Revision a4f35477

b/src/Ganeti/JSON.hs
39 39
  , asJSObject
40 40
  , asObjectList
41 41
  , tryFromObj
42
  , tryArrayMaybeFromObj
42 43
  , toArray
43 44
  , optionalJSField
44 45
  , optFieldsToObj
......
104 105
               -> m [J.JSObject J.JSValue]
105 106
loadJSArray s = fromJResult s . J.decodeStrict
106 107

  
108
-- | Helper function for missing-key errors
109
buildNoKeyError :: JSRecord -> String -> String
110
buildNoKeyError o k =
111
  printf "key '%s' not found, object contains only %s" k (show (map fst o))
112

  
107 113
-- | Reads the value of a key in a JSON object.
108 114
fromObj :: (J.JSON a, Monad m) => JSRecord -> String -> m a
109 115
fromObj o k =
110 116
  case lookup k o of
111
    Nothing -> fail $ printf "key '%s' not found, object contains only %s"
112
               k (show (map fst o))
117
    Nothing -> fail $ buildNoKeyError o k
113 118
    Just val -> fromKeyValue k val
114 119

  
115 120
-- | Reads the value of an optional key in a JSON object. Missing
......
136 141
                      JSRecord -> String -> a -> m a
137 142
fromObjWithDefault o k d = liftM (fromMaybe d) $ maybeFromObj o k
138 143

  
144
-- | Reads an array of optional items
145
arrayMaybeFromObj :: (J.JSON a, Monad m) =>
146
                     JSRecord -> String -> m [Maybe a]
147
arrayMaybeFromObj o k =
148
  case lookup k o of
149
    Just (J.JSArray xs) -> mapM parse xs
150
      where
151
        parse J.JSNull = return Nothing
152
        parse x = liftM Just $ fromJVal x
153
    _ -> fail $ buildNoKeyError o k
154

  
155
-- | Wrapper for arrayMaybeFromObj with better diagnostic
156
tryArrayMaybeFromObj :: (J.JSON a)
157
                     => String     -- ^ Textual "owner" in error messages
158
                     -> JSRecord   -- ^ The object array
159
                     -> String     -- ^ The desired key from the object
160
                     -> Result [Maybe a]
161
tryArrayMaybeFromObj t o = annotateResult t . arrayMaybeFromObj o
162

  
139 163
-- | Reads a JValue, that originated from an object key.
140 164
fromKeyValue :: (J.JSON a, Monad m)
141 165
              => String     -- ^ The key name
b/test/hs/Test/Ganeti/JSON.hs
28 28

  
29 29
module Test.Ganeti.JSON (testJSON) where
30 30

  
31
import Data.List
31 32
import Test.QuickCheck
32 33

  
33 34
import qualified Text.JSON as J
......
53 54
    BasicTypes.Bad _ -> passTest
54 55
    BasicTypes.Ok result -> failTest $ "Unexpected parse, got " ++ show result
55 56

  
57
arrayMaybeToJson :: (J.JSON a) => [Maybe a] -> String -> JSON.JSRecord
58
arrayMaybeToJson xs k = [(k, J.JSArray $ map sh xs)]
59
  where
60
    sh x = case x of
61
      Just v -> J.showJSON v
62
      Nothing -> J.JSNull
63

  
64
prop_arrayMaybeFromObj :: String -> [Maybe Int] -> String -> Property
65
prop_arrayMaybeFromObj t xs k =
66
  case JSON.tryArrayMaybeFromObj t (arrayMaybeToJson xs k) k of
67
    BasicTypes.Ok xs' -> xs' ==? xs
68
    BasicTypes.Bad e -> failTest $ "Parsing failing, got: " ++ show e
69

  
70
prop_arrayMaybeFromObjFail :: String -> String -> Property
71
prop_arrayMaybeFromObjFail t k =
72
  case JSON.tryArrayMaybeFromObj t [] k of
73
    BasicTypes.Ok r -> fail $
74
                       "Unexpected result, got: " ++ show (r::[Maybe Int])
75
    BasicTypes.Bad e -> conjoin [ Data.List.isInfixOf t e ==? True
76
                                , Data.List.isInfixOf k e ==? True
77
                                ]
78

  
56 79
testSuite "JSON"
57 80
          [ 'prop_toArray
58 81
          , 'prop_toArrayFail
82
          , 'prop_arrayMaybeFromObj
83
          , 'prop_arrayMaybeFromObjFail
59 84
          ]

Also available in: Unified diff