diff --git a/htest/Test/Ganeti/Types.hs b/htest/Test/Ganeti/Types.hs index 79abcef63a760da58213ebd3b6969f219ccc1cb5..281bbbbb3db61a2ed84f8ea1ca44c2e1285e0f39 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 b70d704132fc7063e6b529a157f7dbf8e80b662e..1768ab6b10726d88944206ff1f97bf72b616db93 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)