Compare commits

..

No commits in common. "851da6e469aa25f6e59f8a16c3fa286627226951" and "13a2577ae26d90bd1fae97a5b5efd272d94b9bd9" have entirely different histories.

9 changed files with 17 additions and 125 deletions

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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