From 3ad57194b6c19148360ba1a50b462595a3a2be36 Mon Sep 17 00:00:00 2001
From: Iustin Pop <iustin@google.com>
Date: Sat, 5 May 2012 05:32:53 +0200
Subject: [PATCH] Add a new JSON function
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
And its associated unittests.
Signed-off-by: Iustin Pop <iustin@google.com>
Reviewed-by: RenΓ© Nussbaumer <rn@google.com>
---
htools/Ganeti/HTools/JSON.hs | 8 +++++++-
htools/Ganeti/HTools/QC.hs | 23 +++++++++++++++++++++++
htools/test.hs | 1 +
3 files changed, 31 insertions(+), 1 deletion(-)
diff --git a/htools/Ganeti/HTools/JSON.hs b/htools/Ganeti/HTools/JSON.hs
index 31a6d1947..684711f07 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 cc0c072a6..fef4f878a 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 fe77ca72d..2167e0ea5 100644
--- a/htools/test.hs
+++ b/htools/test.hs
@@ -123,6 +123,7 @@ allTests =
, (fast, testLoader)
, (fast, testTypes)
, (fast, testCLI)
+ , (fast, testJSON)
, (slow, testCluster)
]
--
GitLab