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     , getListElement
  24     , concatEitherElems
  25     , applyEither1
  26     , applyEither2
  27     ) where
  28
  29 import Data.Either
  30 import Data.List
  31 import Monad
  32 import System
  33 import System.IO
  34 import Text.JSON
  35 import Text.Printf (printf)
  36
  37 import Debug.Trace
  38
  39 -- | To be used only for debugging, breaks referential integrity.
  40 debug :: Show a => a -> a
  41 debug x = trace (show x) x
  42
  43 -- | Check if the given argument is Left something
  44 isLeft :: Either a b -> Bool
  45 isLeft val =
  46     case val of
  47       Left _ -> True
  48       _ -> False
  49
  50 fromLeft :: Either a b -> a
  51 fromLeft = either (\x -> x) (\_ -> undefined)
  52
  53 fromRight :: Either a b -> b
  54 fromRight = either (\_ -> undefined) id
  55
  56 -- | Comma-join a string list.
  57 commaJoin :: [String] -> String
  58 commaJoin = intercalate ","
  59
  60 -- | Split a string on a separator and return an array.
  61 sepSplit :: Char -> String -> [String]
  62 sepSplit sep s
  63     | x == "" && xs == [] = []
  64     | xs == []            = [x]
  65     | ys == []            = x:"":[]
  66     | otherwise           = x:(sepSplit sep ys)
  67     where (x, xs) = break (== sep) s
  68           ys = drop 1 xs
  69
  70 -- | Partial application of sepSplit to @'.'@
  71 commaSplit :: String -> [String]
  72 commaSplit = sepSplit ','
  73
  74 -- | Swap a list of @(a, b)@ into @(b, a)@
  75 swapPairs :: [(a, b)] -> [(b, a)]
  76 swapPairs = map (\ (a, b) -> (b, a))
  77
  78 -- Simple and slow statistical functions, please replace with better versions
  79
  80 -- | Mean value of a list.
  81 meanValue :: Floating a => [a] -> a
  82 meanValue lst = (sum lst) / (fromIntegral $ length lst)
  83
  84 -- | Standard deviation.
  85 stdDev :: Floating a => [a] -> a
  86 stdDev lst =
  87     let mv = meanValue lst
  88         square = (^ (2::Int)) -- silences "defaulting the constraint..."
  89         av = sum $ map square $ map (\e -> e - mv) lst
  90         bv = sqrt (av / (fromIntegral $ length lst))
  91     in bv
  92
  93 -- | Coefficient of variation.
  94 varianceCoeff :: Floating a => [a] -> a
  95 varianceCoeff lst = (stdDev lst) / (fromIntegral $ length lst)
  96
  97 -- | Get a Right result or print the error and exit
  98 readData :: (String -> IO (Either String String)) -> String -> IO String
  99 readData fn host = do
 100   nd <- fn host
 101   when (isLeft nd) $
 102        do
 103          putStrLn $ fromLeft nd
 104          exitWith $ ExitFailure 1
 105   return $ fromRight nd
 106
 107 {-- Our cheap monad-like stuff.
 108
 109 Thi is needed since Either e a is already a monad instance somewhere
 110 in the standard libraries (Control.Monad.Error) and we don't need that
 111 entire thing.
 112
 113 -}
 114 combineEithers :: (Either String a)
 115                -> (a -> Either String b)
 116                -> (Either String b)
 117 combineEithers (Left s) _ = Left s
 118 combineEithers (Right s) f = f s
 119
 120 ensureEitherList :: [Either String a] -> Either String [a]
 121 ensureEitherList lst =
 122     foldr (\elem accu ->
 123                case (elem, accu) of
 124                  (Left x, _) -> Left x
 125                  (_, Left x) -> Left x -- should never happen
 126                  (Right e, Right a) -> Right (e:a)
 127           )
 128     (Right []) lst
 129
 130 eitherListHead :: Either String [a] -> Either String a
 131 eitherListHead lst =
 132     case lst of
 133       Left x -> Left x
 134       Right (x:_) -> Right x
 135       Right [] -> Left "List empty"
 136
 137 readEitherString :: JSValue -> Either String String
 138 readEitherString v =
 139     case v of
 140       JSString s -> Right $ fromJSString s
 141       _ -> Left "Wrong JSON type"
 142
 143 parseEitherList :: (JSObject JSValue -> Either String String)
 144           -> [JSObject JSValue]
 145           -> Either String String
 146 parseEitherList fn idata =
 147     let ml = ensureEitherList $ map fn idata
 148     in ml `combineEithers` (Right . unlines)
 149
 150 loadJSArray :: String -> Either String [JSObject JSValue]
 151 loadJSArray s = resultToEither $ decodeStrict s
 152
 153 fromObj :: JSON a => String -> JSObject JSValue -> Either String a
 154 fromObj k o =
 155     case lookup k (fromJSObject o) of
 156       Nothing -> Left $ printf "key '%s' not found" k
 157       Just val -> resultToEither $ readJSON val
 158
 159 getStringElement :: String -> JSObject JSValue -> Either String String
 160 getStringElement = fromObj
 161
 162 getIntElement :: String -> JSObject JSValue -> Either String Int
 163 getIntElement = fromObj
 164
 165 getListElement :: String -> JSObject JSValue
 166                -> Either String [JSValue]
 167 getListElement = fromObj
 168
 169 concatEitherElems :: Either String String
 170             -> Either String String
 171             -> Either String String
 172 concatEitherElems = applyEither2 (\x y -> x ++ "|" ++ y)
 173
 174 applyEither1 :: (a -> b) -> Either String a -> Either String b
 175 applyEither1 fn a =
 176     case a of
 177       Left x -> Left x
 178       Right y -> Right $ fn y
 179
 180 applyEither2 :: (a -> b -> c)
 181        -> Either String a
 182        -> Either String b
 183        -> Either String c
 184 applyEither2 fn a b =
 185     case (a, b) of
 186       (Right x, Right y) -> Right $ fn x y
 187       (Left x, _) -> Left x
 188       (_, Left y) -> Left y