Skip to content
Snippets Groups Projects
Commit 9ba5c28f authored by Iustin Pop's avatar Iustin Pop
Browse files

Move the JSON utilities to Utils.hs 

This patch moves the generic/reusable JSON functions to Utils.hs, so
that they're shared between RAPI/IAlloc.
parent 43643696
No related branches found
No related tags found
No related merge requests found
Hide whitespace changes
Inline Side-by-side
Ganeti/HTools/IAlloc.hs
+ 0
− 83
View file @ 9ba5c28f
......@@ -16,89 +16,6 @@ import Text.Printf (printf)
import Ganeti.HTools.Utils ()
-- Some constants
{-- 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.
-}
combine :: (Either String a) -> (a -> Either String b) -> (Either String b)
combine (Left s) _ = Left s
combine (Right s) f = f s
ensureList :: [Either String a] -> Either String [a]
ensureList 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
listHead :: Either String [a] -> Either String a
listHead lst =
case lst of
Left x -> Left x
Right (x:_) -> Right x
Right [] -> Left "List empty"
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
readString :: JSValue -> Either String String
readString v =
case v of
JSString s -> Right $ fromJSString s
_ -> Left "Wrong JSON type"
concatElems :: Either String String
-> Either String String
-> Either String String
concatElems = apply2 (\x y -> x ++ "|" ++ y)
apply1 :: (a -> b) -> Either String a -> Either String b
apply1 fn a =
case a of
Left x -> Left x
Right y -> Right $ fn y
apply2 :: (a -> b -> c)
-> Either String a
-> Either String b
-> Either String c
apply2 fn a b =
case (a, b) of
(Right x, Right y) -> Right $ fn x y
(Left x, _) -> Left x
(_, Left y) -> Left y
parseList :: (JSObject JSValue -> Either String String)
-> [JSObject JSValue]
->Either String String
parseList fn idata =
let ml = ensureList $ map fn idata
in ml `combine` (Right . unlines)
parseInstance :: JSObject JSValue -> Either String String
parseInstance a =
let name = getStringElement "name" a
......
Ganeti/HTools/Rapi.hs
+ 23
− 97
View file @ 9ba5c28f
......@@ -16,7 +16,7 @@ import Data.Maybe
import Control.Monad
import Text.JSON
import Text.Printf (printf)
import Ganeti.HTools.Utils ()
import Ganeti.HTools.Utils
-- Some constants
......@@ -24,80 +24,6 @@ import Ganeti.HTools.Utils ()
-- | The fixed drbd overhead per disk (only used with 1.2's sdx_size)
drbdOverhead = 128
{-- 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.
-}
combine :: (Either String a) -> (a -> Either String b) -> (Either String b)
combine (Left s) _ = Left s
combine (Right s) f = f s
ensureList :: [Either String a] -> Either String [a]
ensureList 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
listHead :: Either String [a] -> Either String a
listHead lst =
case lst of
Left x -> Left x
Right (x:_) -> Right x
Right [] -> Left "List empty"
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
readString :: JSValue -> Either String String
readString v =
case v of
JSString s -> Right $ fromJSString s
_ -> Left "Wrong JSON type"
concatElems :: Either String String
-> Either String String
-> Either String String
concatElems = apply2 (\x y -> x ++ "|" ++ y)
apply1 :: (a -> b) -> Either String a -> Either String b
apply1 fn a =
case a of
Left x -> Left x
Right y -> Right $ fn y
apply2 :: (a -> b -> c)
-> Either String a
-> Either String b
-> Either String c
apply2 fn a b =
case (a, b) of
(Right x, Right y) -> Right $ fn x y
(Left x, _) -> Left x
(_, Left y) -> Left y
getUrl :: String -> IO (Either String String)
getUrl url = do
(code, body) <- curlGetString url [CurlSSLVerifyPeer False,
......@@ -122,7 +48,9 @@ getInstances master =
url1 = printf "http://%s:5080/instances?bulk=1" master
in do
body <- tryRapi url1 url2
let inst = body `combine` loadJSArray `combine` (parseList parseInstance)
let inst = body `combineEithers`
loadJSArray `combineEithers`
(parseEitherList parseInstance)
return inst
getNodes :: String -> IO (Either String String)
......@@ -132,38 +60,35 @@ getNodes master =
url1 = printf "http://%s:5080/nodes?bulk=1" master
in do
body <- tryRapi url1 url2
let inst = body `combine` loadJSArray `combine` (parseList parseNode)
let inst = body `combineEithers`
loadJSArray `combineEithers`
(parseEitherList parseNode)
return inst
parseList :: (JSObject JSValue -> Either String String)
-> [JSObject JSValue]
->Either String String
parseList fn idata =
let ml = ensureList $ map fn idata
in ml `combine` (Right . unlines)
parseInstance :: JSObject JSValue -> Either String String
parseInstance a =
let name = getStringElement "name" a
disk = case getIntElement "disk_usage" a of
Left _ -> let log_sz = apply2 (+)
Left _ -> let log_sz = applyEither2 (+)
(getIntElement "sda_size" a)
(getIntElement "sdb_size" a)
in apply2 (+) log_sz (Right $ drbdOverhead * 2)
in applyEither2 (+) log_sz
(Right $ drbdOverhead * 2)
Right x -> Right x
bep = fromObj "beparams" a
pnode = getStringElement "pnode" a
snode = (listHead $ getListElement "snodes" a) `combine` readString
snode = (eitherListHead $ getListElement "snodes" a)
`combineEithers` readEitherString
mem = case bep of
Left _ -> getIntElement "admin_ram" a
Right o -> getIntElement "memory" o
running = getStringElement "status" a
in
concatElems name $
concatElems (show `apply1` mem) $
concatElems (show `apply1` disk) $
concatElems running $
concatElems pnode snode
concatEitherElems name $
concatEitherElems (show `applyEither1` mem) $
concatEitherElems (show `applyEither1` disk) $
concatEitherElems running $
concatEitherElems pnode snode
parseNode :: JSObject JSValue -> Either String String
parseNode a =
......@@ -173,8 +98,9 @@ parseNode a =
mfree = getIntElement "mfree" a
dtotal = getIntElement "dtotal" a
dfree = getIntElement "dfree" a
in concatElems name $
concatElems (show `apply1` mtotal) $
concatElems (show `apply1` mnode) $
concatElems (show `apply1` mfree) $
concatElems (show `apply1` dtotal) (show `apply1` dfree)
in concatEitherElems name $
concatEitherElems (show `applyEither1` mtotal) $
concatEitherElems (show `applyEither1` mnode) $
concatEitherElems (show `applyEither1` mfree) $
concatEitherElems (show `applyEither1` dtotal)
(show `applyEither1` dfree)
Ganeti/HTools/Utils.hs
+ 98
− 0
View file @ 9ba5c28f
......@@ -11,6 +11,19 @@ module Ganeti.HTools.Utils
, varianceCoeff
, readData
, commaJoin
, combineEithers
, ensureEitherList
, eitherListHead
, readEitherString
, parseEitherList
, loadJSArray
, fromObj
, getStringElement
, getIntElement
, getListElement
, concatEitherElems
, applyEither1
, applyEither2
) where
import Data.Either
......@@ -18,6 +31,8 @@ import Data.List
import Monad
import System
import System.IO
import Text.JSON
import Text.Printf (printf)
import Debug.Trace
......@@ -88,3 +103,86 @@ readData fn host = do
putStrLn $ fromLeft nd
exitWith $ ExitFailure 1
return $ fromRight nd
{-- 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
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
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment