fix[tests]: Safe Haskell Mode

package.yaml

@@ -30,6 +30,7 @@ dependencies:
   - containers
   - text
   - vector
+  - QuickCheck
 
 ghc-options:
 - -Weverything

scalie.cabal

@@ -37,7 +37,8 @@ library
       RoleAnnotations
   ghc-options: -Weverything -Wno-unsafe
   build-depends:
-      base
+      QuickCheck
+    , base
     , containers
     , text
     , vector
@@ -57,7 +58,8 @@ executable scalie-exe
       RoleAnnotations
   ghc-options: -Weverything -Wno-unsafe -threaded -rtsopts -with-rtsopts=-N
   build-depends:
-      base
+      QuickCheck
+    , base
     , containers
     , scalie
     , text
@@ -68,6 +70,8 @@ test-suite scalie-test
   type: exitcode-stdio-1.0
   main-is: Spec.hs
   other-modules:
+      Test.Data.Map.Implicit
+      Test.QuickCheck.Roundtrip
       Paths_scalie
   hs-source-dirs:
       test
@@ -79,7 +83,8 @@ test-suite scalie-test
       RoleAnnotations
   ghc-options: -Weverything -Wno-unsafe -threaded -rtsopts -with-rtsopts=-N
   build-depends:
-      base
+      QuickCheck
+    , base
     , containers
     , scalie
     , text

src/Data/Map/Implicit.hs

