root / Ganeti / HTools / Utils.hs @ 9ba5c28f
History | View | Annotate | Download (5 kB)
1 | e4f08c46 | Iustin Pop | {-| Utility functions -} |
---|---|---|---|
2 | e4f08c46 | Iustin Pop | |
3 | 209b3711 | Iustin Pop | module Ganeti.HTools.Utils |
4 | 209b3711 | Iustin Pop | ( |
5 | 209b3711 | Iustin Pop | debug |
6 | 209b3711 | Iustin Pop | , isLeft |
7 | 209b3711 | Iustin Pop | , fromLeft |
8 | 209b3711 | Iustin Pop | , fromRight |
9 | 209b3711 | Iustin Pop | , sepSplit |
10 | 209b3711 | Iustin Pop | , swapPairs |
11 | 209b3711 | Iustin Pop | , varianceCoeff |
12 | 209b3711 | Iustin Pop | , readData |
13 | 3d7cd10b | Iustin Pop | , commaJoin |
14 | 9ba5c28f | Iustin Pop | , combineEithers |
15 | 9ba5c28f | Iustin Pop | , ensureEitherList |
16 | 9ba5c28f | Iustin Pop | , eitherListHead |
17 | 9ba5c28f | Iustin Pop | , readEitherString |
18 | 9ba5c28f | Iustin Pop | , parseEitherList |
19 | 9ba5c28f | Iustin Pop | , loadJSArray |
20 | 9ba5c28f | Iustin Pop | , fromObj |
21 | 9ba5c28f | Iustin Pop | , getStringElement |
22 | 9ba5c28f | Iustin Pop | , getIntElement |
23 | 9ba5c28f | Iustin Pop | , getListElement |
24 | 9ba5c28f | Iustin Pop | , concatEitherElems |
25 | 9ba5c28f | Iustin Pop | , applyEither1 |
26 | 9ba5c28f | Iustin Pop | , applyEither2 |
27 | 209b3711 | Iustin Pop | ) where |
28 | e4f08c46 | Iustin Pop | |
29 | 1b7cf8ca | Iustin Pop | import Data.Either |
30 | 29ac5975 | Iustin Pop | import Data.List |
31 | 29ac5975 | Iustin Pop | import Monad |
32 | dd4c56ed | Iustin Pop | import System |
33 | dd4c56ed | Iustin Pop | import System.IO |
34 | 9ba5c28f | Iustin Pop | import Text.JSON |
35 | 9ba5c28f | Iustin Pop | import Text.Printf (printf) |
36 | e4f08c46 | Iustin Pop | |
37 | e4f08c46 | Iustin Pop | import Debug.Trace |
38 | e4f08c46 | Iustin Pop | |
39 | e4f08c46 | Iustin Pop | -- | To be used only for debugging, breaks referential integrity. |
40 | e4f08c46 | Iustin Pop | debug :: Show a => a -> a |
41 | e4f08c46 | Iustin Pop | debug x = trace (show x) x |
42 | e4f08c46 | Iustin Pop | |
43 | 1b7cf8ca | Iustin Pop | -- | Check if the given argument is Left something |
44 | 1b7cf8ca | Iustin Pop | isLeft :: Either a b -> Bool |
45 | 1b7cf8ca | Iustin Pop | isLeft val = |
46 | 1b7cf8ca | Iustin Pop | case val of |
47 | 1b7cf8ca | Iustin Pop | Left _ -> True |
48 | 1b7cf8ca | Iustin Pop | _ -> False |
49 | 1b7cf8ca | Iustin Pop | |
50 | 1b7cf8ca | Iustin Pop | fromLeft :: Either a b -> a |
51 | 1b7cf8ca | Iustin Pop | fromLeft = either (\x -> x) (\_ -> undefined) |
52 | 1b7cf8ca | Iustin Pop | |
53 | 1b7cf8ca | Iustin Pop | fromRight :: Either a b -> b |
54 | 1b7cf8ca | Iustin Pop | fromRight = either (\_ -> undefined) id |
55 | 1b7cf8ca | Iustin Pop | |
56 | e4f08c46 | Iustin Pop | -- | Comma-join a string list. |
57 | e4f08c46 | Iustin Pop | commaJoin :: [String] -> String |
58 | e4f08c46 | Iustin Pop | commaJoin = intercalate "," |
59 | e4f08c46 | Iustin Pop | |
60 | e4f08c46 | Iustin Pop | -- | Split a string on a separator and return an array. |
61 | e4f08c46 | Iustin Pop | sepSplit :: Char -> String -> [String] |
62 | e4f08c46 | Iustin Pop | sepSplit sep s |
63 | e4f08c46 | Iustin Pop | | x == "" && xs == [] = [] |
64 | e4f08c46 | Iustin Pop | | xs == [] = [x] |
65 | e4f08c46 | Iustin Pop | | ys == [] = x:"":[] |
66 | e4f08c46 | Iustin Pop | | otherwise = x:(sepSplit sep ys) |
67 | e4f08c46 | Iustin Pop | where (x, xs) = break (== sep) s |
68 | e4f08c46 | Iustin Pop | ys = drop 1 xs |
69 | e4f08c46 | Iustin Pop | |
70 | e4f08c46 | Iustin Pop | -- | Partial application of sepSplit to @'.'@ |
71 | e4f08c46 | Iustin Pop | commaSplit :: String -> [String] |
72 | e4f08c46 | Iustin Pop | commaSplit = sepSplit ',' |
73 | e4f08c46 | Iustin Pop | |
74 | e4f08c46 | Iustin Pop | -- | Swap a list of @(a, b)@ into @(b, a)@ |
75 | e4f08c46 | Iustin Pop | swapPairs :: [(a, b)] -> [(b, a)] |
76 | e4f08c46 | Iustin Pop | swapPairs = map (\ (a, b) -> (b, a)) |
77 | e4f08c46 | Iustin Pop | |
78 | e4f08c46 | Iustin Pop | -- Simple and slow statistical functions, please replace with better versions |
79 | e4f08c46 | Iustin Pop | |
80 | e4f08c46 | Iustin Pop | -- | Mean value of a list. |
81 | e4f08c46 | Iustin Pop | meanValue :: Floating a => [a] -> a |
82 | e4f08c46 | Iustin Pop | meanValue lst = (sum lst) / (fromIntegral $ length lst) |
83 | e4f08c46 | Iustin Pop | |
84 | e4f08c46 | Iustin Pop | -- | Standard deviation. |
85 | e4f08c46 | Iustin Pop | stdDev :: Floating a => [a] -> a |
86 | e4f08c46 | Iustin Pop | stdDev lst = |
87 | e4f08c46 | Iustin Pop | let mv = meanValue lst |
88 | e4f08c46 | Iustin Pop | square = (^ (2::Int)) -- silences "defaulting the constraint..." |
89 | e4f08c46 | Iustin Pop | av = sum $ map square $ map (\e -> e - mv) lst |
90 | e4f08c46 | Iustin Pop | bv = sqrt (av / (fromIntegral $ length lst)) |
91 | e4f08c46 | Iustin Pop | in bv |
92 | e4f08c46 | Iustin Pop | |
93 | e4f08c46 | Iustin Pop | -- | Coefficient of variation. |
94 | e4f08c46 | Iustin Pop | varianceCoeff :: Floating a => [a] -> a |
95 | e4f08c46 | Iustin Pop | varianceCoeff lst = (stdDev lst) / (fromIntegral $ length lst) |
96 | dd4c56ed | Iustin Pop | |
97 | dd4c56ed | Iustin Pop | -- | Get a Right result or print the error and exit |
98 | dd4c56ed | Iustin Pop | readData :: (String -> IO (Either String String)) -> String -> IO String |
99 | dd4c56ed | Iustin Pop | readData fn host = do |
100 | dd4c56ed | Iustin Pop | nd <- fn host |
101 | dd4c56ed | Iustin Pop | when (isLeft nd) $ |
102 | dd4c56ed | Iustin Pop | do |
103 | dd4c56ed | Iustin Pop | putStrLn $ fromLeft nd |
104 | dd4c56ed | Iustin Pop | exitWith $ ExitFailure 1 |
105 | dd4c56ed | Iustin Pop | return $ fromRight nd |
106 | 9ba5c28f | Iustin Pop | |
107 | 9ba5c28f | Iustin Pop | {-- Our cheap monad-like stuff. |
108 | 9ba5c28f | Iustin Pop | |
109 | 9ba5c28f | Iustin Pop | Thi is needed since Either e a is already a monad instance somewhere |
110 | 9ba5c28f | Iustin Pop | in the standard libraries (Control.Monad.Error) and we don't need that |
111 | 9ba5c28f | Iustin Pop | entire thing. |
112 | 9ba5c28f | Iustin Pop | |
113 | 9ba5c28f | Iustin Pop | -} |
114 | 9ba5c28f | Iustin Pop | combineEithers :: (Either String a) |
115 | 9ba5c28f | Iustin Pop | -> (a -> Either String b) |
116 | 9ba5c28f | Iustin Pop | -> (Either String b) |
117 | 9ba5c28f | Iustin Pop | combineEithers (Left s) _ = Left s |
118 | 9ba5c28f | Iustin Pop | combineEithers (Right s) f = f s |
119 | 9ba5c28f | Iustin Pop | |
120 | 9ba5c28f | Iustin Pop | ensureEitherList :: [Either String a] -> Either String [a] |
121 | 9ba5c28f | Iustin Pop | ensureEitherList lst = |
122 | 9ba5c28f | Iustin Pop | foldr (\elem accu -> |
123 | 9ba5c28f | Iustin Pop | case (elem, accu) of |
124 | 9ba5c28f | Iustin Pop | (Left x, _) -> Left x |
125 | 9ba5c28f | Iustin Pop | (_, Left x) -> Left x -- should never happen |
126 | 9ba5c28f | Iustin Pop | (Right e, Right a) -> Right (e:a) |
127 | 9ba5c28f | Iustin Pop | ) |
128 | 9ba5c28f | Iustin Pop | (Right []) lst |
129 | 9ba5c28f | Iustin Pop | |
130 | 9ba5c28f | Iustin Pop | eitherListHead :: Either String [a] -> Either String a |
131 | 9ba5c28f | Iustin Pop | eitherListHead lst = |
132 | 9ba5c28f | Iustin Pop | case lst of |
133 | 9ba5c28f | Iustin Pop | Left x -> Left x |
134 | 9ba5c28f | Iustin Pop | Right (x:_) -> Right x |
135 | 9ba5c28f | Iustin Pop | Right [] -> Left "List empty" |
136 | 9ba5c28f | Iustin Pop | |
137 | 9ba5c28f | Iustin Pop | readEitherString :: JSValue -> Either String String |
138 | 9ba5c28f | Iustin Pop | readEitherString v = |
139 | 9ba5c28f | Iustin Pop | case v of |
140 | 9ba5c28f | Iustin Pop | JSString s -> Right $ fromJSString s |
141 | 9ba5c28f | Iustin Pop | _ -> Left "Wrong JSON type" |
142 | 9ba5c28f | Iustin Pop | |
143 | 9ba5c28f | Iustin Pop | parseEitherList :: (JSObject JSValue -> Either String String) |
144 | 9ba5c28f | Iustin Pop | -> [JSObject JSValue] |
145 | 9ba5c28f | Iustin Pop | -> Either String String |
146 | 9ba5c28f | Iustin Pop | parseEitherList fn idata = |
147 | 9ba5c28f | Iustin Pop | let ml = ensureEitherList $ map fn idata |
148 | 9ba5c28f | Iustin Pop | in ml `combineEithers` (Right . unlines) |
149 | 9ba5c28f | Iustin Pop | |
150 | 9ba5c28f | Iustin Pop | loadJSArray :: String -> Either String [JSObject JSValue] |
151 | 9ba5c28f | Iustin Pop | loadJSArray s = resultToEither $ decodeStrict s |
152 | 9ba5c28f | Iustin Pop | |
153 | 9ba5c28f | Iustin Pop | fromObj :: JSON a => String -> JSObject JSValue -> Either String a |
154 | 9ba5c28f | Iustin Pop | fromObj k o = |
155 | 9ba5c28f | Iustin Pop | case lookup k (fromJSObject o) of |
156 | 9ba5c28f | Iustin Pop | Nothing -> Left $ printf "key '%s' not found" k |
157 | 9ba5c28f | Iustin Pop | Just val -> resultToEither $ readJSON val |
158 | 9ba5c28f | Iustin Pop | |
159 | 9ba5c28f | Iustin Pop | getStringElement :: String -> JSObject JSValue -> Either String String |
160 | 9ba5c28f | Iustin Pop | getStringElement = fromObj |
161 | 9ba5c28f | Iustin Pop | |
162 | 9ba5c28f | Iustin Pop | getIntElement :: String -> JSObject JSValue -> Either String Int |
163 | 9ba5c28f | Iustin Pop | getIntElement = fromObj |
164 | 9ba5c28f | Iustin Pop | |
165 | 9ba5c28f | Iustin Pop | getListElement :: String -> JSObject JSValue |
166 | 9ba5c28f | Iustin Pop | -> Either String [JSValue] |
167 | 9ba5c28f | Iustin Pop | getListElement = fromObj |
168 | 9ba5c28f | Iustin Pop | |
169 | 9ba5c28f | Iustin Pop | concatEitherElems :: Either String String |
170 | 9ba5c28f | Iustin Pop | -> Either String String |
171 | 9ba5c28f | Iustin Pop | -> Either String String |
172 | 9ba5c28f | Iustin Pop | concatEitherElems = applyEither2 (\x y -> x ++ "|" ++ y) |
173 | 9ba5c28f | Iustin Pop | |
174 | 9ba5c28f | Iustin Pop | applyEither1 :: (a -> b) -> Either String a -> Either String b |
175 | 9ba5c28f | Iustin Pop | applyEither1 fn a = |
176 | 9ba5c28f | Iustin Pop | case a of |
177 | 9ba5c28f | Iustin Pop | Left x -> Left x |
178 | 9ba5c28f | Iustin Pop | Right y -> Right $ fn y |
179 | 9ba5c28f | Iustin Pop | |
180 | 9ba5c28f | Iustin Pop | applyEither2 :: (a -> b -> c) |
181 | 9ba5c28f | Iustin Pop | -> Either String a |
182 | 9ba5c28f | Iustin Pop | -> Either String b |
183 | 9ba5c28f | Iustin Pop | -> Either String c |
184 | 9ba5c28f | Iustin Pop | applyEither2 fn a b = |
185 | 9ba5c28f | Iustin Pop | case (a, b) of |
186 | 9ba5c28f | Iustin Pop | (Right x, Right y) -> Right $ fn x y |
187 | 9ba5c28f | Iustin Pop | (Left x, _) -> Left x |
188 | 9ba5c28f | Iustin Pop | (_, Left y) -> Left y |