Revision ebf38064 htools/Ganeti/HTools/JSON.hs
| b/htools/Ganeti/HTools/JSON.hs | ||
|---|---|---|
| 22 | 22 |
-} |
| 23 | 23 |
|
| 24 | 24 |
module Ganeti.HTools.JSON |
| 25 |
( fromJResult
|
|
| 26 |
, readEitherString
|
|
| 27 |
, JSRecord
|
|
| 28 |
, loadJSArray
|
|
| 29 |
, fromObj
|
|
| 30 |
, maybeFromObj
|
|
| 31 |
, fromObjWithDefault
|
|
| 32 |
, fromJVal
|
|
| 33 |
, asJSObject
|
|
| 34 |
, asObjectList
|
|
| 35 |
)
|
|
| 36 |
where
|
|
| 25 |
( fromJResult |
|
| 26 |
, readEitherString |
|
| 27 |
, JSRecord |
|
| 28 |
, loadJSArray |
|
| 29 |
, fromObj |
|
| 30 |
, maybeFromObj |
|
| 31 |
, fromObjWithDefault |
|
| 32 |
, fromJVal |
|
| 33 |
, asJSObject |
|
| 34 |
, asObjectList |
|
| 35 |
) |
|
| 36 |
where |
|
| 37 | 37 |
|
| 38 | 38 |
import Control.Monad (liftM) |
| 39 | 39 |
import Data.Maybe (fromMaybe) |
| ... | ... | |
| 57 | 57 |
-- context of the current monad. |
| 58 | 58 |
readEitherString :: (Monad m) => J.JSValue -> m String |
| 59 | 59 |
readEitherString v = |
| 60 |
case v of
|
|
| 61 |
J.JSString s -> return $ J.fromJSString s
|
|
| 62 |
_ -> fail "Wrong JSON type"
|
|
| 60 |
case v of |
|
| 61 |
J.JSString s -> return $ J.fromJSString s |
|
| 62 |
_ -> fail "Wrong JSON type" |
|
| 63 | 63 |
|
| 64 | 64 |
-- | Converts a JSON message into an array of JSON objects. |
| 65 | 65 |
loadJSArray :: (Monad m) |
| ... | ... | |
| 71 | 71 |
-- | Reads the value of a key in a JSON object. |
| 72 | 72 |
fromObj :: (J.JSON a, Monad m) => JSRecord -> String -> m a |
| 73 | 73 |
fromObj o k = |
| 74 |
case lookup k o of
|
|
| 75 |
Nothing -> fail $ printf "key '%s' not found, object contains only %s"
|
|
| 76 |
k (show (map fst o))
|
|
| 77 |
Just val -> fromKeyValue k val
|
|
| 74 |
case lookup k o of |
|
| 75 |
Nothing -> fail $ printf "key '%s' not found, object contains only %s" |
|
| 76 |
k (show (map fst o)) |
|
| 77 |
Just val -> fromKeyValue k val |
|
| 78 | 78 |
|
| 79 | 79 |
-- | Reads the value of an optional key in a JSON object. |
| 80 | 80 |
maybeFromObj :: (J.JSON a, Monad m) => |
| 81 | 81 |
JSRecord -> String -> m (Maybe a) |
| 82 | 82 |
maybeFromObj o k = |
| 83 |
case lookup k o of
|
|
| 84 |
Nothing -> return Nothing
|
|
| 85 |
Just val -> liftM Just (fromKeyValue k val)
|
|
| 83 |
case lookup k o of |
|
| 84 |
Nothing -> return Nothing |
|
| 85 |
Just val -> liftM Just (fromKeyValue k val) |
|
| 86 | 86 |
|
| 87 | 87 |
-- | Reads the value of a key in a JSON object with a default if missing. |
| 88 | 88 |
fromObjWithDefault :: (J.JSON a, Monad m) => |
| ... | ... | |
| 100 | 100 |
-- | Small wrapper over readJSON. |
| 101 | 101 |
fromJVal :: (Monad m, J.JSON a) => J.JSValue -> m a |
| 102 | 102 |
fromJVal v = |
| 103 |
case J.readJSON v of
|
|
| 104 |
J.Error s -> fail ("Cannot convert value '" ++ show v ++
|
|
| 105 |
"', error: " ++ s)
|
|
| 106 |
J.Ok x -> return x
|
|
| 103 |
case J.readJSON v of |
|
| 104 |
J.Error s -> fail ("Cannot convert value '" ++ show v ++
|
|
| 105 |
"', error: " ++ s) |
|
| 106 |
J.Ok x -> return x |
|
| 107 | 107 |
|
| 108 | 108 |
-- | Converts a JSON value into a JSON object. |
| 109 | 109 |
asJSObject :: (Monad m) => J.JSValue -> m (J.JSObject J.JSValue) |
Also available in: Unified diff