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

   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