feat[core]: Function Property: Argument modification

test/Spec.hs

@@ -1,10 +1,16 @@
 {-# LANGUAGE Unsafe #-} -- unsafe: Uses functions imported from unsafe modules
-import Test.Data.Map.Implicit qualified
+
+-- library
 import Test.Tasty qualified as Tasty
 
+-- test groups
+import Test.Data.Map.Implicit qualified
+import Test.Language.Scalie.Domain.Type.Function.ArgumentModification qualified
+
 main :: IO ()
 main = Tasty.defaultMain $ Tasty.testGroup "all"
   [ Tasty.testGroup "Properties"
     [ Test.Data.Map.Implicit.testGroup
+    , Test.Language.Scalie.Domain.Type.Function.ArgumentModification.testGroup
     ]
   ]

test/Test/Data/Map/Implicit.hs

@@ -18,6 +18,7 @@ import Test.Tasty.QuickCheck (QuickCheckMaxSize(QuickCheckMaxSize))
 
 import Test.Tasty qualified as Tasty
 import Test.Tasty.QuickCheck qualified as Tasty.QuickCheck
+import Test.Tasty.TH (moduleName)
 
 -- | This is testworthy since I have somehow hand-hacked the read/show de/serialization of 'ImplicitMap'
 
@@ -33,4 +34,4 @@ allTests = $allProperties
 
 testGroup :: TestTree
 testGroup = Tasty.localOption (QuickCheckMaxSize 25) -- it is necessary to restrain the size because the generated core would get veeeeeery big otherwise
-  $ Tasty.QuickCheck.testProperties "Data.Map.Implicit" allTests
+  $ Tasty.QuickCheck.testProperties $moduleName allTests

test/Test/Language/Scalie/Domain/Type/Function/ArgumentModification.hs

@@ -0,0 +1,32 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE TemplateHaskell #-}
+module Test.Language.Scalie.Domain.Type.Function.ArgumentModification (testGroup) where
+
+import Language.Scalie.Domain.Type.Function.ArgumentModification (ArgumentModification, toBool, fromBool)
+
+-- library: QuickCheck
+import Test.QuickCheck.Roundtrip (roundtrips)
+import Test.QuickCheck.Isomorphic (isomorphic)
+
+-- library: Tasty
+import Test.Tasty (TestTree)
+import Test.Tasty.TH (moduleName)
+
+import Test.Tasty qualified as Tasty
+import Test.Tasty.LeanCheck qualified as Tasty.LeanCheck
+
+prop_toFromBoolRoundtrips :: Bool -> Bool
+prop_toFromBoolRoundtrips = roundtrips toBool fromBool
+
+prop_IsoToBoolEnumConversion :: ArgumentModification -> Bool
+prop_IsoToBoolEnumConversion = isomorphic toBool (toEnum . fromEnum)
+
+prop_IsoFromBoolEnumConversion :: Bool -> Bool
+prop_IsoFromBoolEnumConversion = isomorphic fromBool (toEnum . fromEnum)
+
+testGroup :: TestTree
+testGroup = Tasty.testGroup $moduleName
+  [ Tasty.LeanCheck.testProperty "id       ≡ toBool . fromBool" prop_toFromBoolRoundtrips
+  , Tasty.LeanCheck.testProperty "toBool   ≡ toEnum . fromEnum" prop_IsoToBoolEnumConversion
+  , Tasty.LeanCheck.testProperty "fromBool ≡ toEnum . fromEnum" prop_IsoFromBoolEnumConversion
+  ]

test/Test/QuickCheck/Isomorphic.hs

@@ -0,0 +1,5 @@
+{-# LANGUAGE Safe #-}
+module Test.QuickCheck.Isomorphic (isomorphic) where
+
+isomorphic :: Eq a => (t -> a) -> (t -> a) -> t -> Bool
+isomorphic f g x = f x == g x

test/Test/Tasty/TH.hs

@@ -0,0 +1,11 @@
+{-# LANGUAGE Safe #-} -- does template haskell, but no IO inside it
+module Test.Tasty.TH (moduleName) where
+
+import Language.Haskell.TH.Lib (thisModule)
+import Language.Haskell.TH.Syntax (Q, Exp(LitE), ModName(ModName), Lit(StringL), Module (Module))
+
+moduleName :: Q Exp
+moduleName = do
+  Module _ (ModName name) <- thisModule
+  pure . LitE . StringL $ name
+