Update the IAlloc module

[ganeti-local] / Ganeti / HTools / Utils.hs

diff --git a/Ganeti/HTools/Utils.hs b/Ganeti/HTools/Utils.hs
index 737b94a..fde9616 100644 (file)
--- a/Ganeti/HTools/Utils.hs
+++ b/Ganeti/HTools/Utils.hs
@@ -1,16 +1,41 @@
 {-| Utility functions -}
 
-module Ganeti.HTools.Utils where
+module Ganeti.HTools.Utils
+    (
+      debug
+    , isLeft
+    , fromLeft
+    , fromRight
+    , sepSplit
+    , swapPairs
+    , varianceCoeff
+    , readData
+    , commaJoin
+    , combineEithers
+    , ensureEitherList
+    , eitherListHead
+    , readEitherString
+    , parseEitherList
+    , loadJSArray
+    , fromObj
+    , getStringElement
+    , getIntElement
+    , getListElement
+    , getObjectElement
+    , asJSObject
+    , asObjectList
+    , concatEitherElems
+    , applyEither1
+    , applyEither2
+    ) where
 
 import Data.Either
 import Data.List
-import qualified Data.Version
 import Monad
 import System
 import System.IO
-import System.Info
-import Text.Printf
-import qualified Ganeti.HTools.Version as Version
+import Text.JSON
+import Text.Printf (printf)
 
 import Debug.Trace
 
@@ -68,7 +93,6 @@ stdDev lst =
         bv = sqrt (av / (fromIntegral $ length lst))
     in bv
 
-
 -- | Coefficient of variation.
 varianceCoeff :: Floating a => [a] -> a
 varianceCoeff lst = (stdDev lst) / (fromIntegral $ length lst)
@@ -83,10 +107,97 @@ readData fn host = do
          exitWith $ ExitFailure 1
   return $ fromRight nd
 
-showVersion :: String -- ^ The program name
-            -> String -- ^ The formatted version and other information data
-showVersion name =
-    printf "%s %s\ncompiled with %s %s\nrunning on %s %s\n"
-           name Version.version
-           compilerName (Data.Version.showVersion compilerVersion)
-           os arch
+{-- Our cheap monad-like stuff.
+
+Thi is needed since Either e a is already a monad instance somewhere
+in the standard libraries (Control.Monad.Error) and we don't need that
+entire thing.
+
+-}
+combineEithers :: (Either String a)
+               -> (a -> Either String b)
+               -> (Either String b)
+combineEithers (Left s) _ = Left s
+combineEithers (Right s) f = f s
+
+ensureEitherList :: [Either String a] -> Either String [a]
+ensureEitherList lst =
+    foldr (\elem accu ->
+               case (elem, accu) of
+                 (Left x, _) -> Left x
+                 (_, Left x) -> Left x -- should never happen
+                 (Right e, Right a) -> Right (e:a)
+          )
+    (Right []) lst
+
+eitherListHead :: Either String [a] -> Either String a
+eitherListHead lst =
+    case lst of
+      Left x -> Left x
+      Right (x:_) -> Right x
+      Right [] -> Left "List empty"
+
+readEitherString :: JSValue -> Either String String
+readEitherString v =
+    case v of
+      JSString s -> Right $ fromJSString s
+      _ -> Left "Wrong JSON type"
+
+parseEitherList :: (JSObject JSValue -> Either String String)
+          -> [JSObject JSValue]
+          -> Either String String
+parseEitherList fn idata =
+    let ml = ensureEitherList $ map fn idata
+    in ml `combineEithers` (Right . unlines)
+
+loadJSArray :: String -> Either String [JSObject JSValue]
+loadJSArray s = resultToEither $ decodeStrict s
+
+fromObj :: JSON a => String -> JSObject JSValue -> Either String a
+fromObj k o =
+    case lookup k (fromJSObject o) of
+      Nothing -> Left $ printf "key '%s' not found" k
+      Just val -> resultToEither $ readJSON val
+
+getStringElement :: String -> JSObject JSValue -> Either String String
+getStringElement = fromObj
+
+getIntElement :: String -> JSObject JSValue -> Either String Int
+getIntElement = fromObj
+
+getListElement :: String -> JSObject JSValue
+               -> Either String [JSValue]
+getListElement = fromObj
+
+getObjectElement :: String -> JSObject JSValue
+                 -> Either String (JSObject JSValue)
+getObjectElement = fromObj
+
+asJSObject :: JSValue -> Either String (JSObject JSValue)
+asJSObject (JSObject a) = Right a
+asJSObject _ = Left "not an object"
+
+asObjectList :: [JSValue] -> Either String [JSObject JSValue]
+asObjectList =
+    ensureEitherList . map asJSObject
+
+concatEitherElems :: Either String String
+            -> Either String String
+            -> Either String String
+concatEitherElems = applyEither2 (\x y -> x ++ "|" ++ y)
+
+applyEither1 :: (a -> b) -> Either String a -> Either String b
+applyEither1 fn a =
+    case a of
+      Left x -> Left x
+      Right y -> Right $ fn y
+
+applyEither2 :: (a -> b -> c)
+       -> Either String a
+       -> Either String b
+       -> Either String c
+applyEither2 fn a b =
+    case (a, b) of
+      (Right x, Right y) -> Right $ fn x y
+      (Left x, _) -> Left x
+      (_, Left y) -> Left y