Initial work on hail

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

diff --git a/Ganeti/HTools/Utils.hs b/Ganeti/HTools/Utils.hs
index 737b94a..d26e7c7 100644 (file)
--- a/Ganeti/HTools/Utils.hs
+++ b/Ganeti/HTools/Utils.hs
@@ -1,16 +1,35 @@
 {-| Utility functions -}
 
 {-| Utility functions -}
 

-module Ganeti.HTools.Utils where
+module Ganeti.HTools.Utils
+    (
+      debug
+    , sepSplit
+    , swapPairs
+    , varianceCoeff
+    , readData
+    , commaJoin
+    , readEitherString
+    , loadJSArray
+    , fromObj
+    , getStringElement
+    , getIntElement
+    , getBoolElement
+    , getListElement
+    , getObjectElement
+    , asJSObject
+    , asObjectList
+    , Result(Ok, Bad)
+    , fromJResult
+    , (|+)
+    ) where

 
 import Data.Either
 import Data.List
 
 import Data.Either
 import Data.List

-import qualified Data.Version
-import Monad
+import Control.Monad

 import System
 import System.IO
 import System
 import System.IO

-import System.Info
-import Text.Printf
-import qualified Ganeti.HTools.Version as Version
+import qualified Text.JSON as J
+import Text.Printf (printf)

 
 import Debug.Trace
 
 
 import Debug.Trace
 

@@ -18,18 +37,29 @@ import Debug.Trace
 debug :: Show a => a -> a
 debug x = trace (show x) x
 
 debug :: Show a => a -> a
 debug x = trace (show x) x
 

--- | Check if the given argument is Left something
-isLeft :: Either a b -> Bool
-isLeft val =
-    case val of
-      Left _ -> True
-      _ -> False

 
 

-fromLeft :: Either a b -> a
-fromLeft = either (\x -> x) (\_ -> undefined)
+{-

 
 

-fromRight :: Either a b -> b
-fromRight = either (\_ -> undefined) id
+This is similar to the JSON library Result type - *very* similar, but
+we want to use it in multiple places, so we abstract it into a
+mini-library here
+
+-}
+
+data Result a
+    = Bad String
+    | Ok a
+    deriving (Show)
+
+instance Monad Result where
+    (>>=) (Bad x) _ = Bad x
+    (>>=) (Ok x) fn = fn x
+    return = Ok
+    fail = Bad
+
+fromJResult :: Monad m => J.Result a -> m a
+fromJResult (J.Error x) = fail x
+fromJResult (J.Ok x) = return x

 
 -- | Comma-join a string list.
 commaJoin :: [String] -> String
 
 -- | Comma-join a string list.
 commaJoin :: [String] -> String

@@ -68,25 +98,57 @@ stdDev lst =
         bv = sqrt (av / (fromIntegral $ length lst))
     in bv
 
         bv = sqrt (av / (fromIntegral $ length lst))
     in bv
 

-

 -- | Coefficient of variation.
 varianceCoeff :: Floating a => [a] -> a
 varianceCoeff lst = (stdDev lst) / (fromIntegral $ length lst)
 
 -- | Coefficient of variation.
 varianceCoeff :: Floating a => [a] -> a
 varianceCoeff lst = (stdDev lst) / (fromIntegral $ length lst)
 

--- | Get a Right result or print the error and exit
-readData :: (String -> IO (Either String String)) -> String -> IO String
-readData fn host = do
-  nd <- fn host
-  when (isLeft nd) $
-       do
-         putStrLn $ fromLeft nd
+-- | Get an Ok result or print the error and exit
+readData :: Result a -> IO a
+readData nd =
+    (case nd of
+       Bad x -> do
+         putStrLn x

          exitWith $ ExitFailure 1
          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
+       Ok x -> return x)
+
+readEitherString :: (Monad m) => J.JSValue -> m String
+readEitherString v =
+    case v of
+      J.JSString s -> return $ J.fromJSString s
+      _ -> fail "Wrong JSON type"
+
+loadJSArray :: (Monad m) => String -> m [J.JSObject J.JSValue]
+loadJSArray s = fromJResult $ J.decodeStrict s
+
+fromObj :: (J.JSON a, Monad m) => String -> J.JSObject J.JSValue -> m a
+fromObj k o =
+    case lookup k (J.fromJSObject o) of
+      Nothing -> fail $ printf "key '%s' not found in %s" k (show o)
+      Just val -> fromJResult $ J.readJSON val
+
+getStringElement :: (Monad m) => String -> J.JSObject J.JSValue -> m String
+getStringElement = fromObj
+
+getIntElement :: (Monad m) => String -> J.JSObject J.JSValue -> m Int
+getIntElement = fromObj
+
+getBoolElement :: (Monad m) => String -> J.JSObject J.JSValue -> m Bool
+getBoolElement = fromObj
+
+getListElement :: (Monad m) => String -> J.JSObject J.JSValue -> m [J.JSValue]
+getListElement = fromObj
+
+getObjectElement :: (Monad m) => String -> J.JSObject J.JSValue
+                 -> m (J.JSObject J.JSValue)
+getObjectElement = fromObj
+
+asJSObject :: (Monad m) => J.JSValue -> m (J.JSObject J.JSValue)
+asJSObject (J.JSObject a) = return a
+asJSObject _ = fail "not an object"
+
+asObjectList :: (Monad m) => [J.JSValue] -> m [J.JSObject J.JSValue]
+asObjectList = sequence . map asJSObject
+
+-- | Function to concat two strings with a separator under a monad
+(|+) :: (Monad m) => m String -> m String -> m String
+(|+) = liftM2 (\x y -> x ++ "|" ++ y)