fix[test]: Don't test read/show instances for more than a second

package.yaml

@@ -28,9 +28,6 @@ default-extensions:
 
 dependencies:
   - base
-  - containers
-  - text
-  - vector
   - QuickCheck
 
 ghc-options:
@@ -40,6 +37,11 @@ ghc-options:
 
 library:
   source-dirs: src
+  dependencies:
+    - containers
+    - leancheck
+    - text
+    - vector
 
 executables:
   scalie-exe:
@@ -64,3 +66,5 @@ tests:
     - scalie
     - tasty
     - tasty-quickcheck
+    - tasty-leancheck
+    - template-haskell

scalie.cabal

@@ -19,6 +19,7 @@ extra-source-files:
 
 library
   exposed-modules:
+      Data.Enum.Util
       Data.Map.Implicit
       Language.Scalie.Bytecode.Instruction
       Language.Scalie.Bytecode.Object
@@ -39,6 +40,8 @@ library
       Language.Scalie.Core.Provenance
       Language.Scalie.Core.Provenance.SourceLocation
       Language.Scalie.Domain.Type
+      Language.Scalie.Domain.Type.Function
+      Language.Scalie.Domain.Type.Function.ArgumentModification
   other-modules:
       Paths_scalie
   hs-source-dirs:
@@ -55,6 +58,7 @@ library
       QuickCheck
     , base
     , containers
+    , leancheck
     , text
     , vector
   default-language: Haskell2010
@@ -76,10 +80,7 @@ executable scalie-exe
   build-depends:
       QuickCheck
     , base
-    , containers
     , scalie
-    , text
-    , vector
   default-language: Haskell2010
 
 test-suite scalie-test
@@ -87,7 +88,10 @@ test-suite scalie-test
   main-is: Spec.hs
   other-modules:
       Test.Data.Map.Implicit
+      Test.Language.Scalie.Domain.Type.Function.ArgumentModification
+      Test.QuickCheck.Isomorphic
       Test.QuickCheck.Roundtrip
+      Test.Tasty.TH
       Paths_scalie
   hs-source-dirs:
       test
@@ -102,10 +106,9 @@ test-suite scalie-test
   build-depends:
       QuickCheck
     , base
-    , containers
     , scalie
     , tasty
+    , tasty-leancheck
     , tasty-quickcheck
-    , text
-    , vector
+    , template-haskell
   default-language: Haskell2010

src/Data/Enum/Util.hs

@@ -0,0 +1,5 @@
+{-# LANGUAGE Safe #-}
+module Data.Enum.Util (enumerate) where
+
+enumerate :: (Enum a, Bounded a) => [a]
+enumerate = [minBound .. maxBound]

src/Language/Scalie/Domain/Type.hs

@@ -4,17 +4,25 @@ module Language.Scalie.Domain.Type (Type(..)) where
 
 import Data.Kind qualified
 import Test.QuickCheck (Arbitrary (arbitrary), Gen, oneof)
+import Language.Scalie.Domain.Type.Function qualified as Type
 
 -- | The type of an expression in Scalie, not to be confused with the 'Type' provided by GHC
 
 type Type :: Data.Kind.Type
 data Type
   = RawInt
+  | RawRational
+  | RawString
+  | Function Type.Function
   deriving stock (Show, Read, Eq)
 
   -- add to the arbitrary instance when defining constructors
 
 instance Arbitrary Type where
   arbitrary :: Gen Type
-  arbitrary = oneof [ pure RawInt ]
+  arbitrary = oneof 
+    [ pure RawInt
+    , pure RawRational
+    , pure RawString 
+    ]
 

src/Language/Scalie/Domain/Type.hs-boot

@@ -0,0 +1,9 @@
+{-# LANGUAGE Safe #-}
+module Language.Scalie.Domain.Type (Type) where
+import Data.Kind qualified
+
+type Type :: Data.Kind.Type
+data Type
+instance Show Type
+instance Read Type
+instance Eq   Type

src/Language/Scalie/Domain/Type/Function.hs

@@ -0,0 +1,18 @@
+{-# LANGUAGE Safe #-}
+module Language.Scalie.Domain.Type.Function (Function(..)) where
+
+-- meta
+import Data.Kind qualified
+
+-- scalie
+import Language.Scalie.Domain.Type.Function.ArgumentModification (ArgumentModification)
+
+import {-# SOURCE #-} Language.Scalie.Domain.Type qualified as Scalie.Domain
+
+type Function :: Data.Kind.Type
+data Function = Function
+  { argument             :: Scalie.Domain.Type
+  , result               :: Scalie.Domain.Type
+  , argumentModification :: ArgumentModification
+  }
+  deriving stock (Show, Read, Eq)

src/Language/Scalie/Domain/Type/Function/ArgumentModification.hs

@@ -0,0 +1,26 @@
+{-# LANGUAGE Trustworthy #-} -- leancheck import somehow is not safe
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE InstanceSigs #-}
+module Language.Scalie.Domain.Type.Function.ArgumentModification (ArgumentModification(..), toBool, fromBool) where
+import Data.Kind qualified
+import Test.LeanCheck (Listable (list))
+import Data.Enum.Util (enumerate)
+
+type ArgumentModification :: Data.Kind.Type
+data ArgumentModification
+  = PureArguments
+  | LinearArguments
+  deriving stock (Show, Read, Eq, Ord, Enum, Bounded)
+
+toBool :: ArgumentModification -> Bool
+toBool = \case
+  PureArguments -> False
+  LinearArguments -> True
+
+fromBool :: Bool -> ArgumentModification
+fromBool = toEnum . fromEnum
+
+instance Listable ArgumentModification where
+  list :: [ArgumentModification]
+  list = enumerate
+

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'
 
@@ -32,5 +33,6 @@ allTests :: [(String, Property)]
 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
+testGroup = Tasty.localOption (QuickCheckMaxSize 5) -- anything above 25 doesn't finish in reasonable time on my laptop
+  $ Tasty.QuickCheck.testProperties $moduleName allTests
+  -- I don't want to stress-tess or bench-mark it, just prove it works cause I hacked a little around it.

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
+