feat: instances for Arbitrary

This commit is contained in:
vegowotenks 2025-08-14 09:21:34 +02:00
parent 13a2577ae2
commit 8181113bfe
6 changed files with 83 additions and 16 deletions

View file

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

View file

@ -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

View file

@ -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
show :: ImplicitMap v -> String
show = show . ImplicitMapElems . Map.elems . get
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
instance (Arbitrary v) => Arbitrary (ImplicitMapElems v) where
arbitrary :: Gen (ImplicitMapElems v)
arbitrary = ImplicitMapElems <$> arbitrary
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

View file

@ -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

View file

@ -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
]

View file

@ -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 ]