commit 9ba5c28f70085d8cd2c853156857881802e69c0f
Author: Iustin Pop <iustin@google.com>
Date:   Mon May 18 10:24:24 2009 +0200

    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.

diff --git a/Ganeti/HTools/Rapi.hs b/Ganeti/HTools/Rapi.hs
index da1a9b5..c6db593 100644
--- a/Ganeti/HTools/Rapi.hs
+++ b/Ganeti/HTools/Rapi.hs
@@ -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)
