From edb5a1c84db63393ff8fc181673dbbca206a01ad Mon Sep 17 00:00:00 2001
From: Iustin Pop <iustin@google.com>
Date: Thu, 15 Nov 2012 13:24:14 +0100
Subject: [PATCH] Add more basic validation types
This mirrors the ht.py types PositiveInt, NonNegative, etc., except
that they work at a more generic level (any numeric type, respectively
any non-empty list).
Signed-off-by: Iustin Pop <iustin@google.com>
Reviewed-by: Adeodato Simo <dato@google.com>
---
htest/Test/Ganeti/Types.hs | 67 ++++++++++++++++++++++++++++++++++++--
htools/Ganeti/Types.hs | 56 +++++++++++++++++++++++++++++++
2 files changed, 121 insertions(+), 2 deletions(-)
diff --git a/htest/Test/Ganeti/Types.hs b/htest/Test/Ganeti/Types.hs
index d4e6d4ed2..c066a22d3 100644
--- a/htest/Test/Ganeti/Types.hs
+++ b/htest/Test/Ganeti/Types.hs
@@ -31,23 +31,37 @@ module Test.Ganeti.Types
, AllocPolicy(..)
, DiskTemplate(..)
, InstanceStatus(..)
+ , NonEmpty(..)
) where
-import Test.QuickCheck
+import Test.QuickCheck as QuickCheck hiding (Result)
+import Test.HUnit
import Test.Ganeti.TestHelper
import Test.Ganeti.TestCommon
-import Ganeti.Types
+import Ganeti.BasicTypes
+import Ganeti.Types as Types
-- * Arbitrary instance
+instance (Arbitrary a, Ord a, Num a, Show a) =>
+ Arbitrary (Types.Positive a) where
+ arbitrary = do
+ (QuickCheck.Positive i) <- arbitrary
+ Types.mkPositive i
+
$(genArbitrary ''AllocPolicy)
$(genArbitrary ''DiskTemplate)
$(genArbitrary ''InstanceStatus)
+instance (Arbitrary a) => Arbitrary (Types.NonEmpty a) where
+ arbitrary = do
+ QuickCheck.NonEmpty lst <- arbitrary
+ Types.mkNonEmpty lst
+
prop_AllocPolicy_serialisation :: AllocPolicy -> Property
prop_AllocPolicy_serialisation = testSerialisation
@@ -57,8 +71,57 @@ prop_DiskTemplate_serialisation = testSerialisation
prop_InstanceStatus_serialisation :: InstanceStatus -> Property
prop_InstanceStatus_serialisation = testSerialisation
+-- | Tests building non-negative numbers.
+prop_NonNeg_pass :: QuickCheck.NonNegative Int -> Property
+prop_NonNeg_pass (QuickCheck.NonNegative i) =
+ case mkNonNegative i of
+ Bad msg -> failTest $ "Fail to build non-negative: " ++ msg
+ Ok nn -> fromNonNegative nn ==? i
+
+-- | Tests building non-negative numbers.
+prop_NonNeg_fail :: QuickCheck.Positive Int -> Property
+prop_NonNeg_fail (QuickCheck.Positive i) =
+ case mkNonNegative (negate i)::Result (Types.NonNegative Int) of
+ Bad _ -> passTest
+ Ok nn -> failTest $ "Built non-negative number '" ++ show nn ++
+ "' from negative value " ++ show i
+
+-- | Tests building positive numbers.
+prop_Positive_pass :: QuickCheck.Positive Int -> Property
+prop_Positive_pass (QuickCheck.Positive i) =
+ case mkPositive i of
+ Bad msg -> failTest $ "Fail to build positive: " ++ msg
+ Ok nn -> fromPositive nn ==? i
+
+-- | Tests building positive numbers.
+prop_Positive_fail :: QuickCheck.NonNegative Int -> Property
+prop_Positive_fail (QuickCheck.NonNegative i) =
+ case mkPositive (negate i)::Result (Types.Positive Int) of
+ Bad _ -> passTest
+ Ok nn -> failTest $ "Built positive number '" ++ show nn ++
+ "' from negative or zero value " ++ show i
+
+-- | Tests building non-empty lists.
+prop_NonEmpty_pass :: QuickCheck.NonEmptyList [Char] -> Property
+prop_NonEmpty_pass (QuickCheck.NonEmpty xs) =
+ case mkNonEmpty xs of
+ Bad msg -> failTest $ "Fail to build non-empty list: " ++ msg
+ Ok nn -> fromNonEmpty nn ==? xs
+
+-- | Tests building positive numbers.
+case_NonEmpty_fail :: Assertion
+case_NonEmpty_fail = do
+ assertEqual "building non-empty list from an empty list"
+ (Bad "Received empty value for non-empty list") (mkNonEmpty ([]::[Int]))
+
testSuite "Types"
[ 'prop_AllocPolicy_serialisation
, 'prop_DiskTemplate_serialisation
, 'prop_InstanceStatus_serialisation
+ , 'prop_NonNeg_pass
+ , 'prop_NonNeg_fail
+ , 'prop_Positive_pass
+ , 'prop_Positive_fail
+ , 'prop_NonEmpty_pass
+ , 'case_NonEmpty_fail
]
diff --git a/htools/Ganeti/Types.hs b/htools/Ganeti/Types.hs
index 9ce9aa6d8..4f1014a75 100644
--- a/htools/Ganeti/Types.hs
+++ b/htools/Ganeti/Types.hs
@@ -40,11 +40,67 @@ module Ganeti.Types
, DiskTemplate(..)
, diskTemplateToRaw
, diskTemplateFromRaw
+ , NonNegative
+ , fromNonNegative
+ , mkNonNegative
+ , Positive
+ , fromPositive
+ , mkPositive
+ , NonEmpty
+ , fromNonEmpty
+ , mkNonEmpty
) where
+import qualified Text.JSON as JSON
+
import qualified Ganeti.Constants as C
import qualified Ganeti.THH as THH
+-- * Generic types
+
+-- | Type that holds a non-negative value.
+newtype NonNegative a = NonNegative { fromNonNegative :: a }
+ deriving (Show, Read, Eq)
+
+-- | Smart constructor for 'NonNegative'.
+mkNonNegative :: (Monad m, Num a, Ord a, Show a) => a -> m (NonNegative a)
+mkNonNegative i | i >= 0 = return (NonNegative i)
+ | otherwise = fail $ "Invalid value for non-negative type '" ++
+ show i ++ "'"
+
+instance (JSON.JSON a, Num a, Ord a, Show a) => JSON.JSON (NonNegative a) where
+ showJSON = JSON.showJSON . fromNonNegative
+ readJSON v = JSON.readJSON v >>= mkNonNegative
+
+-- | Type that holds a positive value.
+newtype Positive a = Positive { fromPositive :: a }
+ deriving (Show, Read, Eq)
+
+-- | Smart constructor for 'Positive'.
+mkPositive :: (Monad m, Num a, Ord a, Show a) => a -> m (Positive a)
+mkPositive i | i > 0 = return (Positive i)
+ | otherwise = fail $ "Invalid value for positive type '" ++
+ show i ++ "'"
+
+instance (JSON.JSON a, Num a, Ord a, Show a) => JSON.JSON (Positive a) where
+ showJSON = JSON.showJSON . fromPositive
+ readJSON v = JSON.readJSON v >>= mkPositive
+
+-- | Type that holds a non-null list.
+newtype NonEmpty a = NonEmpty { fromNonEmpty :: [a] }
+ deriving (Show, Read, Eq)
+
+-- | Smart constructor for 'NonEmpty'.
+mkNonEmpty :: (Monad m) => [a] -> m (NonEmpty a)
+mkNonEmpty [] = fail "Received empty value for non-empty list"
+mkNonEmpty xs = return (NonEmpty xs)
+
+instance (JSON.JSON a) => JSON.JSON (NonEmpty a) where
+ showJSON = JSON.showJSON . fromNonEmpty
+ readJSON v = JSON.readJSON v >>= mkNonEmpty
+
+-- * Ganeti types
+
-- | Instance disk template type.
$(THH.declareSADT "DiskTemplate"
[ ("DTDiskless", 'C.dtDiskless)
--
GitLab