From c67b908ab7d58f77efd8238309ea2b3153c4cb84 Mon Sep 17 00:00:00 2001
From: Iustin Pop <iustin@google.com>
Date: Wed, 28 Nov 2012 09:33:06 +0100
Subject: [PATCH] Add a negative type
This mirrors the positive one, and will be needed for relative job
IDs.
Signed-off-by: Iustin Pop <iustin@google.com>
Reviewed-by: Guido Trotter <ultrotter@google.com>
---
htest/Test/Ganeti/Types.hs | 24 ++++++++++++++++++++++++
htools/Ganeti/Types.hs | 17 +++++++++++++++++
2 files changed, 41 insertions(+)
diff --git a/htest/Test/Ganeti/Types.hs b/htest/Test/Ganeti/Types.hs
index 79abcef63..281bbbbb3 100644
--- a/htest/Test/Ganeti/Types.hs
+++ b/htest/Test/Ganeti/Types.hs
@@ -65,6 +65,12 @@ instance (Arbitrary a, Ord a, Num a, Show a) =>
(QuickCheck.NonNegative i) <- arbitrary
Types.mkNonNegative i
+instance (Arbitrary a, Ord a, Num a, Show a) =>
+ Arbitrary (Types.Negative a) where
+ arbitrary = do
+ (QuickCheck.Positive i) <- arbitrary
+ Types.mkNegative $ negate i
+
instance (Arbitrary a) => Arbitrary (Types.NonEmpty a) where
arbitrary = do
QuickCheck.NonEmpty lst <- arbitrary
@@ -158,6 +164,22 @@ prop_Positive_fail (QuickCheck.NonNegative i) =
Ok nn -> failTest $ "Built positive number '" ++ show nn ++
"' from negative or zero value " ++ show i
+-- | Tests building negative numbers.
+prop_Neg_pass :: QuickCheck.Positive Int -> Property
+prop_Neg_pass (QuickCheck.Positive i) =
+ case mkNegative i' of
+ Bad msg -> failTest $ "Fail to build negative: " ++ msg
+ Ok nn -> fromNegative nn ==? i'
+ where i' = negate i
+
+-- | Tests building negative numbers.
+prop_Neg_fail :: QuickCheck.NonNegative Int -> Property
+prop_Neg_fail (QuickCheck.NonNegative i) =
+ case mkNegative i::Result (Types.Negative Int) of
+ Bad _ -> passTest
+ Ok nn -> failTest $ "Built negative number '" ++ show nn ++
+ "' from non-negative value " ++ show i
+
-- | Tests building non-empty lists.
prop_NonEmpty_pass :: QuickCheck.NonEmptyList String -> Property
prop_NonEmpty_pass (QuickCheck.NonEmpty xs) =
@@ -293,6 +315,8 @@ testSuite "Types"
, 'prop_NonNeg_fail
, 'prop_Positive_pass
, 'prop_Positive_fail
+ , 'prop_Neg_pass
+ , 'prop_Neg_fail
, 'prop_NonEmpty_pass
, 'case_NonEmpty_fail
, 'prop_MigrationMode_serialisation
diff --git a/htools/Ganeti/Types.hs b/htools/Ganeti/Types.hs
index b70d70413..1768ab6b1 100644
--- a/htools/Ganeti/Types.hs
+++ b/htools/Ganeti/Types.hs
@@ -46,6 +46,9 @@ module Ganeti.Types
, Positive
, fromPositive
, mkPositive
+ , Negative
+ , fromNegative
+ , mkNegative
, NonEmpty
, fromNonEmpty
, mkNonEmpty
@@ -116,6 +119,20 @@ 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 negative value.
+newtype Negative a = Negative { fromNegative :: a }
+ deriving (Show, Eq)
+
+-- | Smart constructor for 'Negative'.
+mkNegative :: (Monad m, Num a, Ord a, Show a) => a -> m (Negative a)
+mkNegative i | i < 0 = return (Negative i)
+ | otherwise = fail $ "Invalid value for negative type '" ++
+ show i ++ "'"
+
+instance (JSON.JSON a, Num a, Ord a, Show a) => JSON.JSON (Negative a) where
+ showJSON = JSON.showJSON . fromNegative
+ readJSON v = JSON.readJSON v >>= mkNegative
+
-- | Type that holds a non-null list.
newtype NonEmpty a = NonEmpty { fromNonEmpty :: [a] }
deriving (Show, Eq)
--
GitLab