Statistics
| Branch: | Tag: | Revision:

root / Ganeti / HTools / Utils.hs @ 00b15752

History | View | Annotate | Download (5.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
    , getBoolElement
24
    , getListElement
25
    , getObjectElement
26
    , asJSObject
27
    , asObjectList
28
    , concatEitherElems
29
    , applyEither1
30
    , applyEither2
31
    ) where
32

    
33
import Data.Either
34
import Data.List
35
import Monad
36
import System
37
import System.IO
38
import Text.JSON
39
import Text.Printf (printf)
40

    
41
import Debug.Trace
42

    
43
-- | To be used only for debugging, breaks referential integrity.
44
debug :: Show a => a -> a
45
debug x = trace (show x) x
46

    
47
-- | Check if the given argument is Left something
48
isLeft :: Either a b -> Bool
49
isLeft val =
50
    case val of
51
      Left _ -> True
52
      _ -> False
53

    
54
fromLeft :: Either a b -> a
55
fromLeft = either (\x -> x) (\_ -> undefined)
56

    
57
fromRight :: Either a b -> b
58
fromRight = either (\_ -> undefined) id
59

    
60
-- | Comma-join a string list.
61
commaJoin :: [String] -> String
62
commaJoin = intercalate ","
63

    
64
-- | Split a string on a separator and return an array.
65
sepSplit :: Char -> String -> [String]
66
sepSplit sep s
67
    | x == "" && xs == [] = []
68
    | xs == []            = [x]
69
    | ys == []            = x:"":[]
70
    | otherwise           = x:(sepSplit sep ys)
71
    where (x, xs) = break (== sep) s
72
          ys = drop 1 xs
73

    
74
-- | Partial application of sepSplit to @'.'@
75
commaSplit :: String -> [String]
76
commaSplit = sepSplit ','
77

    
78
-- | Swap a list of @(a, b)@ into @(b, a)@
79
swapPairs :: [(a, b)] -> [(b, a)]
80
swapPairs = map (\ (a, b) -> (b, a))
81

    
82
-- Simple and slow statistical functions, please replace with better versions
83

    
84
-- | Mean value of a list.
85
meanValue :: Floating a => [a] -> a
86
meanValue lst = (sum lst) / (fromIntegral $ length lst)
87

    
88
-- | Standard deviation.
89
stdDev :: Floating a => [a] -> a
90
stdDev lst =
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))
95
    in bv
96

    
97
-- | Coefficient of variation.
98
varianceCoeff :: Floating a => [a] -> a
99
varianceCoeff lst = (stdDev lst) / (fromIntegral $ length lst)
100

    
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
104
  nd <- fn host
105
  when (isLeft nd) $
106
       do
107
         putStrLn $ fromLeft nd
108
         exitWith $ ExitFailure 1
109
  return $ fromRight nd
110

    
111
{-- Our cheap monad-like stuff.
112

    
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
115
entire thing.
116

    
117
-}
118
combineEithers :: (Either String a)
119
               -> (a -> Either String b)
120
               -> (Either String b)
121
combineEithers (Left s) _ = Left s
122
combineEithers (Right s) f = f s
123

    
124
ensureEitherList :: [Either String a] -> Either String [a]
125
ensureEitherList lst =
126
    foldr (\elem accu ->
127
               case (elem, accu) of
128
                 (Left x, _) -> Left x
129
                 (_, Left x) -> Left x -- should never happen
130
                 (Right e, Right a) -> Right (e:a)
131
          )
132
    (Right []) lst
133

    
134
eitherListHead :: Either String [a] -> Either String a
135
eitherListHead lst =
136
    case lst of
137
      Left x -> Left x
138
      Right (x:_) -> Right x
139
      Right [] -> Left "List empty"
140

    
141
readEitherString :: JSValue -> Either String String
142
readEitherString v =
143
    case v of
144
      JSString s -> Right $ fromJSString s
145
      _ -> Left "Wrong JSON type"
146

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

    
154
loadJSArray :: String -> Either String [JSObject JSValue]
155
loadJSArray s = resultToEither $ decodeStrict s
156

    
157
fromObj :: JSON a => String -> JSObject JSValue -> Either String a
158
fromObj k o =
159
    case lookup k (fromJSObject o) of
160
      Nothing -> Left $ printf "key '%s' not found" k
161
      Just val -> resultToEither $ readJSON val
162

    
163
getStringElement :: String -> JSObject JSValue -> Either String String
164
getStringElement = fromObj
165

    
166
getIntElement :: String -> JSObject JSValue -> Either String Int
167
getIntElement = fromObj
168

    
169
getBoolElement :: String -> JSObject JSValue -> Either String Bool
170
getBoolElement = fromObj
171

    
172
getListElement :: String -> JSObject JSValue
173
               -> Either String [JSValue]
174
getListElement = fromObj
175

    
176
getObjectElement :: String -> JSObject JSValue
177
                 -> Either String (JSObject JSValue)
178
getObjectElement = fromObj
179

    
180
asJSObject :: JSValue -> Either String (JSObject JSValue)
181
asJSObject (JSObject a) = Right a
182
asJSObject _ = Left "not an object"
183

    
184
asObjectList :: [JSValue] -> Either String [JSObject JSValue]
185
asObjectList =
186
    ensureEitherList . map asJSObject
187

    
188
concatEitherElems :: Either String String
189
            -> Either String String
190
            -> Either String String
191
concatEitherElems = applyEither2 (\x y -> x ++ "|" ++ y)
192

    
193
applyEither1 :: (a -> b) -> Either String a -> Either String b
194
applyEither1 fn a =
195
    case a of
196
      Left x -> Left x
197
      Right y -> Right $ fn y
198

    
199
applyEither2 :: (a -> b -> c)
200
       -> Either String a
201
       -> Either String b
202
       -> Either String c
203
applyEither2 fn a b =
204
    case (a, b) of
205
      (Right x, Right y) -> Right $ fn x y
206
      (Left x, _) -> Left x
207
      (_, Left y) -> Left y