Synnefo » snf-ganeti » ganeti-local

-- 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)