code.grnet.gr Git - ganeti-local/blob - Ganeti/HTools/Utils.hs

   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)