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