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

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

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

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

Iustin Pop's avatar
Iustin Pop committed
26
27
import Debug.Trace

Iustin Pop's avatar
Iustin Pop committed
28
29
-- * Debug functions

Iustin Pop's avatar
Iustin Pop committed
30
31
32
33
-- | 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
34
-- * Miscelaneous
Iustin Pop's avatar
Iustin Pop committed
35

Iustin Pop's avatar
Iustin Pop committed
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
-- | 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 ','

Iustin Pop's avatar
Iustin Pop committed
54
55
-- * Mathematical functions

Iustin Pop's avatar
Iustin Pop committed
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
-- 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

Iustin Pop's avatar
Iustin Pop committed
75
76
77
78
79
80
81
82
83
84
85
-- * JSON-related functions

-- | Converts a JSON Result into a monadic value.
fromJResult :: Monad m => J.Result a -> m a
fromJResult (J.Error x) = fail x
fromJResult (J.Ok x) = return x

-- | Tries to read a string from a JSON value.
--
-- In case the value was not a string, we fail the read (in the
-- context of the current monad.
86
readEitherString :: (Monad m) => J.JSValue -> m String
87
88
readEitherString v =
    case v of
89
90
      J.JSString s -> return $ J.fromJSString s
      _ -> fail "Wrong JSON type"
91

Iustin Pop's avatar
Iustin Pop committed
92
-- | Converts a JSON message into an array of JSON objects.
93
loadJSArray :: (Monad m) => String -> m [J.JSObject J.JSValue]
94
loadJSArray s = fromJResult $ J.decodeStrict s
95

Iustin Pop's avatar
Iustin Pop committed
96
-- | Reads a the value of a key in a JSON object.
97
fromObj :: (J.JSON a, Monad m) => String -> J.JSObject J.JSValue -> m a
98
fromObj k o =
99
    case lookup k (J.fromJSObject o) of
Iustin Pop's avatar
Iustin Pop committed
100
      Nothing -> fail $ printf "key '%s' not found in %s" k (show o)
101
      Just val -> fromJResult $ J.readJSON val
102

Iustin Pop's avatar
Iustin Pop committed
103
-- | Converts a JSON value into a JSON object.
104
105
106
asJSObject :: (Monad m) => J.JSValue -> m (J.JSObject J.JSValue)
asJSObject (J.JSObject a) = return a
asJSObject _ = fail "not an object"
107

Iustin Pop's avatar
Iustin Pop committed
108
-- | Coneverts a list of JSON values into a list of JSON objects.
109
asObjectList :: (Monad m) => [J.JSValue] -> m [J.JSObject J.JSValue]
110
asObjectList = sequence . map asJSObject