From 8181113bfe172c395e250b39ae503f56d56c6bac Mon Sep 17 00:00:00 2001 From: VegOwOtenks Date: Thu, 14 Aug 2025 09:21:34 +0200 Subject: [PATCH] feat: instances for Arbitrary --- package.yaml | 3 +- scalie.cabal | 11 +++++-- src/Data/Map/Implicit.hs | 44 +++++++++++++++++++++------ src/Language/Scalie/Ast/Definition.hs | 18 ++++++++++- src/Language/Scalie/Ast/Expression.hs | 13 +++++++- src/Language/Scalie/Domain/Type.hs | 10 +++++- 6 files changed, 83 insertions(+), 16 deletions(-) diff --git a/package.yaml b/package.yaml index 336b741..e247398 100644 --- a/package.yaml +++ b/package.yaml @@ -23,13 +23,14 @@ default-extensions: - ImportQualifiedPost - NoImplicitPrelude - StandaloneKindSignatures - - RoleAnnotations + - RoleAnnotations dependencies: - base - containers - text - vector + - QuickCheck ghc-options: - -Weverything diff --git a/scalie.cabal b/scalie.cabal index b67faef..9e834db 100644 --- a/scalie.cabal +++ b/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 diff --git a/src/Data/Map/Implicit.hs b/src/Data/Map/Implicit.hs index ac0d459..3cbc43f 100644 --- a/src/Data/Map/Implicit.hs +++ b/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 - 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 diff --git a/src/Language/Scalie/Ast/Definition.hs b/src/Language/Scalie/Ast/Definition.hs index 9e6d6f8..7ebc156 100644 --- a/src/Language/Scalie/Ast/Definition.hs +++ b/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) -- @@ -37,7 +45,7 @@ type role Definition nominal data Definition f = Definition { signature :: f Scalie.Domain.Type -- ^ What is the type - , name :: f Text + , name :: f Text -- ^ Which name can be used to refer to this definition , body :: f Expression -- ^ What needs to be evaluated to get the 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 + diff --git a/src/Language/Scalie/Ast/Expression.hs b/src/Language/Scalie/Ast/Expression.hs index 09ef3b3..8ecf68e 100644 --- a/src/Language/Scalie/Ast/Expression.hs +++ b/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 + ] + diff --git a/src/Language/Scalie/Domain/Type.hs b/src/Language/Scalie/Domain/Type.hs index bf54b2d..92f9f87 100644 --- a/src/Language/Scalie/Domain/Type.hs +++ b/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 ]