Revision 3ad57194

b/htools/Ganeti/HTools/JSON.hs
2 2

  
3 3
{-
4 4

  
5
Copyright (C) 2009, 2010, 2011 Google Inc.
5
Copyright (C) 2009, 2010, 2011, 2012 Google Inc.
6 6

  
7 7
This program is free software; you can redistribute it and/or modify
8 8
it under the terms of the GNU General Public License as published by
......
34 34
  , asJSObject
35 35
  , asObjectList
36 36
  , tryFromObj
37
  , toArray
37 38
  )
38 39
  where
39 40

  
......
126 127
           -> String     -- ^ The desired key from the object
127 128
           -> Result a
128 129
tryFromObj t o = annotateResult t . fromObj o
130

  
131
-- | Ensure a given JSValue is actually a JSArray.
132
toArray :: (Monad m) => J.JSValue -> m [J.JSValue]
133
toArray (J.JSArray arr) = return arr
134
toArray o = fail $ "Invalid input, expected array but got " ++ show o
b/htools/Ganeti/HTools/QC.hs
39 39
  , testLoader
40 40
  , testTypes
41 41
  , testCLI
42
  , testJSON
42 43
  ) where
43 44

  
44 45
import Test.QuickCheck
......
1634 1635
          , 'prop_CLI_StringArg
1635 1636
          , 'prop_CLI_stdopts
1636 1637
          ]
1638

  
1639
-- * JSON tests
1640

  
1641
prop_JSON_toArray :: [Int] -> Property
1642
prop_JSON_toArray intarr =
1643
  let arr = map J.showJSON intarr in
1644
  case JSON.toArray (J.JSArray arr) of
1645
    Types.Ok arr' -> arr ==? arr'
1646
    Types.Bad err -> failTest $ "Failed to parse array: " ++ err
1647

  
1648
prop_JSON_toArrayFail :: Int -> String -> Bool -> Property
1649
prop_JSON_toArrayFail i s b =
1650
  -- poor man's instance Arbitrary JSValue
1651
  forAll (elements [J.showJSON i, J.showJSON s, J.showJSON b]) $ \item ->
1652
  case JSON.toArray item of
1653
    Types.Bad _ -> property True
1654
    Types.Ok result -> failTest $ "Unexpected parse, got " ++ show result
1655

  
1656
testSuite "JSON"
1657
          [ 'prop_JSON_toArray
1658
          , 'prop_JSON_toArrayFail
1659
          ]
b/htools/test.hs
123 123
  , (fast, testLoader)
124 124
  , (fast, testTypes)
125 125
  , (fast, testCLI)
126
  , (fast, testJSON)
126 127
  , (slow, testCluster)
127 128
  ]
128 129

  

Also available in: Unified diff