Add a test helper for simple JSON serialisation testing

While adding yet another JSON serialisation test, I realised that this
can be trivially abstracted; hence this patch, replacing both simple
versions (readJSON . showJSON == id) and the standard version (with
different error messages) across the tests with a single function
call.

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

htest/Test/Ganeti/HTools/Types.hs

@@ -41,7 +41,6 @@ module Test.Ganeti.HTools.Types
 import Test.QuickCheck
 
 import Control.Applicative
-import qualified Text.JSON as J
 
 import Test.Ganeti.TestHelper
 import Test.Ganeti.TestCommon
@@ -128,34 +127,19 @@ instance Arbitrary Types.IPolicy where
 -- * Test cases
 
 prop_AllocPolicy_serialisation :: Types.AllocPolicy -> Property
-prop_AllocPolicy_serialisation apol =
-  case J.readJSON (J.showJSON apol) of
-    J.Ok p -> p ==? apol
-    J.Error s -> failTest $ "Failed to deserialise: " ++ s
+prop_AllocPolicy_serialisation = testSerialisation
 
 prop_DiskTemplate_serialisation :: Types.DiskTemplate -> Property
-prop_DiskTemplate_serialisation dt =
-  case J.readJSON (J.showJSON dt) of
-    J.Ok p -> p ==? dt
-    J.Error s -> failTest $ "Failed to deserialise: " ++ s
+prop_DiskTemplate_serialisation = testSerialisation
 
 prop_ISpec_serialisation :: Types.ISpec -> Property
-prop_ISpec_serialisation ispec =
-  case J.readJSON (J.showJSON ispec) of
-    J.Ok p -> p ==? ispec
-    J.Error s -> failTest $ "Failed to deserialise: " ++ s
+prop_ISpec_serialisation = testSerialisation
 
 prop_IPolicy_serialisation :: Types.IPolicy -> Property
-prop_IPolicy_serialisation ipol =
-  case J.readJSON (J.showJSON ipol) of
-    J.Ok p -> p ==? ipol
-    J.Error s -> failTest $ "Failed to deserialise: " ++ s
+prop_IPolicy_serialisation = testSerialisation
 
 prop_EvacMode_serialisation :: Types.EvacMode -> Property
-prop_EvacMode_serialisation em =
-  case J.readJSON (J.showJSON em) of
-    J.Ok p -> p ==? em
-    J.Error s -> failTest $ "Failed to deserialise: " ++ s
+prop_EvacMode_serialisation = testSerialisation
 
 prop_opToResult :: Types.OpResult Int -> Bool
 prop_opToResult op =

htest/Test/Ganeti/Jobs.hs

@@ -30,8 +30,6 @@ module Test.Ganeti.Jobs (testJobs) where
 
 import Test.QuickCheck
 
-import qualified Text.JSON as J
-
 import Test.Ganeti.TestHelper
 import Test.Ganeti.TestCommon
 
@@ -49,16 +47,10 @@ instance Arbitrary Jobs.JobStatus where
 
 -- | Check that (queued) job\/opcode status serialization is idempotent.
 prop_OpStatus_serialization :: Jobs.OpStatus -> Property
-prop_OpStatus_serialization os =
-  case J.readJSON (J.showJSON os) of
-    J.Error e -> failTest $ "Cannot deserialise: " ++ e
-    J.Ok os' -> os ==? os'
+prop_OpStatus_serialization = testSerialisation
 
 prop_JobStatus_serialization :: Jobs.JobStatus -> Property
-prop_JobStatus_serialization js =
-  case J.readJSON (J.showJSON js) of
-    J.Error e -> failTest $ "Cannot deserialise: " ++ e
-    J.Ok js' -> js ==? js'
+prop_JobStatus_serialization = testSerialisation
 
 testSuite "Jobs"
             [ 'prop_OpStatus_serialization

htest/Test/Ganeti/Objects.hs

@@ -37,7 +37,6 @@ import Test.QuickCheck
 import Control.Applicative
 import qualified Data.Map as Map
 import qualified Data.Set as Set
-import qualified Text.JSON as J
 
 import Test.Ganeti.TestHelper
 import Test.Ganeti.TestCommon
@@ -106,13 +105,11 @@ prop_fillDict defaults custom =
 -- testing entire Disk serialisations. So this tests two things at
 -- once, basically.
 prop_Disk_serialisation :: Disk -> Property
-prop_Disk_serialisation disk =
-  J.readJSON (J.showJSON disk) ==? J.Ok disk
+prop_Disk_serialisation = testSerialisation
 
 -- | Check that node serialisation is idempotent.
 prop_Node_serialisation :: Node -> Property
-prop_Node_serialisation node =
-  J.readJSON (J.showJSON node) ==? J.Ok node
+prop_Node_serialisation = testSerialisation
 
 testSuite "Objects"
   [ 'prop_fillDict

htest/Test/Ganeti/OpCodes.hs

@@ -74,10 +74,7 @@ instance Arbitrary OpCodes.OpCode where
 
 -- | Check that opcode serialization is idempotent.
 prop_serialization :: OpCodes.OpCode -> Property
-prop_serialization op =
-  case J.readJSON (J.showJSON op) of
-    J.Error e -> failTest $ "Cannot deserialise: " ++ e
-    J.Ok op' -> op ==? op'
+prop_serialization = testSerialisation
 
 -- | Check that Python and Haskell defined the same opcode list.
 case_AllDefined :: HUnit.Assertion

htest/Test/Ganeti/Query/Language.hs

@@ -34,7 +34,6 @@ module Test.Ganeti.Query.Language
 import Test.QuickCheck
 
 import Control.Applicative
-import qualified Text.JSON as J
 
 import Test.Ganeti.TestHelper
 import Test.Ganeti.TestCommon
@@ -83,13 +82,11 @@ instance Arbitrary Qlang.FilterRegex where
 -- idempotent.
 prop_Serialisation :: Property
 prop_Serialisation =
-  forAll genFilter $ \flt ->
-  J.readJSON (J.showJSON flt) ==? J.Ok flt
+  forAll genFilter testSerialisation
 
 prop_FilterRegex_instances :: Qlang.FilterRegex -> Property
 prop_FilterRegex_instances rex =
-  printTestCase "failed JSON encoding"
-    (J.readJSON (J.showJSON rex) ==? J.Ok rex) .&&.
+  printTestCase "failed JSON encoding" (testSerialisation rex) .&&.
   printTestCase "failed read/show instances" (read (show rex) ==? rex)
 
 testSuite "Query/Language"

htest/Test/Ganeti/TestCommon.hs

@@ -31,6 +31,7 @@ import Control.Monad
 import Data.List
 import qualified Test.HUnit as HUnit
 import Test.QuickCheck
+import qualified Text.JSON as J
 import System.Environment (getEnv)
 import System.Exit (ExitCode(..))
 import System.IO.Error (isDoesNotExistError)
@@ -187,3 +188,10 @@ instance Arbitrary SmallRatio where
   arbitrary = do
     v <- choose (0, 1)
     return $ SmallRatio v
+
+-- | Checks for serialisation idempotence.
+testSerialisation :: (Eq a, Show a, J.JSON a) => a -> Property
+testSerialisation a =
+  case J.readJSON (J.showJSON a) of
+    J.Error msg -> failTest $ "Failed to deserialise: " ++ msg
+    J.Ok a' -> a ==? a'