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 - containers
- text - text
- vector - vector
- QuickCheck
ghc-options: ghc-options:
- -Weverything - -Weverything

View file

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

View file

@ -2,7 +2,8 @@
{-# LANGUAGE TypeFamilies #-} -- for KeyType {-# LANGUAGE TypeFamilies #-} -- for KeyType
{-# LANGUAGE FlexibleContexts #-} -- use non type-variable argument in instance head {-# LANGUAGE FlexibleContexts #-} -- use non type-variable argument in instance head
{-# LANGUAGE UndecidableInstances #-} -- use type family 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. -- | A Map that derives the keys for the mapping from the items.
module Data.Map.Implicit (ImplicitMap(), get, ImplicitKeyOf(..), empty) where 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 Data.Map qualified as Map
import Text.Read (Read (readPrec), ReadPrec) import Text.Read (Read (readPrec), ReadPrec)
import Data.List qualified as List import Data.List qualified as List
import Control.Arrow (Arrow ((&&&))) import Control.Arrow (Arrow ((&&&)), (>>>))
import Data.Functor ((<$>)) import Data.Functor ((<$>))
import Data.Ord (Ord) 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 ImplicitMap :: Type -> Type
type role ImplicitMap nominal type role ImplicitMap nominal
newtype ImplicitMap v = ImplicitMap { get :: Map (KeyType v) v } 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 ImplicitMapElems :: Type -> Type
type role ImplicitMapElems representational type role ImplicitMapElems representational
newtype ImplicitMapElems v = ImplicitMapElems [v] newtype ImplicitMapElems v = ImplicitMapElems [v]
deriving stock (Show, Read) 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 type ImplicitKeyOf :: Type -> Constraint
class ImplicitKeyOf v where class ImplicitKeyOf v where
@ -42,3 +63,8 @@ class ImplicitKeyOf v where
empty :: ImplicitMap v empty :: ImplicitMap v
empty = ImplicitMap Map.empty 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 Language.Scalie.Ast.Expression (Expression)
import Text.Show (Show) import Text.Show (Show)
import Text.Read (Read) 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) -- | 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 (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 (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 instance ImplicitKeyOf (Definition f) where
type KeyType (Definition f) = f Text type KeyType (Definition f) = f Text
keyOf :: Definition f -> KeyType (Definition f) keyOf :: Definition f -> KeyType (Definition f)
keyOf = name 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 Safe #-}
{-# LANGUAGE InstanceSigs #-}
module Language.Scalie.Ast.Expression (Expression(..)) where module Language.Scalie.Ast.Expression (Expression(..)) where
import Prelude (Integer) import Prelude (Integer)
import Data.Kind (Type) import Data.Kind (Type)
import Text.Show (Show) import Text.Show (Show)
import Text.Read (Read) import Text.Read (Read)
import Data.Eq (Eq)
import Test.QuickCheck (Arbitrary (arbitrary), Gen, oneof)
import Data.Functor ((<$>))
type Expression :: Type type Expression :: Type
data Expression data Expression
= RawInt Integer = 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 Safe #-}
{-# LANGUAGE InstanceSigs #-} -- function signature in instances
module Language.Scalie.Domain.Type (Type(..)) where module Language.Scalie.Domain.Type (Type(..)) where
import Data.Kind qualified import Data.Kind qualified
import Text.Show (Show) import Text.Show (Show)
import Text.Read (Read) 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 type Type :: Data.Kind.Type
data Type data Type
= RawInt = RawInt
deriving stock (Show, Read) deriving stock (Show, Read, Eq)
instance Arbitrary Type where
arbitrary :: Gen Type
arbitrary = oneof [ pure RawInt ]