Add a new JSON function

And its associated unittests.

Signed-off-by: Iustin Pop <iustin@google.com>
Reviewed-by: René Nussbaumer <rn@google.com>

diff --git a/htools/Ganeti/HTools/JSON.hs b/htools/Ganeti/HTools/JSON.hs
index 31a6d19..684711f 100644 (file)
--- a/htools/Ganeti/HTools/JSON.hs
+++ b/htools/Ganeti/HTools/JSON.hs
@@ -2,7 +2,7 @@
 
 {-
 
-Copyright (C) 2009, 2010, 2011 Google Inc.
+Copyright (C) 2009, 2010, 2011, 2012 Google Inc.
 
 This program is free software; you can redistribute it and/or modify
 it under the terms of the GNU General Public License as published by
@@ -34,6 +34,7 @@ module Ganeti.HTools.JSON
   , asJSObject
   , asObjectList
   , tryFromObj
+  , toArray
   )
   where
 
@@ -126,3 +127,8 @@ tryFromObj :: (J.JSON a) =>
            -> String     -- ^ The desired key from the object
            -> Result a
 tryFromObj t o = annotateResult t . fromObj o
+
+-- | Ensure a given JSValue is actually a JSArray.
+toArray :: (Monad m) => J.JSValue -> m [J.JSValue]
+toArray (J.JSArray arr) = return arr
+toArray o = fail $ "Invalid input, expected array but got " ++ show o

diff --git a/htools/Ganeti/HTools/QC.hs b/htools/Ganeti/HTools/QC.hs
index cc0c072..fef4f87 100644 (file)
--- a/htools/Ganeti/HTools/QC.hs
+++ b/htools/Ganeti/HTools/QC.hs
@@ -39,6 +39,7 @@ module Ganeti.HTools.QC
   , testLoader
   , testTypes
   , testCLI
+  , testJSON
   ) where
 
 import Test.QuickCheck
@@ -1634,3 +1635,25 @@ testSuite "CLI"
           , 'prop_CLI_StringArg
           , 'prop_CLI_stdopts
           ]
+
+-- * JSON tests
+
+prop_JSON_toArray :: [Int] -> Property
+prop_JSON_toArray intarr =
+  let arr = map J.showJSON intarr in
+  case JSON.toArray (J.JSArray arr) of
+    Types.Ok arr' -> arr ==? arr'
+    Types.Bad err -> failTest $ "Failed to parse array: " ++ err
+
+prop_JSON_toArrayFail :: Int -> String -> Bool -> Property
+prop_JSON_toArrayFail i s b =
+  -- poor man's instance Arbitrary JSValue
+  forAll (elements [J.showJSON i, J.showJSON s, J.showJSON b]) $ \item ->
+  case JSON.toArray item of
+    Types.Bad _ -> property True
+    Types.Ok result -> failTest $ "Unexpected parse, got " ++ show result
+
+testSuite "JSON"
+          [ 'prop_JSON_toArray
+          , 'prop_JSON_toArrayFail
+          ]

diff --git a/htools/test.hs b/htools/test.hs
index fe77ca7..2167e0e 100644 (file)
--- a/htools/test.hs
+++ b/htools/test.hs
@@ -123,6 +123,7 @@ allTests =
   , (fast, testLoader)
   , (fast, testTypes)
   , (fast, testCLI)
+  , (fast, testJSON)
   , (slow, testCluster)
   ]