diff --git a/htools/Ganeti/HTools/JSON.hs b/htools/Ganeti/HTools/JSON.hs index 31a6d1947f28d2f70f9505ed193ec7c081d7a1b8..684711f0756a342acfac905836a4496322470bf1 100644 --- 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 cc0c072a6b473fec6f35953a0ddeee6d41932a92..fef4f878a5f3d5a66ad374c05708d53fd1dc7b00 100644 --- 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 fe77ca72d39168dcaeb86e34847633a1b775d983..2167e0ea503eab6cf51d5e024f2cb8df2c69446b 100644 --- a/htools/test.hs +++ b/htools/test.hs @@ -123,6 +123,7 @@ allTests = , (fast, testLoader) , (fast, testTypes) , (fast, testCLI) + , (fast, testJSON) , (slow, testCluster) ]