## 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) |