Commit c67b908a authored by Iustin Pop's avatar Iustin Pop
Browse files

Add a negative type



This mirrors the positive one, and will be needed for relative job
IDs.
Signed-off-by: default avatarIustin Pop <iustin@google.com>
Reviewed-by: default avatarGuido Trotter <ultrotter@google.com>
parent c48711d5
......@@ -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
......
......@@ -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)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment