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