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