Utils.hs 2.73 KB
Newer Older
Iustin Pop's avatar
Iustin Pop committed
1
2
{-| Utility functions -}

3
4
5
6
7
8
module Ganeti.HTools.Utils
    (
      debug
    , sepSplit
    , varianceCoeff
    , readData
9
    , commaJoin
10
11
12
    , readEitherString
    , loadJSArray
    , fromObj
Iustin Pop's avatar
Iustin Pop committed
13
14
    , asJSObject
    , asObjectList
15
    , fromJResult
16
    ) where
Iustin Pop's avatar
Iustin Pop committed
17

18
import Data.List
19
import Control.Monad
Iustin Pop's avatar
Iustin Pop committed
20
21
import System
import System.IO
22
import qualified Text.JSON as J
23
import Text.Printf (printf)
Iustin Pop's avatar
Iustin Pop committed
24

Iustin Pop's avatar
Iustin Pop committed
25
26
import Ganeti.HTools.Types

Iustin Pop's avatar
Iustin Pop committed
27
28
29
30
31
32
import Debug.Trace

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

Iustin Pop's avatar
Iustin Pop committed
33

34
35
36
fromJResult :: Monad m => J.Result a -> m a
fromJResult (J.Error x) = fail x
fromJResult (J.Ok x) = return x
Iustin Pop's avatar
Iustin Pop committed
37

Iustin Pop's avatar
Iustin Pop committed
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
-- | Comma-join a string list.
commaJoin :: [String] -> String
commaJoin = intercalate ","

-- | Split a string on a separator and return an array.
sepSplit :: Char -> String -> [String]
sepSplit sep s
    | x == "" && xs == [] = []
    | xs == []            = [x]
    | ys == []            = x:"":[]
    | otherwise           = x:(sepSplit sep ys)
    where (x, xs) = break (== sep) s
          ys = drop 1 xs

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

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

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

-- | Standard deviation.
stdDev :: Floating a => [a] -> a
stdDev lst =
    let mv = meanValue lst
        square = (^ (2::Int)) -- silences "defaulting the constraint..."
        av = sum $ map square $ map (\e -> e - mv) lst
        bv = sqrt (av / (fromIntegral $ length lst))
    in bv

-- | Coefficient of variation.
varianceCoeff :: Floating a => [a] -> a
varianceCoeff lst = (stdDev lst) / (fromIntegral $ length lst)
Iustin Pop's avatar
Iustin Pop committed
74

75
76
77
78
79
80
-- | Get an Ok result or print the error and exit
readData :: Result a -> IO a
readData nd =
    (case nd of
       Bad x -> do
         putStrLn x
Iustin Pop's avatar
Iustin Pop committed
81
         exitWith $ ExitFailure 1
82
       Ok x -> return x)
83

84
readEitherString :: (Monad m) => J.JSValue -> m String
85
86
readEitherString v =
    case v of
87
88
      J.JSString s -> return $ J.fromJSString s
      _ -> fail "Wrong JSON type"
89

90
loadJSArray :: (Monad m) => String -> m [J.JSObject J.JSValue]
91
loadJSArray s = fromJResult $ J.decodeStrict s
92

93
fromObj :: (J.JSON a, Monad m) => String -> J.JSObject J.JSValue -> m a
94
fromObj k o =
95
    case lookup k (J.fromJSObject o) of
Iustin Pop's avatar
Iustin Pop committed
96
      Nothing -> fail $ printf "key '%s' not found in %s" k (show o)
97
      Just val -> fromJResult $ J.readJSON val
98

99
100
101
asJSObject :: (Monad m) => J.JSValue -> m (J.JSObject J.JSValue)
asJSObject (J.JSObject a) = return a
asJSObject _ = fail "not an object"
102

103
asObjectList :: (Monad m) => [J.JSValue] -> m [J.JSObject J.JSValue]
104
asObjectList = sequence . map asJSObject