module Ganeti.HTools.Utils
(
debug
- , isLeft
- , fromLeft
- , fromRight
, sepSplit
- , swapPairs
, varianceCoeff
, readData
, commaJoin
+ , readEitherString
+ , loadJSArray
+ , fromObj
+ , asJSObject
+ , asObjectList
+ , fromJResult
) where
-import Data.Either
import Data.List
-import Monad
+import Control.Monad
import System
import System.IO
+import qualified Text.JSON as J
+import Text.Printf (printf)
+
+import Ganeti.HTools.Types
import Debug.Trace
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
+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
commaSplit :: String -> [String]
commaSplit = sepSplit ','
--- | Swap a list of @(a, b)@ into @(b, a)@
-swapPairs :: [(a, b)] -> [(b, a)]
-swapPairs = map (\ (a, b) -> (b, a))
-
-- Simple and slow statistical functions, please replace with better versions
-- | Mean value of a list.
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
- return $ fromRight nd
+ 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
+
+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