Compare commits
No commits in common. "851da6e469aa25f6e59f8a16c3fa286627226951" and "13a2577ae26d90bd1fae97a5b5efd272d94b9bd9" have entirely different histories.
851da6e469
...
13a2577ae2
9 changed files with 17 additions and 125 deletions
|
@ -30,7 +30,6 @@ dependencies:
|
|||
- containers
|
||||
- text
|
||||
- vector
|
||||
- QuickCheck
|
||||
|
||||
ghc-options:
|
||||
- -Weverything
|
||||
|
|
11
scalie.cabal
11
scalie.cabal
|
@ -37,8 +37,7 @@ library
|
|||
RoleAnnotations
|
||||
ghc-options: -Weverything -Wno-unsafe
|
||||
build-depends:
|
||||
QuickCheck
|
||||
, base
|
||||
base
|
||||
, containers
|
||||
, text
|
||||
, vector
|
||||
|
@ -58,8 +57,7 @@ executable scalie-exe
|
|||
RoleAnnotations
|
||||
ghc-options: -Weverything -Wno-unsafe -threaded -rtsopts -with-rtsopts=-N
|
||||
build-depends:
|
||||
QuickCheck
|
||||
, base
|
||||
base
|
||||
, containers
|
||||
, scalie
|
||||
, text
|
||||
|
@ -70,8 +68,6 @@ 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
|
||||
|
@ -83,8 +79,7 @@ test-suite scalie-test
|
|||
RoleAnnotations
|
||||
ghc-options: -Weverything -Wno-unsafe -threaded -rtsopts -with-rtsopts=-N
|
||||
build-depends:
|
||||
QuickCheck
|
||||
, base
|
||||
base
|
||||
, containers
|
||||
, scalie
|
||||
, text
|
||||
|
|
|
@ -2,8 +2,7 @@
|
|||
{-# LANGUAGE TypeFamilies #-} -- for KeyType
|
||||
{-# LANGUAGE FlexibleContexts #-} -- use non type-variable argument in instance head
|
||||
{-# LANGUAGE UndecidableInstances #-} -- use type family in instance head
|
||||
{-# LANGUAGE InstanceSigs #-} -- type signature in Show and Read instance
|
||||
{-# LANGUAGE StandaloneDeriving #-} -- derive Eq
|
||||
{-# LANGUAGE InstanceSigs #-}
|
||||
-- | A Map that derives the keys for the mapping from the items.
|
||||
|
||||
module Data.Map.Implicit (ImplicitMap(), get, ImplicitKeyOf(..), empty) where
|
||||
|
@ -15,46 +14,26 @@ 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 (Arbitrary v) => Arbitrary (ImplicitMapElems v) where
|
||||
arbitrary :: Gen (ImplicitMapElems v)
|
||||
arbitrary = ImplicitMapElems <$> arbitrary
|
||||
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
|
||||
|
||||
type ImplicitKeyOf :: Type -> Constraint
|
||||
class ImplicitKeyOf v where
|
||||
|
@ -63,8 +42,3 @@ 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
|
||||
|
|
|
@ -14,14 +14,6 @@ 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)
|
||||
--
|
||||
|
@ -53,17 +45,9 @@ 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
|
||||
|
||||
|
|
|
@ -1,23 +1,12 @@
|
|||
{-# 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, Eq)
|
||||
|
||||
instance Arbitrary Expression where
|
||||
arbitrary :: Gen Expression
|
||||
arbitrary = oneof
|
||||
[ RawInt <$> arbitrary
|
||||
]
|
||||
|
||||
deriving stock (Show, Read)
|
||||
|
|
|
@ -1,20 +1,12 @@
|
|||
{-# 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, Eq)
|
||||
|
||||
instance Arbitrary Type where
|
||||
arbitrary :: Gen Type
|
||||
arbitrary = oneof [ pure RawInt ]
|
||||
deriving stock (Show, Read)
|
||||
|
||||
|
|
|
@ -1,9 +1,2 @@
|
|||
{-# 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 = do
|
||||
_ <- Test.Data.Map.Implicit.runTests
|
||||
pure ()
|
||||
main = putStrLn "Test suite not yet implemented"
|
||||
|
|
|
@ -1,27 +0,0 @@
|
|||
{-# 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
|
|
@ -1,7 +0,0 @@
|
|||
{-# 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)
|
Loading…
Add table
Add a link
Reference in a new issue