root / Ganeti / HTools / Utils.hs @ 5aa48dbe
History | View | Annotate | Download (4 kB)
1 |
{-| Utility functions -} |
---|---|
2 |
|
3 |
module Ganeti.HTools.Utils |
4 |
( |
5 |
debug |
6 |
, sepSplit |
7 |
, swapPairs |
8 |
, varianceCoeff |
9 |
, readData |
10 |
, commaJoin |
11 |
, readEitherString |
12 |
, loadJSArray |
13 |
, fromObj |
14 |
, getStringElement |
15 |
, getIntElement |
16 |
, getBoolElement |
17 |
, getListElement |
18 |
, getObjectElement |
19 |
, asJSObject |
20 |
, asObjectList |
21 |
, Result(Ok, Bad) |
22 |
, fromJResult |
23 |
, (|+) |
24 |
) where |
25 |
|
26 |
import Data.Either |
27 |
import Data.List |
28 |
import Control.Monad |
29 |
import System |
30 |
import System.IO |
31 |
import qualified Text.JSON as J |
32 |
import Text.Printf (printf) |
33 |
|
34 |
import Debug.Trace |
35 |
|
36 |
-- | To be used only for debugging, breaks referential integrity. |
37 |
debug :: Show a => a -> a |
38 |
debug x = trace (show x) x |
39 |
|
40 |
|
41 |
{- |
42 |
|
43 |
This is similar to the JSON library Result type - *very* similar, but |
44 |
we want to use it in multiple places, so we abstract it into a |
45 |
mini-library here |
46 |
|
47 |
-} |
48 |
|
49 |
data Result a |
50 |
= Bad String |
51 |
| Ok a |
52 |
deriving (Show) |
53 |
|
54 |
instance Monad Result where |
55 |
(>>=) (Bad x) _ = Bad x |
56 |
(>>=) (Ok x) fn = fn x |
57 |
return = Ok |
58 |
fail = Bad |
59 |
|
60 |
fromJResult :: Monad m => J.Result a -> m a |
61 |
fromJResult (J.Error x) = fail x |
62 |
fromJResult (J.Ok x) = return x |
63 |
|
64 |
-- | Comma-join a string list. |
65 |
commaJoin :: [String] -> String |
66 |
commaJoin = intercalate "," |
67 |
|
68 |
-- | Split a string on a separator and return an array. |
69 |
sepSplit :: Char -> String -> [String] |
70 |
sepSplit sep s |
71 |
| x == "" && xs == [] = [] |
72 |
| xs == [] = [x] |
73 |
| ys == [] = x:"":[] |
74 |
| otherwise = x:(sepSplit sep ys) |
75 |
where (x, xs) = break (== sep) s |
76 |
ys = drop 1 xs |
77 |
|
78 |
-- | Partial application of sepSplit to @'.'@ |
79 |
commaSplit :: String -> [String] |
80 |
commaSplit = sepSplit ',' |
81 |
|
82 |
-- | Swap a list of @(a, b)@ into @(b, a)@ |
83 |
swapPairs :: [(a, b)] -> [(b, a)] |
84 |
swapPairs = map (\ (a, b) -> (b, a)) |
85 |
|
86 |
-- Simple and slow statistical functions, please replace with better versions |
87 |
|
88 |
-- | Mean value of a list. |
89 |
meanValue :: Floating a => [a] -> a |
90 |
meanValue lst = (sum lst) / (fromIntegral $ length lst) |
91 |
|
92 |
-- | Standard deviation. |
93 |
stdDev :: Floating a => [a] -> a |
94 |
stdDev lst = |
95 |
let mv = meanValue lst |
96 |
square = (^ (2::Int)) -- silences "defaulting the constraint..." |
97 |
av = sum $ map square $ map (\e -> e - mv) lst |
98 |
bv = sqrt (av / (fromIntegral $ length lst)) |
99 |
in bv |
100 |
|
101 |
-- | Coefficient of variation. |
102 |
varianceCoeff :: Floating a => [a] -> a |
103 |
varianceCoeff lst = (stdDev lst) / (fromIntegral $ length lst) |
104 |
|
105 |
-- | Get an Ok result or print the error and exit |
106 |
readData :: Result a -> IO a |
107 |
readData nd = |
108 |
(case nd of |
109 |
Bad x -> do |
110 |
putStrLn x |
111 |
exitWith $ ExitFailure 1 |
112 |
Ok x -> return x) |
113 |
|
114 |
readEitherString :: (Monad m) => J.JSValue -> m String |
115 |
readEitherString v = |
116 |
case v of |
117 |
J.JSString s -> return $ J.fromJSString s |
118 |
_ -> fail "Wrong JSON type" |
119 |
|
120 |
loadJSArray :: (Monad m) => String -> m [J.JSObject J.JSValue] |
121 |
loadJSArray s = fromJResult $ J.decodeStrict s |
122 |
|
123 |
fromObj :: (J.JSON a, Monad m) => String -> J.JSObject J.JSValue -> m a |
124 |
fromObj k o = |
125 |
case lookup k (J.fromJSObject o) of |
126 |
Nothing -> fail $ printf "key '%s' not found" k |
127 |
Just val -> fromJResult $ J.readJSON val |
128 |
|
129 |
getStringElement :: (Monad m) => String -> J.JSObject J.JSValue -> m String |
130 |
getStringElement = fromObj |
131 |
|
132 |
getIntElement :: (Monad m) => String -> J.JSObject J.JSValue -> m Int |
133 |
getIntElement = fromObj |
134 |
|
135 |
getBoolElement :: (Monad m) => String -> J.JSObject J.JSValue -> m Bool |
136 |
getBoolElement = fromObj |
137 |
|
138 |
getListElement :: (Monad m) => String -> J.JSObject J.JSValue -> m [J.JSValue] |
139 |
getListElement = fromObj |
140 |
|
141 |
getObjectElement :: (Monad m) => String -> J.JSObject J.JSValue |
142 |
-> m (J.JSObject J.JSValue) |
143 |
getObjectElement = fromObj |
144 |
|
145 |
asJSObject :: (Monad m) => J.JSValue -> m (J.JSObject J.JSValue) |
146 |
asJSObject (J.JSObject a) = return a |
147 |
asJSObject _ = fail "not an object" |
148 |
|
149 |
asObjectList :: (Monad m) => [J.JSValue] -> m [J.JSObject J.JSValue] |
150 |
asObjectList = sequence . map asJSObject |
151 |
|
152 |
-- | Function to concat two strings with a separator under a monad |
153 |
(|+) :: (Monad m) => m String -> m String -> m String |
154 |
(|+) = liftM2 (\x y -> x ++ "|" ++ y) |