@@ -2,7 +2,8 @@
 {-# LANGUAGE TypeFamilies #-} -- for KeyType
 {-# LANGUAGE FlexibleContexts #-} -- use non type-variable argument in instance head
 {-# LANGUAGE UndecidableInstances #-} -- use type family in instance head
-{-# LANGUAGE InstanceSigs #-}
+{-# LANGUAGE InstanceSigs #-} -- type signature in Show and Read instance
+{-# LANGUAGE StandaloneDeriving #-} -- derive Eq
 -- | A Map that derives the keys for the mapping from the items.
 
 module Data.Map.Implicit (ImplicitMap(), get, ImplicitKeyOf(..), empty) where
@@ -14,26 +15,46 @@ import Control.Category ((.), Category (id))
 import Data.Map qualified as Map
 import Text.Read (Read (readPrec), ReadPrec)
 import Data.List qualified as List
-import Control.Arrow (Arrow ((&&&)))
+import Control.Arrow (Arrow ((&&&)), (>>>))
 import Data.Functor ((<$>))
 import Data.Ord (Ord)
+import Data.Eq (Eq)
+import Test.QuickCheck.Arbitrary (Arbitrary (arbitrary))
+import Test.QuickCheck.Gen (Gen)
+
+-- | This map will use the 'ImplicitKeyOf' class to compute the keys of the values.
 
 type ImplicitMap :: Type -> Type
 type role ImplicitMap nominal
 newtype ImplicitMap v = ImplicitMap { get :: Map (KeyType v) v }
 
+deriving stock instance (Eq v, Eq (KeyType v)) => Eq (ImplicitMap v)
+
+instance (Show v) => Show (ImplicitMap v) where
+  -- Serialize via the list of elements to avoid breaking invariants help by the map
+  show :: ImplicitMap v -> String
+  show = show . ImplicitMapElems . Map.elems . get
+
+instance (Read v, ImplicitKeyOf v, Ord (KeyType v)) => Read (ImplicitMap v) where
+  -- Serialize via the list of elements to avoid breaking invariants help by the map
+  readPrec :: ReadPrec (ImplicitMap v)
+  readPrec = ImplicitMap . Map.fromList . List.map (keyOf &&& id) . (\(ImplicitMapElems es) -> es) <$> readPrec
+
+instance (Arbitrary v, ImplicitKeyOf v, Ord (KeyType v)) => Arbitrary (ImplicitMap v) where
+  arbitrary :: Gen (ImplicitMap v)
+  arbitrary = fromList . (\(ImplicitMapElems es) -> es) <$> arbitrary
+
+
+-- | This is my helper type for the Show and Read instances of 'ImplicitMap'
+
 type ImplicitMapElems :: Type -> Type
 type role ImplicitMapElems representational
 newtype ImplicitMapElems v = ImplicitMapElems [v]
   deriving stock (Show, Read)
 
-instance (Show v) => Show (ImplicitMap v) where
+instance (Arbitrary v) => Arbitrary (ImplicitMapElems v) where
-  show :: ImplicitMap v -> String
+  arbitrary :: Gen (ImplicitMapElems v)
-  show = show . ImplicitMapElems . Map.elems . get
+  arbitrary = ImplicitMapElems <$> arbitrary
-
-instance (Read v, ImplicitKeyOf v, Ord (KeyType v)) => Read (ImplicitMap v) where
-  readPrec :: ReadPrec (ImplicitMap v)
-  readPrec = ImplicitMap . Map.fromList . List.map (keyOf &&& id) . (\(ImplicitMapElems es) -> es) <$> readPrec
 
 type ImplicitKeyOf :: Type -> Constraint
 class ImplicitKeyOf v where
@@ -42,3 +63,8 @@ class ImplicitKeyOf v where
 
 empty :: ImplicitMap v
 empty = ImplicitMap Map.empty
+
+fromList :: (ImplicitKeyOf v, Ord (KeyType v)) => [v] -> ImplicitMap v
+fromList = List.map (keyOf &&& id)
+  >>> Map.fromList
+  >>> ImplicitMap

src/Language/Scalie/Ast/Definition.hs

@@ -14,6 +14,14 @@ import Language.Scalie.Domain.Type qualified as Scalie.Domain
 import Language.Scalie.Ast.Expression (Expression)
 import Text.Show (Show)
 import Text.Read (Read)
+import Data.Eq (Eq)
+import Test.QuickCheck.Arbitrary (Arbitrary (arbitrary))
+import Test.QuickCheck.Gen (Gen)
+import Control.Applicative (Applicative((<*>)), (<$>))
+import Data.Text qualified as Text
+import Control.Category (Category((.)))
+import Test.QuickCheck.Modifiers (UnicodeString(getUnicodeString))
+import Data.Functor (Functor)
 
 -- | The definition of a value or a function (which is also a value)
 --
@@ -45,9 +53,17 @@ data Definition f = Definition
 
 deriving stock instance (Show (f Expression), Show (f Scalie.Domain.Type), Show (f Text)) => Show (Definition f)
 deriving stock instance (Read (f Expression), Read (f Scalie.Domain.Type), Read (f Text)) => Read (Definition f)
+deriving stock instance (Eq (f Expression)  , Eq (f Scalie.Domain.Type)  , Eq (f Text))   => Eq (Definition f)
 
 instance ImplicitKeyOf (Definition f) where
   type KeyType (Definition f) = f Text
   keyOf :: Definition f -> KeyType (Definition f)
   keyOf = name
 
+instance (Functor f, Arbitrary (f UnicodeString), Arbitrary (f Scalie.Domain.Type), Arbitrary (f Expression)) => Arbitrary (Definition f) where
+  arbitrary :: Gen (Definition f)
+  arbitrary = Definition
+    <$> arbitrary
+    <*> ((Text.pack . getUnicodeString <$>) <$> arbitrary)
+    <*> arbitrary
+

src/Language/Scalie/Ast/Expression.hs

@@ -1,12 +1,23 @@
 {-# LANGUAGE Safe #-}
+{-# LANGUAGE InstanceSigs #-}
 module Language.Scalie.Ast.Expression (Expression(..)) where
 
 import Prelude (Integer)
 import Data.Kind (Type)
 import Text.Show (Show)
 import Text.Read (Read)
+import Data.Eq (Eq)
+import Test.QuickCheck (Arbitrary (arbitrary), Gen, oneof)
+import Data.Functor ((<$>))
 
 type Expression :: Type
 data Expression
   = RawInt Integer
-  deriving stock (Show, Read)
+  deriving stock (Show, Read, Eq)
+
+instance Arbitrary Expression where
+  arbitrary :: Gen Expression
+  arbitrary = oneof
+    [ RawInt <$> arbitrary
+    ]
+

src/Language/Scalie/Domain/Type.hs

@@ -1,12 +1,20 @@
 {-# LANGUAGE Safe #-}
+{-# LANGUAGE InstanceSigs #-} -- function signature in instances
 module Language.Scalie.Domain.Type (Type(..)) where
 
 import Data.Kind qualified
 import Text.Show (Show)
 import Text.Read (Read)
+import Data.Eq (Eq)
+import Test.QuickCheck (Arbitrary (arbitrary), Gen, oneof)
+import Control.Applicative (Applicative(pure))
 
 type Type :: Data.Kind.Type
 data Type
   = RawInt
-  deriving stock (Show, Read)
+  deriving stock (Show, Read, Eq)
+
+instance Arbitrary Type where
+  arbitrary :: Gen Type
+  arbitrary = oneof [ pure RawInt ]
 

test/Spec.hs

@@ -1,2 +1,9 @@
+{-# LANGUAGE Unsafe #-} -- unsafe: Uses functions imported from unsafe modules
+import System.IO (IO)
+import Control.Applicative (pure)
+import Test.Data.Map.Implicit qualified
+
 main :: IO ()
-main = putStrLn "Test suite not yet implemented"
+main = do
+  _ <- Test.Data.Map.Implicit.runTests
+  pure ()

test/Test/Data/Map/Implicit.hs

@@ -0,0 +1,27 @@
+{-# LANGUAGE Unsafe #-} -- unsafe: I am using TemplateHaskell from a dependency
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeApplications #-}
+module Test.Data.Map.Implicit (prop_readShowIdentityRoundtrip, prop_readShowMaybeRoundtrip, runTests) where
+import Test.QuickCheck.Roundtrip (roundtrips)
+import Text.Show (show)
+import Text.Read (read)
+import Data.Map.Implicit (ImplicitMap)
+import Data.Bool (Bool)
+import Language.Scalie.Ast.Definition (Definition)
+import Data.Functor.Identity (Identity)
+import Test.QuickCheck.All (quickCheckAll)
+import System.IO (IO)
+import Control.Applicative (pure)
+import Data.Maybe (Maybe)
+
+-- | This is testworthy since I have somehow hand-hacked the read/show de/serialization of 'ImplicitMap'
+
+prop_readShowIdentityRoundtrip :: ImplicitMap (Definition Identity) -> Bool
+prop_readShowIdentityRoundtrip = roundtrips read show
+
+prop_readShowMaybeRoundtrip :: ImplicitMap (Definition Maybe) -> Bool
+prop_readShowMaybeRoundtrip = roundtrips read show
+
+pure []
+runTests :: IO Bool
+runTests = $quickCheckAll

test/Test/QuickCheck/Roundtrip.hs

@@ -0,0 +1,7 @@
+{-# LANGUAGE Safe #-}
+module Test.QuickCheck.Roundtrip (roundtrips) where
+import Data.Eq ((==), Eq)
+import Data.Bool (Bool)
+
+roundtrips :: Eq t1 => (t2 -> t1) -> (t1 -> t2) -> t1 -> Bool
+roundtrips back forth x = x == back (forth x)