module Test.HsBindgen.Runtime.CEnum (tests) where import Control.Monad (forM_) import Data.List.NonEmpty (NonEmpty ((:|))) import Data.List.NonEmpty qualified as NonEmpty import Foreign.C qualified as FC import GHC.Show (appPrec1) import Test.Tasty (TestTree, testGroup) import Test.Tasty.ExpectedFailure (expectFail) import Test.Tasty.HUnit (testCase, (@=?)) import Test.Tasty.QuickCheck (Arbitrary (arbitrary), Property, chooseInt, counterexample, testProperty, (===)) import Text.Read (Read (readPrec), minPrec, readMaybe) import HsBindgen.Runtime.CEnum (AsCEnum (..), AsSequentialCEnum (..), CEnum (CEnumZ), CEnumException (..), SequentialCEnum) import HsBindgen.Runtime.CEnum qualified as CEnum import Test.HsBindgen.Runtime.CEnumArbitrary () import Test.Util.Tasty read_show_prop :: forall a. (Show a, Read a, Eq a) => a -> Property read_show_prop x = read (show x) === x newtype Precedence = MkPrecedence Int deriving stock Show instance Arbitrary Precedence where arbitrary = MkPrecedence <$> chooseInt (minPrec, appPrec1) readsPrec_showsPrec_prop :: forall a. (Show a, Read a, Eq a) => a -> Precedence -> Property readsPrec_showsPrec_prop x (MkPrecedence d) = counterexample errMsg isElem where parsedValues = readsPrec d (showsPrec d x "") isElem = (x,"") `elem` parsedValues errMsg = "expected element " <> show x <> " not found in possible parsed values " <> show parsedValues {------------------------------------------------------------------------------- Tests -------------------------------------------------------------------------------} tests :: TestTree tests = testGroup "HsBindgen.Runtime.CEnum" [ testGroup "CEnum" [ testNoValue , testGenSingleValue , testGenPosValue , testGenNegValue ] , testGroup "SequentialCEnum" [ testSeqSingleValue , testSeqPosValue , testSeqNegValue , testNastyValue ] ] {------------------------------------------------------------------------------- CEnum: no values -------------------------------------------------------------------------------} newtype NoValue = NoValue { _unwrapNoValue :: FC.CUInt } deriving newtype Eq instance CEnum NoValue where type CEnumZ NoValue = FC.CUInt declaredValues _ = CEnum.declaredValuesFromList [] showsUndeclared = CEnum.showsWrappedUndeclared "NoValue" readPrecUndeclared = CEnum.readPrecWrappedUndeclared "NoValue" instance Show NoValue where showsPrec = CEnum.shows instance Read NoValue where readPrec = CEnum.readPrec deriving via AsCEnum NoValue instance Bounded NoValue deriving via AsCEnum NoValue instance Enum NoValue deriving via AsCEnum NoValue instance Arbitrary NoValue testNoValue :: TestTree testNoValue = testGroup "NoValue" [ testCase "isDeclared" $ False @=? CEnum.isDeclared v1 , testCase "mkDeclared" $ Nothing @=? CEnum.mkDeclared @NoValue 1 , testCase "Show" $ "NoValue 1" @=? show v1 , testGroup "Read" [ testCase "!declared/pos" $ (Just v1) @=? readMaybe "NoValue 1" -- We inherit the behavior of downstream Read instances. For example, -- we parse negative values even for unsigned types such as -- 'FC.CUInt'. , expectFail $ testCase "!declared/neg" $ Nothing @=? readMaybe @NoValue "NoValue (-1)" , testCase "noparse" $ Nothing @=? readMaybe @NoValue "noparse" -- Similarly, we parse invalid Haskell; the same is true for derived -- instances, , expectFail $ testCase "noparse/neg" $ Nothing @=? readMaybe @NoValue "NoValue -1" , testProperty "read . show" (read_show_prop @NoValue) , testProperty "readsPrec . showsPrec" (readsPrec_showsPrec_prop @NoValue) ] , testCase "getNames" $ [] @=? CEnum.getNames v1 , testGroup "Bounded" [ testCase "minBound" $ CEnumEmpty @=?! minBound @NoValue , testCase "maxBound" $ CEnumEmpty @=?! maxBound @NoValue ] , testGroup "Enum" [ testCase "succ" $ CEnumNotDeclared 1 @=?! succ v1 , testCase "pred" $ CEnumNotDeclared 1 @=?! pred v1 , testCase "toEnum" $ CEnumNotDeclared 1 @=?! toEnum @NoValue 1 , testCase "fromEnum" $ CEnumNotDeclared 1 @=?! fromEnum v1 , testCase "enumFrom" $ CEnumNotDeclared 1 @=?! enumFrom v1 , testGroup "enumFromThen" [ testCase "from==then" $ CEnumFromEqThen 1 @=?! enumFromThen v1 v1 , testCase "!declared" $ CEnumNotDeclared 1 @=?! enumFromThen v1 v2 ] , testCase "enumFromTo" $ CEnumNotDeclared 1 @=?! enumFromTo v1 v2 , testGroup "enumFromThenTo" [ testCase "from==then" $ CEnumFromEqThen 1 @=?! enumFromThenTo v1 v1 v2 , testCase "!declared" $ CEnumNotDeclared 1 @=?! enumFromThenTo v1 v2 v2 ] ] ] where v1, v2 :: NoValue v1 = NoValue 1 v2 = NoValue 2 {------------------------------------------------------------------------------- CEnum: single value -------------------------------------------------------------------------------} newtype GenSingleValue = GenSingleValue { _unwrapGenSingleValue :: FC.CUInt } deriving newtype Eq instance CEnum GenSingleValue where type CEnumZ GenSingleValue = FC.CUInt declaredValues _ = CEnum.declaredValuesFromList [(1, "OK" :| ["SUCCESS"])] showsUndeclared = CEnum.showsWrappedUndeclared "GenSingleValue" readPrecUndeclared = CEnum.readPrecWrappedUndeclared "GenSingleValue" instance Show GenSingleValue where showsPrec = CEnum.shows instance Read GenSingleValue where readPrec = CEnum.readPrec deriving via AsCEnum GenSingleValue instance Bounded GenSingleValue deriving via AsCEnum GenSingleValue instance Enum GenSingleValue deriving via AsCEnum GenSingleValue instance Arbitrary GenSingleValue testGenSingleValue :: TestTree testGenSingleValue = testGroup "GenSingleValue" [ testGroup "isDeclared" [ testCase "True" $ True @=? CEnum.isDeclared v1 , testCase "False" $ False @=? CEnum.isDeclared v2 ] , testGroup "mkDeclared" [ testCase "declared" $ Just v1 @=? CEnum.mkDeclared 1 , testCase "!declared" $ Nothing @=? CEnum.mkDeclared @GenSingleValue 2 ] , testGroup "Show" [ testCase "declared" $ "OK" @=? show v1 , testCase "!declared" $ "GenSingleValue 2" @=? show v2 ] , testGroup "Read" [ testCase "declared/ok" $ (Just v1) @=? readMaybe "OK" , testCase "declared/sc" $ (Just v1) @=? readMaybe "SUCCESS" , testCase "declared/parentheses" $ (Just v1) @=? readMaybe "(OK)" , testCase "declared/parentheses/spaces" $ (Just v1) @=? readMaybe "( OK )" , testCase "declared/spaces" $ (Just v1) @=? readMaybe " OK " , testCase "!declared" $ (Just v2) @=? readMaybe "GenSingleValue 2" , testCase "noParse" $ Nothing @=? readMaybe @GenSingleValue "noParse" , testProperty "read . show" (read_show_prop @GenSingleValue) , testProperty "readsPrec . showsPrec" (readsPrec_showsPrec_prop @GenSingleValue) ] , testGroup "getNames" [ testCase "declared" $ ["OK", "SUCCESS"] @=? CEnum.getNames v1 , testCase "!declared" $ [] @=? CEnum.getNames v2 ] , testGroup "Bounded" [ testCase "minBound" $ v1 @=? minBound , testCase "maxBound" $ v1 @=? maxBound ] , testGroup "Enum" [ testGroup "succ" [ testCase "!successor" $ CEnumNoSuccessor 1 @=?! succ v1 , testCase "!declared" $ CEnumNotDeclared 2 @=?! succ v2 ] , testGroup "pred" [ testCase "!predecessor" $ CEnumNoPredecessor 1 @=?! pred v1 , testCase "!declared" $ CEnumNotDeclared 2 @=?! pred v2 ] , testGroup "toEnum" [ testCase "declared" $ v1 @=? toEnum 1 , testCase "!declared" $ CEnumNotDeclared 2 @=?! toEnum @GenSingleValue 2 ] , testGroup "fromEnum" [ testCase "declared" $ 1 @=? fromEnum v1 , testCase "!declared" $ CEnumNotDeclared 2 @=?! fromEnum v2 ] , testGroup "enumFrom" [ testCase "declared" $ [v1] @=? enumFrom v1 , testCase "!declared" $ CEnumNotDeclared 2 @=?! enumFrom v2 ] , testGroup "enumFromThen" [ testCase "from==then" $ CEnumFromEqThen 1 @=?! enumFromThen v1 v1 , testCase "!declared from" $ CEnumNotDeclared 2 @=?! enumFromThen v2 v1 , testCase "!declared then" $ CEnumNotDeclared 2 @=?! enumFromThen v1 v2 ] , testGroup "enumFromTo" [ testCase "declared" $ [v1] @=? enumFromTo v1 v1 , testCase "!declared from" $ CEnumNotDeclared 2 @=?! enumFromTo v2 v1 , testCase "!declared to" $ CEnumNotDeclared 2 @=?! enumFromTo v1 v2 ] , testGroup "enumFromThenTo" [ testCase "from==then" $ CEnumFromEqThen 1 @=?! enumFromThenTo v1 v1 v2 , testCase "!declared from" $ CEnumNotDeclared 2 @=?! enumFromThenTo v2 v1 v1 , testCase "!declared then" $ CEnumNotDeclared 2 @=?! enumFromThenTo v1 v2 v2 ] ] ] where v1, v2 :: GenSingleValue v1 = GenSingleValue 1 v2 = GenSingleValue 2 {------------------------------------------------------------------------------- CEnum: positive values -------------------------------------------------------------------------------} newtype GenPosValue = GenPosValue { _unwrapGenPosValue :: FC.CUInt } deriving newtype Eq instance CEnum GenPosValue where type CEnumZ GenPosValue = FC.CUInt declaredValues _ = CEnum.declaredValuesFromList [ (100, NonEmpty.singleton "CONTINUE") , (101, NonEmpty.singleton "SWITCHING_PROTOCOLS") , (200, NonEmpty.singleton "OK") , (201, NonEmpty.singleton "CREATED") , (202, NonEmpty.singleton "ACCEPTED") , (301, NonEmpty.singleton "MOVED_PERMANENTLY") , (400, NonEmpty.singleton "BAD_REQUEST") , (401, NonEmpty.singleton "UNAUTHORIZED") , (403, NonEmpty.singleton "FORBIDDEN") , (404, NonEmpty.singleton "NOT_FOUND") ] showsUndeclared = CEnum.showsWrappedUndeclared "GenPosValue" readPrecUndeclared = CEnum.readPrecWrappedUndeclared "GenPosValue" instance Show GenPosValue where showsPrec = CEnum.shows instance Read GenPosValue where readPrec = CEnum.readPrec deriving via AsCEnum GenPosValue instance Bounded GenPosValue deriving via AsCEnum GenPosValue instance Enum GenPosValue deriving via AsCEnum GenPosValue instance Arbitrary GenPosValue testGenPosValue :: TestTree testGenPosValue = testGroup "GenPosValue" [ testGroup "isDeclared" [ testCase "declared" $ True @=? CEnum.isDeclared v301 , testCase "!declared" $ False @=? CEnum.isDeclared v300 ] , testGroup "mkDeclared" [ testCase "declared" $ Just v301 @=? CEnum.mkDeclared 301 , testCase "!declared" $ Nothing @=? CEnum.mkDeclared @GenPosValue 300 ] , testGroup "Show" [ testCase "declared" $ "OK" @=? show v200 , testCase "!declared" $ "GenPosValue 300" @=? show v300 ] , testGroup "Read" [ testCase "declared" $ (Just v200) @=? readMaybe "OK" , testCase "declared/parentheses" $ (Just v200) @=? readMaybe "(OK)" , testCase "declared/parentheses/spaces" $ (Just v200) @=? readMaybe "( OK )" , testCase "declared/spaces" $ (Just $ v200) @=? readMaybe " OK " , testCase "!declared" $ (Just v300) @=? readMaybe "GenPosValue 300" , testCase "noparse" $ Nothing @=? readMaybe @GenPosValue "noparse" , testProperty "read . show" (read_show_prop @GenPosValue) , testProperty "readsPrec . showsPrec" (readsPrec_showsPrec_prop @GenPosValue) ] , testGroup "getNames" [ testCase "declared" $ ["OK"] @=? CEnum.getNames v200 , testCase "!declared" $ [] @=? CEnum.getNames v300 ] , testGroup "Bounded" [ testCase "minBound" $ v100 @=? minBound , testCase "maxBound" $ v404 @=? maxBound ] , testGroup "Enum" [ testGroup "succ" [ testCase "valid" $ v301 @=? succ v202 , testCase "!successor" $ CEnumNoSuccessor 404 @=?! succ v404 , testCase "!declared" $ CEnumNotDeclared 300 @=?! succ v300 ] , testGroup "pred" [ testCase "valid" $ v202 @=? pred v301 , testCase "!predecessor" $ CEnumNoPredecessor 100 @=?! pred v100 , testCase "!declared" $ CEnumNotDeclared 300 @=?! pred v300 ] , testGroup "toEnum" [ testCase "declared" $ v301 @=? toEnum 301 , testCase "!declared" $ CEnumNotDeclared 300 @=?! toEnum @GenPosValue 300 ] , testGroup "fromEnum" [ testCase "declared" $ 301 @=? fromEnum v301 , testCase "!declared" $ CEnumNotDeclared 300 @=?! fromEnum v300 ] , testGroup "enumFrom" [ testCase "valid" $ [v301, v400, v401, v403, v404] @=? enumFrom v301 , testCase "max" $ [v404] @=? enumFrom v404 , testCase "!declared" $ CEnumNotDeclared 300 @=?! enumFrom v300 ] , testGroup "enumFromThen" [ testCase "increasing 1" $ [v301, v400, v401, v403, v404] @=? enumFromThen v301 v400 , testCase "increasing 2" $ [v200, v202, v400, v403] @=? enumFromThen v200 v202 , testCase "increasing 3" $ [v101, v202, v401] @=? enumFromThen v101 v202 , testCase "decreasing 1" $ [v202, v201, v200, v101, v100] @=? enumFromThen v202 v201 , testCase "decreasing 2" $ [v404, v401, v301, v201, v101] @=? enumFromThen v404 v401 , testCase "decreasing 3" $ [v403, v301, v200] @=? enumFromThen v403 v301 , testCase "from==then" $ CEnumFromEqThen 200 @=?! enumFromThen v200 v200 , testCase "!declared from" $ CEnumNotDeclared 300 @=?! enumFromThen v300 v404 , testCase "!declared then" $ CEnumNotDeclared 300 @=?! enumFromThen v200 v300 ] , testGroup "enumFromTo" [ testCase "valid" $ [v202, v301, v400, v401] @=? enumFromTo v202 v401 , testCase "!declared from" $ CEnumNotDeclared 300 @=?! enumFromTo v300 v401 , testCase "!declared to" $ CEnumNotDeclared 300 @=?! enumFromTo v200 v300 ] , testGroup "enumFromThenTo" [ testCase "increasing 1" $ [v301, v400, v401] @=? enumFromThenTo v301 v400 v401 , testCase "increasing 2" $ [v200, v202, v400] @=? enumFromThenTo v200 v202 v401 , testCase "increasing 3" $ [v100, v201, v400] @=? enumFromThenTo v100 v201 v403 , testCase "decreasing 1" $ [v202, v201, v200] @=? enumFromThenTo v202 v201 v200 , testCase "decreasing 2" $ [v404, v401, v301, v201] @=? enumFromThenTo v404 v401 v200 , testCase "decreasing 3" $ [v404, v400, v201] @=? enumFromThenTo v404 v400 v200 , testCase "from==then" $ CEnumFromEqThen 200 @=?! enumFromThenTo v200 v200 v400 , testCase "!declared from" $ CEnumNotDeclared 300 @=?! enumFromThenTo v300 v400 v403 , testCase "!declared then" $ CEnumNotDeclared 300 @=?! enumFromThenTo v200 v300 v400 , testCase "!declared to" $ CEnumNotDeclared 300 @=?! enumFromThenTo v100 v200 v300 ] ] ] where v100, v101, v200, v201, v202, v301, v400, v401, v403, v404 :: GenPosValue v100 = GenPosValue 100 v101 = GenPosValue 101 v200 = GenPosValue 200 v201 = GenPosValue 201 v202 = GenPosValue 202 v301 = GenPosValue 301 v400 = GenPosValue 400 v401 = GenPosValue 401 v403 = GenPosValue 403 v404 = GenPosValue 404 v300 :: GenPosValue v300 = GenPosValue 300 {------------------------------------------------------------------------------- CEnum: negative values -------------------------------------------------------------------------------} newtype GenNegValue = GenNegValue { _unwrapGenNegValue :: FC.CInt } deriving newtype Eq instance CEnum GenNegValue where type CEnumZ GenNegValue = FC.CInt declaredValues _ = CEnum.declaredValuesFromList [ (-201, NonEmpty.singleton "REALLY_TERRIBLE") , (-200, NonEmpty.singleton "TERRIBLE") , (-101, NonEmpty.singleton "REALLY_BAD") , (-100, NonEmpty.singleton "BAD") , (0, "NEUTRAL" :| ["UNREMARKABLE"]) , (100, NonEmpty.singleton "GOOD") , (101, NonEmpty.singleton "REALLY_GOOD") , (200, NonEmpty.singleton "GREAT") , (201, NonEmpty.singleton "REALLY_GREAT") ] showsUndeclared = CEnum.showsWrappedUndeclared "GenNegValue" readPrecUndeclared = CEnum.readPrecWrappedUndeclared "GenNegValue" instance Show GenNegValue where showsPrec = CEnum.shows instance Read GenNegValue where readPrec = CEnum.readPrec deriving via AsCEnum GenNegValue instance Bounded GenNegValue deriving via AsCEnum GenNegValue instance Enum GenNegValue deriving via AsCEnum GenNegValue instance Arbitrary GenNegValue testGenNegValue :: TestTree testGenNegValue = testGroup "GenNegValue" [ testGroup "isDeclared" [ testCase "declared" $ True @=? CEnum.isDeclared n100 , testCase "!declared" $ False @=? CEnum.isDeclared n202 ] , testGroup "mkDeclared" [ testCase "declared" $ Just n100 @=? CEnum.mkDeclared (-100) , testCase "!declared" $ Nothing @=? CEnum.mkDeclared @GenNegValue 300 ] , testGroup "Show" [ testCase "declared" $ "NEUTRAL" @=? show z , testCase "!declared" $ "GenNegValue (-202)" @=? show n202 ] , testGroup "Read" [ testCase "declared" $ (Just $ GenNegValue 0) @=? readMaybe "NEUTRAL" , testCase "declared/parentheses" $ (Just p200) @=? readMaybe "(GREAT)" , testCase "declared/parentheses/spaces" $ (Just p200) @=? readMaybe "( GREAT )" , testCase "declared/spaces" $ (Just n100) @=? readMaybe " BAD " , testCase "!declared" $ (Just n100) @=? readMaybe "GenNegValue (-100)" , testCase "noparse" $ Nothing @=? readMaybe @GenNegValue "noparse" , testProperty "read . show" (read_show_prop @GenNegValue) , testProperty "readsPrec . showsPrec" (readsPrec_showsPrec_prop @GenNegValue) ] , testGroup "getNames" [ testCase "declared" $ ["NEUTRAL", "UNREMARKABLE"] @=? CEnum.getNames z , testCase "!declared" $ [] @=? CEnum.getNames n202 ] , testGroup "Bounded" [ testCase "minBound" $ n201 @=? minBound , testCase "maxBound" $ p201 @=? maxBound ] , testGroup "Enum" [ testGroup "succ" [ testCase "valid" $ n101 @=? succ n200 , testCase "!successor" $ CEnumNoSuccessor 201 @=?! succ p201 , testCase "!declared" $ CEnumNotDeclared (-202) @=?! succ n202 ] , testGroup "pred" [ testCase "valid" $ n100 @=? pred z , testCase "!predecessor" $ CEnumNoPredecessor (-201) @=?! pred n201 , testCase "!declared" $ CEnumNotDeclared 202 @=?! pred p202 ] , testGroup "toEnum" [ testCase "declared" $ n101 @=? toEnum (-101) , testCase "!declared" $ CEnumNotDeclared (-102) @=?! toEnum @GenNegValue (-102) ] , testGroup "fromEnum" [ testCase "declared" $ 101 @=? fromEnum p101 , testCase "!declared" $ CEnumNotDeclared (-202) @=?! fromEnum n202 ] , testGroup "enumFrom" [ testCase "valid" $ [n100, z, p100, p101, p200, p201] @=? enumFrom n100 , testCase "max" $ [p201] @=? enumFrom p201 , testCase "!declared" $ CEnumNotDeclared (-202) @=?! enumFrom n202 ] , testGroup "enumFromThen" [ testCase "increasing 1" $ [n101, n100, z, p100, p101, p200, p201] @=? enumFromThen n101 n100 , testCase "increasing 2" $ [n101, z, p101, p201] @=? enumFromThen n101 z , testCase "increasing 3" $ [n101, p100, p201] @=? enumFromThen n101 p100 , testCase "decreasing 1" $ [p100, z, n100, n101, n200, n201] @=? enumFromThen p100 z , testCase "decreasing 2" $ [p100, n100, n200] @=? enumFromThen p100 n100 , testCase "decreasing 3" $ [p201, p100, n101] @=? enumFromThen p201 p100 , testCase "from==then" $ CEnumFromEqThen (-100) @=?! enumFromThen n100 n100 , testCase "!declared from" $ CEnumNotDeclared (-202) @=?! enumFromThen n202 n200 , testCase "!declared then" $ CEnumNotDeclared 202 @=?! enumFromThen p200 p202 ] , testGroup "enumFromTo" [ testCase "valid" $ [n101, n100, z, p100, p101] @=? enumFromTo n101 p101 , testCase "!declared from" $ CEnumNotDeclared (-202) @=?! enumFromTo n202 p101 , testCase "!declared to" $ CEnumNotDeclared 202 @=?! enumFromTo n101 p202 ] , testGroup "enumFromThenTo" [ testCase "increasing 1" $ [n101, n100, z, p100, p101] @=? enumFromThenTo n101 n100 p101 , testCase "increasing 2" $ [n101, z, p101] @=? enumFromThenTo n101 z p200 , testCase "increasing 3" $ [n201, n100] @=? enumFromThenTo n201 n100 p100 , testCase "decreasing 1" $ [p101, p100, z, n100, n101] @=? enumFromThenTo p101 p100 n101 , testCase "decreasing 2" $ [p101, z, n101] @=? enumFromThenTo p101 z n200 , testCase "decreasing 3" $ [p201, p100] @=? enumFromThenTo p201 p100 n100 , testCase "from==then" $ CEnumFromEqThen (-101) @=?! enumFromThenTo n101 n101 p100 , testCase "!declared from" $ CEnumNotDeclared (-202) @=?! enumFromThenTo n202 n200 p200 , testCase "!declared then" $ CEnumNotDeclared 202 @=?! enumFromThenTo z p202 p202 , testCase "!declared to" $ CEnumNotDeclared 202 @=?! enumFromThenTo z p100 p202 ] ] ] where n201, n200, n101, n100, z, p100, p101, p200, p201 :: GenNegValue n201 = GenNegValue (-201) n200 = GenNegValue (-200) n101 = GenNegValue (-101) n100 = GenNegValue (-100) z = GenNegValue 0 p100 = GenNegValue 100 p101 = GenNegValue 101 p200 = GenNegValue 200 p201 = GenNegValue 201 n202 :: GenNegValue n202 = GenNegValue (-202) p202 = GenNegValue 202 {------------------------------------------------------------------------------- SequentialCEnum: single value -------------------------------------------------------------------------------} newtype SeqSingleValue = SeqSingleValue { _unwrapSeqSingleValue :: FC.CUInt } deriving newtype Eq instance CEnum SeqSingleValue where type CEnumZ SeqSingleValue = FC.CUInt declaredValues _ = CEnum.declaredValuesFromList [(1, "OK" :| ["SUCCESS"])] showsUndeclared = CEnum.showsWrappedUndeclared "SeqSingleValue" readPrecUndeclared = CEnum.readPrecWrappedUndeclared "SeqSingleValue" instance Show SeqSingleValue where showsPrec = CEnum.shows instance Read SeqSingleValue where readPrec = CEnum.readPrec instance SequentialCEnum SeqSingleValue where minDeclaredValue = SeqSingleValue 1 maxDeclaredValue = SeqSingleValue 1 deriving via AsCEnum SeqSingleValue instance Bounded SeqSingleValue deriving via AsCEnum SeqSingleValue instance Enum SeqSingleValue deriving via AsCEnum SeqSingleValue instance Arbitrary SeqSingleValue testSeqSingleValue :: TestTree testSeqSingleValue = testGroup "SeqSingleValue" [ testGroup "isDeclared" [ testCase "True" $ True @=? CEnum.isDeclared v1 , testCase "False" $ False @=? CEnum.isDeclared v2 ] , testGroup "mkDeclared" [ testCase "declared" $ Just v1 @=? CEnum.mkDeclared 1 , testCase "!declared" $ Nothing @=? CEnum.mkDeclared @SeqSingleValue 2 ] , testGroup "Show" [ testCase "declared" $ "OK" @=? show v1 , testCase "!declared" $ "SeqSingleValue 2" @=? show v2 ] , testGroup "Read" [ testCase "declared" $ (Just v1) @=? readMaybe "OK" , testCase "!declared" $ (Just v2) @=? readMaybe "SeqSingleValue 2" , testCase "noparse" $ Nothing @=? readMaybe @SeqSingleValue "noparse" , testProperty "read . show" (read_show_prop @SeqSingleValue) , testProperty "readsPrec . showsPrec" (readsPrec_showsPrec_prop @GenSingleValue) ] , testGroup "getNames" [ testCase "declared" $ ["OK", "SUCCESS"] @=? CEnum.getNames v1 , testCase "!declared" $ [] @=? CEnum.getNames v2 ] , testGroup "Bounded" [ testCase "minBound" $ v1 @=? minBound , testCase "maxBound" $ v1 @=? maxBound ] , testGroup "Enum" [ testGroup "succ" [ testCase "!successor" $ CEnumNoSuccessor 1 @=?! succ v1 , testCase "!declared" $ CEnumNotDeclared 2 @=?! succ v2 ] , testGroup "pred" [ testCase "!predecessor" $ CEnumNoPredecessor 1 @=?! pred v1 , testCase "!declared" $ CEnumNotDeclared 2 @=?! pred v2 ] , testGroup "toEnum" [ testCase "declared" $ v1 @=? toEnum 1 , testCase "!declared" $ CEnumNotDeclared 2 @=?! toEnum @SeqSingleValue 2 ] , testGroup "fromEnum" [ testCase "declared" $ 1 @=? fromEnum v1 , testCase "!declared" $ CEnumNotDeclared 2 @=?! fromEnum v2 ] , testGroup "enumFrom" [ testCase "declared" $ [v1] @=? enumFrom v1 , testCase "!declared" $ CEnumNotDeclared 2 @=?! enumFrom v2 ] , testGroup "enumFromThen" [ testCase "from==then" $ CEnumFromEqThen 1 @=?! enumFromThen v1 v1 , testCase "!declared from" $ CEnumNotDeclared 2 @=?! enumFromThen v2 v1 , testCase "!declared then" $ CEnumNotDeclared 2 @=?! enumFromThen v1 v2 ] , testGroup "enumFromTo" [ testCase "declared" $ [v1] @=? enumFromTo v1 v1 , testCase "!declared from" $ CEnumNotDeclared 2 @=?! enumFromTo v2 v1 , testCase "!declared to" $ CEnumNotDeclared 2 @=?! enumFromTo v1 v2 ] , testGroup "enumFromThenTo" [ testCase "from==then" $ CEnumFromEqThen 1 @=?! enumFromThenTo v1 v1 v2 , testCase "!declared from" $ CEnumNotDeclared 2 @=?! enumFromThenTo v2 v1 v1 , testCase "!declared then" $ CEnumNotDeclared 2 @=?! enumFromThenTo v1 v2 v2 ] ] ] where v1, v2 :: SeqSingleValue v1 = SeqSingleValue 1 v2 = SeqSingleValue 2 {------------------------------------------------------------------------------- SequentialCEnum: positive values -------------------------------------------------------------------------------} newtype SeqPosValue = SeqPosValue { _unwrapSeqPosValue :: FC.CUInt } deriving newtype Eq instance CEnum SeqPosValue where type CEnumZ SeqPosValue = FC.CUInt declaredValues _ = CEnum.declaredValuesFromList [ (1, "A" :| ["ALPHA"]) , (2, "B" :| ["BETA"]) , (3, NonEmpty.singleton "C") , (4, NonEmpty.singleton "D") , (5, NonEmpty.singleton "E") , (6, NonEmpty.singleton "F") , (7, NonEmpty.singleton "G") , (8, NonEmpty.singleton "H") , (9, NonEmpty.singleton "I") , (10, NonEmpty.singleton "J") ] showsUndeclared = CEnum.showsWrappedUndeclared "SeqPosValue" readPrecUndeclared = CEnum.readPrecWrappedUndeclared "SeqPosValue" instance Show SeqPosValue where showsPrec = CEnum.shows instance Read SeqPosValue where readPrec = CEnum.readPrec instance SequentialCEnum SeqPosValue where minDeclaredValue = SeqPosValue 1 maxDeclaredValue = SeqPosValue 10 deriving via AsSequentialCEnum SeqPosValue instance Bounded SeqPosValue deriving via AsSequentialCEnum SeqPosValue instance Enum SeqPosValue deriving via AsSequentialCEnum SeqPosValue instance Arbitrary SeqPosValue testSeqPosValue :: TestTree testSeqPosValue = testGroup "SeqPosValue" [ testGroup "isDeclared" [ testCase "declared" . forM_ [1..10] $ \i -> True @=? CEnum.isDeclared (SeqPosValue i) , testCase "low" $ False @=? CEnum.isDeclared v0 , testCase "high" $ False @=? CEnum.isDeclared v11 ] , testGroup "mkDeclared" [ testCase "declared" . forM_ [1..10] $ \i -> Just (SeqPosValue i) @=? CEnum.mkDeclared i , testCase "low" $ Nothing @=? CEnum.mkDeclared @SeqPosValue 0 , testCase "high" $ Nothing @=? CEnum.mkDeclared @SeqPosValue 11 ] , testGroup "Show" [ testCase "declared" $ "A" @=? show v1 , testCase "!declared" $ "SeqPosValue 0" @=? show v0 ] , testGroup "Read" [ testCase "declared" $ (Just v3) @=? readMaybe "C" , testCase "!declared" $ (Just v11) @=? readMaybe "SeqPosValue 11" , testCase "noparse" $ Nothing @=? readMaybe @SeqPosValue "noparse" , testProperty "read . show" (read_show_prop @SeqPosValue) , testProperty "readsPrec . showsPrec" (readsPrec_showsPrec_prop @SeqPosValue) ] , testGroup "getNames" [ testCase "declared" $ ["A", "ALPHA"] @=? CEnum.getNames v1 , testCase "!declared" $ [] @=? CEnum.getNames v0 ] , testGroup "Bounded" [ testCase "minBound" $ v1 @=? minBound , testCase "maxBound" $ v10 @=? maxBound ] , testGroup "Enum" [ testGroup "succ" [ testCase "valid" . forM_ [1..9] $ \i -> SeqPosValue (i + 1) @=? succ (SeqPosValue i) , testCase "max" $ CEnumNoSuccessor 10 @=?! succ v10 , testCase "low" $ CEnumNotDeclared 0 @=?! succ v0 , testCase "high" $ CEnumNotDeclared 11 @=?! succ v11 ] , testGroup "pred" [ testCase "valid" . forM_ [2..10] $ \i -> SeqPosValue (i - 1) @=? pred (SeqPosValue i) , testCase "min" $ CEnumNoPredecessor 1 @=?! pred v1 , testCase "low" $ CEnumNotDeclared 0 @=?! pred v0 , testCase "high" $ CEnumNotDeclared 11 @=?! pred v11 ] , testGroup "toEnum" [ testCase "declared" . forM_ [1..10] $ \i -> SeqPosValue (fromIntegral i) @=? toEnum i , testCase "low" $ CEnumNotDeclared 0 @=?! toEnum @SeqPosValue 0 , testCase "high" $ CEnumNotDeclared 11 @=?! toEnum @SeqPosValue 11 ] , testGroup "fromEnum" [ testCase "declared" . forM_ [1..10] $ \i -> fromIntegral i @=? fromEnum (SeqPosValue i) , testCase "low" $ CEnumNotDeclared 0 @=?! fromEnum v0 , testCase "high" $ CEnumNotDeclared 11 @=?! fromEnum v11 ] , testGroup "enumFrom" [ testCase "valid" $ [SeqPosValue i | i <- [5..10]] @=? enumFrom v5 , testCase "max" $ [SeqPosValue 10] @=? enumFrom v10 , testCase "low" $ CEnumNotDeclared 0 @=?! enumFrom v0 , testCase "high" $ CEnumNotDeclared 11 @=?! enumFrom v11 ] , testGroup "enumFromThen" [ testCase "increasing" $ [SeqPosValue i | i <- [2, 4 .. 10]] @=? enumFromThen v2 v4 , testCase "decreasing" $ [SeqPosValue i | i <- [10, 6 .. 1]] @=? enumFromThen v10 v6 , testCase "from==then" $ CEnumFromEqThen 2 @=?! enumFromThen v2 v2 , testCase "!declared from" $ CEnumNotDeclared 0 @=?! enumFromThen v0 v1 , testCase "!declared then" $ CEnumNotDeclared 11 @=?! enumFromThen v5 v11 ] , testGroup "enumFromTo" [ testCase "valid" $ [SeqPosValue i | i <- [4..6]] @=? enumFromTo v4 v6 , testCase "!declared from" $ CEnumNotDeclared 0 @=?! enumFromTo v0 v5 , testCase "!declared to" $ CEnumNotDeclared 11 @=?! enumFromTo v5 v11 ] , testGroup "enumFromThenTo" [ testCase "increasing" $ [SeqPosValue i | i <- [2, 4 .. 9]] @=? enumFromThenTo v2 v4 v9 , testCase "decreasing" $ [SeqPosValue i | i <- [10, 8 .. 4]] @=? enumFromThenTo v10 v8 v4 , testCase "from==then" $ CEnumFromEqThen 2 @=?! enumFromThenTo v2 v2 v9 , testCase "!declared from" $ CEnumNotDeclared 0 @=?! enumFromThenTo v0 v2 v9 , testCase "!declared then" $ CEnumNotDeclared 11 @=?! enumFromThenTo v9 v11 v11 , testCase "!declared to" $ CEnumNotDeclared 11 @=?! enumFromThenTo v5 v9 v11 ] ] ] where v0, v1, v2, v4, v5, v6, v8, v9, v10, v11 :: SeqPosValue v0 = SeqPosValue 0 v1 = SeqPosValue 1 v2 = SeqPosValue 2 v3 = SeqPosValue 3 v4 = SeqPosValue 4 v5 = SeqPosValue 5 v6 = SeqPosValue 6 v8 = SeqPosValue 8 v9 = SeqPosValue 9 v10 = SeqPosValue 10 v11 = SeqPosValue 11 {------------------------------------------------------------------------------- SequentialCEnum: negative values -------------------------------------------------------------------------------} newtype SeqNegValue = SeqNegValue { _unwrapSeqNegValue :: FC.CInt } deriving newtype Eq instance CEnum SeqNegValue where type CEnumZ SeqNegValue = FC.CInt declaredValues _ = CEnum.declaredValuesFromList [ (-5, NonEmpty.singleton "GARBAGE") , (-4, NonEmpty.singleton "TERRIBLE") , (-3, NonEmpty.singleton "BAD") , (-2, NonEmpty.singleton "DISAPPOINTING") , (-1, NonEmpty.singleton "UGH") , (0, "NEUTRAL" :| ["UNREMARKABLE"]) , (1, NonEmpty.singleton "MEH") , (2, NonEmpty.singleton "OK") , (3, NonEmpty.singleton "GOOD") , (4, NonEmpty.singleton "GREAT") , (5, NonEmpty.singleton "SPECTACULAR") ] showsUndeclared = CEnum.showsWrappedUndeclared "SeqNegValue" readPrecUndeclared = CEnum.readPrecWrappedUndeclared "SeqNegValue" instance Show SeqNegValue where showsPrec = CEnum.shows instance Read SeqNegValue where readPrec = CEnum.readPrec instance SequentialCEnum SeqNegValue where minDeclaredValue = SeqNegValue (-5) maxDeclaredValue = SeqNegValue 5 deriving via AsSequentialCEnum SeqNegValue instance Bounded SeqNegValue deriving via AsSequentialCEnum SeqNegValue instance Enum SeqNegValue deriving via AsSequentialCEnum SeqNegValue instance Arbitrary SeqNegValue testSeqNegValue :: TestTree testSeqNegValue = testGroup "SeqNegValue" [ testGroup "isDeclared" [ testCase "declared" . forM_ [-5..5] $ \i -> True @=? CEnum.isDeclared (SeqNegValue i) , testCase "low" $ False @=? CEnum.isDeclared n6 , testCase "high" $ False @=? CEnum.isDeclared p6 ] , testGroup "mkDeclared" [ testCase "declared" . forM_ [-5..5] $ \i -> Just (SeqNegValue i) @=? CEnum.mkDeclared i , testCase "low" $ Nothing @=? CEnum.mkDeclared @SeqNegValue (-6) , testCase "high" $ Nothing @=? CEnum.mkDeclared @SeqNegValue 6 ] , testGroup "Show" [ testCase "declared" $ "NEUTRAL" @=? show z , testCase "!declared" $ "SeqNegValue (-6)" @=? show n6 ] , testGroup "Read" [ testCase "declared" $ (Just n3) @=? readMaybe "BAD" , testCase "!declared" $ (Just $ SeqNegValue (-100)) @=? readMaybe "SeqNegValue (-100)" , testCase "noparse" $ Nothing @=? readMaybe @SeqNegValue "noparse" , testProperty "read . show" (read_show_prop @SeqNegValue) , testProperty "readsPrec . showsPrec" (readsPrec_showsPrec_prop @SeqNegValue) ] , testGroup "getNames" [ testCase "declared" $ ["NEUTRAL", "UNREMARKABLE"] @=? CEnum.getNames z , testCase "!declared" $ [] @=? CEnum.getNames n6 ] , testGroup "Bounded" [ testCase "minBound" $ n5 @=? minBound , testCase "maxBound" $ p5 @=? maxBound ] , testGroup "Enum" [ testGroup "succ" [ testCase "valid" . forM_ [-5..4] $ \i -> SeqNegValue (i + 1) @=? succ (SeqNegValue i) , testCase "max" $ CEnumNoSuccessor 5 @=?! succ p5 , testCase "low" $ CEnumNotDeclared (-6) @=?! succ n6 , testCase "high" $ CEnumNotDeclared 6 @=?! succ p6 ] , testGroup "pred" [ testCase "valid" . forM_ [-4..5] $ \i -> SeqNegValue (i - 1) @=? pred (SeqNegValue i) , testCase "min" $ CEnumNoPredecessor (-5) @=?! pred n5 , testCase "low" $ CEnumNotDeclared (-6) @=?! pred n6 , testCase "high" $ CEnumNotDeclared 6 @=?! pred p6 ] , testGroup "toEnum" [ testCase "declared" . forM_ [-5..5] $ \i -> SeqNegValue (fromIntegral i) @=? toEnum i , testCase "low" $ CEnumNotDeclared (-6) @=?! toEnum @SeqNegValue (-6) , testCase "high" $ CEnumNotDeclared 6 @=?! toEnum @SeqNegValue 6 ] , testGroup "fromEnum" [ testCase "declared" . forM_ [-5..5] $ \i -> fromIntegral i @=? fromEnum (SeqNegValue i) , testCase "low" $ CEnumNotDeclared (-6) @=?! fromEnum n6 , testCase "high" $ CEnumNotDeclared 6 @=?! fromEnum p6 ] , testGroup "enumFrom" [ testCase "valid" $ [SeqNegValue i | i <- [-1..5]] @=? enumFrom n1 , testCase "max" $ [SeqNegValue 5] @=? enumFrom p5 , testCase "low" $ CEnumNotDeclared (-6) @=?! enumFrom n6 , testCase "high" $ CEnumNotDeclared 6 @=?! enumFrom p6 ] , testGroup "enumFromThen" [ testCase "increasing" $ [SeqNegValue i | i <- [-3, -1 .. 5]] @=? enumFromThen n3 n1 , testCase "decreasing" $ [SeqNegValue i | i <- [4, 1 .. -5]] @=? enumFromThen p4 p1 , testCase "from==then" $ CEnumFromEqThen (-3) @=?! enumFromThen n3 n3 , testCase "!declared from" $ CEnumNotDeclared (-6) @=?! enumFromThen n6 n3 , testCase "!declared then" $ CEnumNotDeclared 6 @=?! enumFromThen n1 p6 ] , testGroup "enumFromTo" [ testCase "valid" $ [SeqNegValue i | i <- [-3..3]] @=? enumFromTo n3 p3 , testCase "!declared from" $ CEnumNotDeclared (-6) @=?! enumFromTo n6 p1 , testCase "!declared to" $ CEnumNotDeclared 6 @=?! enumFromTo n1 p6 ] , testGroup "enumFromThenTo" [ testCase "increasing" $ [SeqNegValue i | i <- [-3, -1 .. 4]] @=? enumFromThenTo n3 n1 p4 , testCase "decreasing" $ [SeqNegValue i | i <- [5, 3 .. -3]] @=? enumFromThenTo p5 p3 n3 , testCase "from==then" $ CEnumFromEqThen (-3) @=?! enumFromThenTo n3 n3 p3 , testCase "!declared from" $ CEnumNotDeclared (-6) @=?! enumFromThenTo n6 n3 p4 , testCase "!declared then" $ CEnumNotDeclared 6 @=?! enumFromThenTo n1 p6 p6 , testCase "!declared to" $ CEnumNotDeclared 6 @=?! enumFromThenTo n3 n1 p6 ] ] ] where n6, n5, n3, n1, z, p1, p3, p4, p5, p6 :: SeqNegValue n6 = SeqNegValue (-6) n5 = SeqNegValue (-5) n3 = SeqNegValue (-3) n1 = SeqNegValue (-1) z = SeqNegValue 0 p1 = SeqNegValue 1 p3 = SeqNegValue 3 p4 = SeqNegValue 4 p5 = SeqNegValue 5 p6 = SeqNegValue 6 {------------------------------------------------------------------------------- NastiEnum -------------------------------------------------------------------------------} newtype NastyValue = NastyValue { _unwrapNastyValue :: FC.CInt } deriving newtype Eq instance CEnum NastyValue where type CEnumZ NastyValue = FC.CInt declaredValues _ = CEnum.declaredValuesFromList [ (-2, NonEmpty.singleton "Nas") , (-1, NonEmpty.singleton "NastyValueNeg") , (0, "Nasty" :| ["NastyValue"]) , (1, NonEmpty.singleton "NastyVal") , (2, NonEmpty.singleton "NastyValuePos") ] showsUndeclared = CEnum.showsWrappedUndeclared "NastyValue" readPrecUndeclared = CEnum.readPrecWrappedUndeclared "NastyValue" instance Show NastyValue where showsPrec = CEnum.shows instance Read NastyValue where readPrec = CEnum.readPrec instance SequentialCEnum NastyValue where minDeclaredValue = NastyValue (-2) maxDeclaredValue = NastyValue 2 deriving via AsSequentialCEnum NastyValue instance Bounded NastyValue deriving via AsSequentialCEnum NastyValue instance Enum NastyValue deriving via AsSequentialCEnum NastyValue instance Arbitrary NastyValue testNastyValue :: TestTree testNastyValue = testGroup "NastyValue" [ testGroup "Show" [ testCase "declared" $ "Nasty" @=? show z , testCase "!declared" $ "NastyValue (-6)" @=? show n6 ] , testGroup "Read" [ testCase "declared" $ (Just n2) @=? readMaybe "Nas" , testCase "declared" $ (Just n1) @=? readMaybe "NastyValueNeg" , testCase "declared" $ (Just z) @=? readMaybe "Nasty" , testCase "declared" $ (Just z) @=? readMaybe "NastyValue" , testCase "declared" $ (Just p1) @=? readMaybe "NastyVal" , testCase "declared" $ (Just p2) @=? readMaybe "NastyValuePos" , testCase "!declared" $ (Just $ NastyValue (-100)) @=? readMaybe "NastyValue (-100)" , testCase "!declared" $ (Just $ NastyValue (100)) @=? readMaybe "NastyValue (100)" , testCase "noparse" $ Nothing @=? readMaybe @NastyValue "noparse" , testProperty "read . show" (read_show_prop @NastyValue) , testProperty "readsPrec . showsPrec" (readsPrec_showsPrec_prop @NastyValue) ] ] where n6, n1, z, p1, p2 :: NastyValue n6 = NastyValue (-6) n2 = NastyValue (-2) n1 = NastyValue (-1) z = NastyValue 0 p1 = NastyValue 1 p2 = NastyValue 2