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

Iustin Pop's avatar
Iustin Pop committed
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
{-

Copyright (C) 2009 Google Inc.

This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
02110-1301, USA.

-}

24
25
26
27
28
module Ganeti.HTools.Utils
    (
      debug
    , sepSplit
    , varianceCoeff
29
    , commaJoin
30
31
32
    , readEitherString
    , loadJSArray
    , fromObj
Iustin Pop's avatar
Iustin Pop committed
33
34
    , asJSObject
    , asObjectList
35
    , fromJResult
36
    ) where
Iustin Pop's avatar
Iustin Pop committed
37

38
import Data.List
39
import Control.Monad
Iustin Pop's avatar
Iustin Pop committed
40
41
import System
import System.IO
42
import qualified Text.JSON as J
43
import Text.Printf (printf)
Iustin Pop's avatar
Iustin Pop committed
44

Iustin Pop's avatar
Iustin Pop committed
45
46
import Ganeti.HTools.Types

Iustin Pop's avatar
Iustin Pop committed
47
48
import Debug.Trace

Iustin Pop's avatar
Iustin Pop committed
49
50
-- * Debug functions

Iustin Pop's avatar
Iustin Pop committed
51
52
53
54
-- | 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
55
-- * Miscelaneous
Iustin Pop's avatar
Iustin Pop committed
56

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

Iustin Pop's avatar
Iustin Pop committed
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
-- 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
95

Iustin Pop's avatar
Iustin Pop committed
96
97
98
99
100
101
102
103
104
105
106
-- * 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.
107
readEitherString :: (Monad m) => J.JSValue -> m String
108
109
readEitherString v =
    case v of
110
111
      J.JSString s -> return $ J.fromJSString s
      _ -> fail "Wrong JSON type"
112

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

Iustin Pop's avatar
Iustin Pop committed
117
-- | Reads a the value of a key in a JSON object.
118
fromObj :: (J.JSON a, Monad m) => String -> J.JSObject J.JSValue -> m a
119
fromObj k o =
120
    case lookup k (J.fromJSObject o) of
Iustin Pop's avatar
Iustin Pop committed
121
      Nothing -> fail $ printf "key '%s' not found in %s" k (show o)
122
      Just val -> fromJResult $ J.readJSON val
123

Iustin Pop's avatar
Iustin Pop committed
124
-- | Converts a JSON value into a JSON object.
125
126
127
asJSObject :: (Monad m) => J.JSValue -> m (J.JSObject J.JSValue)
asJSObject (J.JSObject a) = return a
asJSObject _ = fail "not an object"
128

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