1 {-| Utility functions -}
3 module Ganeti.HTools.Utils
39 import Text.Printf (printf)
43 -- | To be used only for debugging, breaks referential integrity.
44 debug :: Show a => a -> a
45 debug x = trace (show x) x
47 -- | Check if the given argument is Left something
48 isLeft :: Either a b -> Bool
54 fromLeft :: Either a b -> a
55 fromLeft = either (\x -> x) (\_ -> undefined)
57 fromRight :: Either a b -> b
58 fromRight = either (\_ -> undefined) id
60 -- | Comma-join a string list.
61 commaJoin :: [String] -> String
62 commaJoin = intercalate ","
64 -- | Split a string on a separator and return an array.
65 sepSplit :: Char -> String -> [String]
67 | x == "" && xs == [] = []
70 | otherwise = x:(sepSplit sep ys)
71 where (x, xs) = break (== sep) s
74 -- | Partial application of sepSplit to @'.'@
75 commaSplit :: String -> [String]
76 commaSplit = sepSplit ','
78 -- | Swap a list of @(a, b)@ into @(b, a)@
79 swapPairs :: [(a, b)] -> [(b, a)]
80 swapPairs = map (\ (a, b) -> (b, a))
82 -- Simple and slow statistical functions, please replace with better versions
84 -- | Mean value of a list.
85 meanValue :: Floating a => [a] -> a
86 meanValue lst = (sum lst) / (fromIntegral $ length lst)
88 -- | Standard deviation.
89 stdDev :: Floating a => [a] -> a
91 let mv = meanValue lst
92 square = (^ (2::Int)) -- silences "defaulting the constraint..."
93 av = sum $ map square $ map (\e -> e - mv) lst
94 bv = sqrt (av / (fromIntegral $ length lst))
97 -- | Coefficient of variation.
98 varianceCoeff :: Floating a => [a] -> a
99 varianceCoeff lst = (stdDev lst) / (fromIntegral $ length lst)
101 -- | Get a Right result or print the error and exit
102 readData :: (String -> IO (Either String String)) -> String -> IO String
103 readData fn host = do
107 putStrLn $ fromLeft nd
108 exitWith $ ExitFailure 1
109 return $ fromRight nd
111 {-- Our cheap monad-like stuff.
113 Thi is needed since Either e a is already a monad instance somewhere
114 in the standard libraries (Control.Monad.Error) and we don't need that
118 combineEithers :: (Either String a)
119 -> (a -> Either String b)
121 combineEithers (Left s) _ = Left s
122 combineEithers (Right s) f = f s
124 ensureEitherList :: [Either String a] -> Either String [a]
125 ensureEitherList lst =
128 (Left x, _) -> Left x
129 (_, Left x) -> Left x -- should never happen
130 (Right e, Right a) -> Right (e:a)
134 eitherListHead :: Either String [a] -> Either String a
138 Right (x:_) -> Right x
139 Right [] -> Left "List empty"
141 readEitherString :: JSValue -> Either String String
144 JSString s -> Right $ fromJSString s
145 _ -> Left "Wrong JSON type"
147 parseEitherList :: (JSObject JSValue -> Either String String)
148 -> [JSObject JSValue]
149 -> Either String String
150 parseEitherList fn idata =
151 let ml = ensureEitherList $ map fn idata
152 in ml `combineEithers` (Right . unlines)
154 loadJSArray :: String -> Either String [JSObject JSValue]
155 loadJSArray s = resultToEither $ decodeStrict s
157 fromObj :: JSON a => String -> JSObject JSValue -> Either String a
159 case lookup k (fromJSObject o) of
160 Nothing -> Left $ printf "key '%s' not found" k
161 Just val -> resultToEither $ readJSON val
163 getStringElement :: String -> JSObject JSValue -> Either String String
164 getStringElement = fromObj
166 getIntElement :: String -> JSObject JSValue -> Either String Int
167 getIntElement = fromObj
169 getBoolElement :: String -> JSObject JSValue -> Either String Bool
170 getBoolElement = fromObj
172 getListElement :: String -> JSObject JSValue
173 -> Either String [JSValue]
174 getListElement = fromObj
176 getObjectElement :: String -> JSObject JSValue
177 -> Either String (JSObject JSValue)
178 getObjectElement = fromObj
180 asJSObject :: JSValue -> Either String (JSObject JSValue)
181 asJSObject (JSObject a) = Right a
182 asJSObject _ = Left "not an object"
184 asObjectList :: [JSValue] -> Either String [JSObject JSValue]
186 ensureEitherList . map asJSObject
188 concatEitherElems :: Either String String
189 -> Either String String
190 -> Either String String
191 concatEitherElems = applyEither2 (\x y -> x ++ "|" ++ y)
193 applyEither1 :: (a -> b) -> Either String a -> Either String b
197 Right y -> Right $ fn y
199 applyEither2 :: (a -> b -> c)
203 applyEither2 fn a b =
205 (Right x, Right y) -> Right $ fn x y
206 (Left x, _) -> Left x
207 (_, Left y) -> Left y