diff --git a/package.yaml b/package.yaml index 91f40e0..70fb2cf 100644 --- a/package.yaml +++ b/package.yaml @@ -28,6 +28,9 @@ default-extensions: dependencies: - base + - containers + - text + - vector - QuickCheck ghc-options: @@ -37,11 +40,6 @@ ghc-options: library: source-dirs: src - dependencies: - - containers - - leancheck - - text - - vector executables: scalie-exe: @@ -66,5 +64,3 @@ tests: - scalie - tasty - tasty-quickcheck - - tasty-leancheck - - template-haskell diff --git a/scalie.cabal b/scalie.cabal index 6764e9c..5d04b75 100644 --- a/scalie.cabal +++ b/scalie.cabal @@ -19,7 +19,6 @@ extra-source-files: library exposed-modules: - Data.Enum.Util Data.Map.Implicit Language.Scalie.Bytecode.Instruction Language.Scalie.Bytecode.Object @@ -40,8 +39,6 @@ library Language.Scalie.Core.Provenance Language.Scalie.Core.Provenance.SourceLocation Language.Scalie.Domain.Type - Language.Scalie.Domain.Type.Function - Language.Scalie.Domain.Type.Function.ArgumentModification other-modules: Paths_scalie hs-source-dirs: @@ -58,7 +55,6 @@ library QuickCheck , base , containers - , leancheck , text , vector default-language: Haskell2010 @@ -80,7 +76,10 @@ executable scalie-exe build-depends: QuickCheck , base + , containers , scalie + , text + , vector default-language: Haskell2010 test-suite scalie-test @@ -88,10 +87,7 @@ test-suite scalie-test main-is: Spec.hs other-modules: Test.Data.Map.Implicit - Test.Language.Scalie.Domain.Type.Function.ArgumentModification - Test.QuickCheck.Isomorphic Test.QuickCheck.Roundtrip - Test.Tasty.TH Paths_scalie hs-source-dirs: test @@ -106,9 +102,10 @@ test-suite scalie-test build-depends: QuickCheck , base + , containers , scalie , tasty - , tasty-leancheck , tasty-quickcheck - , template-haskell + , text + , vector default-language: Haskell2010 diff --git a/src/Data/Enum/Util.hs b/src/Data/Enum/Util.hs deleted file mode 100644 index ddc3971..0000000 --- a/src/Data/Enum/Util.hs +++ /dev/null @@ -1,5 +0,0 @@ -{-# LANGUAGE Safe #-} -module Data.Enum.Util (enumerate) where - -enumerate :: (Enum a, Bounded a) => [a] -enumerate = [minBound .. maxBound] diff --git a/src/Language/Scalie/Domain/Type.hs b/src/Language/Scalie/Domain/Type.hs index 55fe978..97354de 100644 --- a/src/Language/Scalie/Domain/Type.hs +++ b/src/Language/Scalie/Domain/Type.hs @@ -4,25 +4,17 @@ module Language.Scalie.Domain.Type (Type(..)) where import Data.Kind qualified import Test.QuickCheck (Arbitrary (arbitrary), Gen, oneof) -import Language.Scalie.Domain.Type.Function qualified as Type -- | The type of an expression in Scalie, not to be confused with the 'Type' provided by GHC type Type :: Data.Kind.Type data Type = RawInt - | RawRational - | RawString - | Function Type.Function deriving stock (Show, Read, Eq) -- add to the arbitrary instance when defining constructors instance Arbitrary Type where arbitrary :: Gen Type - arbitrary = oneof - [ pure RawInt - , pure RawRational - , pure RawString - ] + arbitrary = oneof [ pure RawInt ] diff --git a/src/Language/Scalie/Domain/Type.hs-boot b/src/Language/Scalie/Domain/Type.hs-boot deleted file mode 100644 index 20897d8..0000000 --- a/src/Language/Scalie/Domain/Type.hs-boot +++ /dev/null @@ -1,9 +0,0 @@ -{-# LANGUAGE Safe #-} -module Language.Scalie.Domain.Type (Type) where -import Data.Kind qualified - -type Type :: Data.Kind.Type -data Type -instance Show Type -instance Read Type -instance Eq Type diff --git a/src/Language/Scalie/Domain/Type/Function.hs b/src/Language/Scalie/Domain/Type/Function.hs deleted file mode 100644 index 233aea1..0000000 --- a/src/Language/Scalie/Domain/Type/Function.hs +++ /dev/null @@ -1,18 +0,0 @@ -{-# LANGUAGE Safe #-} -module Language.Scalie.Domain.Type.Function (Function(..)) where - --- meta -import Data.Kind qualified - --- scalie -import Language.Scalie.Domain.Type.Function.ArgumentModification (ArgumentModification) - -import {-# SOURCE #-} Language.Scalie.Domain.Type qualified as Scalie.Domain - -type Function :: Data.Kind.Type -data Function = Function - { argument :: Scalie.Domain.Type - , result :: Scalie.Domain.Type - , argumentModification :: ArgumentModification - } - deriving stock (Show, Read, Eq) diff --git a/src/Language/Scalie/Domain/Type/Function/ArgumentModification.hs b/src/Language/Scalie/Domain/Type/Function/ArgumentModification.hs deleted file mode 100644 index 5deb58d..0000000 --- a/src/Language/Scalie/Domain/Type/Function/ArgumentModification.hs +++ /dev/null @@ -1,26 +0,0 @@ -{-# LANGUAGE Trustworthy #-} -- leancheck import somehow is not safe -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE InstanceSigs #-} -module Language.Scalie.Domain.Type.Function.ArgumentModification (ArgumentModification(..), toBool, fromBool) where -import Data.Kind qualified -import Test.LeanCheck (Listable (list)) -import Data.Enum.Util (enumerate) - -type ArgumentModification :: Data.Kind.Type -data ArgumentModification - = PureArguments - | LinearArguments - deriving stock (Show, Read, Eq, Ord, Enum, Bounded) - -toBool :: ArgumentModification -> Bool -toBool = \case - PureArguments -> False - LinearArguments -> True - -fromBool :: Bool -> ArgumentModification -fromBool = toEnum . fromEnum - -instance Listable ArgumentModification where - list :: [ArgumentModification] - list = enumerate - diff --git a/test/Spec.hs b/test/Spec.hs index 6ad4910..58d3a63 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -1,16 +1,10 @@ {-# LANGUAGE Unsafe #-} -- unsafe: Uses functions imported from unsafe modules - --- library -import Test.Tasty qualified as Tasty - --- test groups import Test.Data.Map.Implicit qualified -import Test.Language.Scalie.Domain.Type.Function.ArgumentModification qualified +import Test.Tasty qualified as Tasty main :: IO () main = Tasty.defaultMain $ Tasty.testGroup "all" [ Tasty.testGroup "Properties" [ Test.Data.Map.Implicit.testGroup - , Test.Language.Scalie.Domain.Type.Function.ArgumentModification.testGroup ] ] diff --git a/test/Test/Data/Map/Implicit.hs b/test/Test/Data/Map/Implicit.hs index 4f38074..44bbb1f 100644 --- a/test/Test/Data/Map/Implicit.hs +++ b/test/Test/Data/Map/Implicit.hs @@ -18,7 +18,6 @@ import Test.Tasty.QuickCheck (QuickCheckMaxSize(QuickCheckMaxSize)) import Test.Tasty qualified as Tasty import Test.Tasty.QuickCheck qualified as Tasty.QuickCheck -import Test.Tasty.TH (moduleName) -- | This is testworthy since I have somehow hand-hacked the read/show de/serialization of 'ImplicitMap' @@ -33,6 +32,5 @@ allTests :: [(String, Property)] allTests = $allProperties testGroup :: TestTree -testGroup = Tasty.localOption (QuickCheckMaxSize 5) -- anything above 25 doesn't finish in reasonable time on my laptop - $ Tasty.QuickCheck.testProperties $moduleName allTests - -- I don't want to stress-tess or bench-mark it, just prove it works cause I hacked a little around it. +testGroup = Tasty.localOption (QuickCheckMaxSize 25) -- it is necessary to restrain the size because the generated core would get veeeeeery big otherwise + $ Tasty.QuickCheck.testProperties "Data.Map.Implicit" allTests diff --git a/test/Test/Language/Scalie/Domain/Type/Function/ArgumentModification.hs b/test/Test/Language/Scalie/Domain/Type/Function/ArgumentModification.hs deleted file mode 100644 index 573ecf8..0000000 --- a/test/Test/Language/Scalie/Domain/Type/Function/ArgumentModification.hs +++ /dev/null @@ -1,32 +0,0 @@ -{-# LANGUAGE Trustworthy #-} -{-# LANGUAGE TemplateHaskell #-} -module Test.Language.Scalie.Domain.Type.Function.ArgumentModification (testGroup) where - -import Language.Scalie.Domain.Type.Function.ArgumentModification (ArgumentModification, toBool, fromBool) - --- library: QuickCheck -import Test.QuickCheck.Roundtrip (roundtrips) -import Test.QuickCheck.Isomorphic (isomorphic) - --- library: Tasty -import Test.Tasty (TestTree) -import Test.Tasty.TH (moduleName) - -import Test.Tasty qualified as Tasty -import Test.Tasty.LeanCheck qualified as Tasty.LeanCheck - -prop_toFromBoolRoundtrips :: Bool -> Bool -prop_toFromBoolRoundtrips = roundtrips toBool fromBool - -prop_IsoToBoolEnumConversion :: ArgumentModification -> Bool -prop_IsoToBoolEnumConversion = isomorphic toBool (toEnum . fromEnum) - -prop_IsoFromBoolEnumConversion :: Bool -> Bool -prop_IsoFromBoolEnumConversion = isomorphic fromBool (toEnum . fromEnum) - -testGroup :: TestTree -testGroup = Tasty.testGroup $moduleName - [ Tasty.LeanCheck.testProperty "id ≡ toBool . fromBool" prop_toFromBoolRoundtrips - , Tasty.LeanCheck.testProperty "toBool ≡ toEnum . fromEnum" prop_IsoToBoolEnumConversion - , Tasty.LeanCheck.testProperty "fromBool ≡ toEnum . fromEnum" prop_IsoFromBoolEnumConversion - ] diff --git a/test/Test/QuickCheck/Isomorphic.hs b/test/Test/QuickCheck/Isomorphic.hs deleted file mode 100644 index dd47ee9..0000000 --- a/test/Test/QuickCheck/Isomorphic.hs +++ /dev/null @@ -1,5 +0,0 @@ -{-# LANGUAGE Safe #-} -module Test.QuickCheck.Isomorphic (isomorphic) where - -isomorphic :: Eq a => (t -> a) -> (t -> a) -> t -> Bool -isomorphic f g x = f x == g x diff --git a/test/Test/Tasty/TH.hs b/test/Test/Tasty/TH.hs deleted file mode 100644 index b1f9e93..0000000 --- a/test/Test/Tasty/TH.hs +++ /dev/null @@ -1,11 +0,0 @@ -{-# LANGUAGE Safe #-} -- does template haskell, but no IO inside it -module Test.Tasty.TH (moduleName) where - -import Language.Haskell.TH.Lib (thisModule) -import Language.Haskell.TH.Syntax (Q, Exp(LitE), ModName(ModName), Lit(StringL), Module (Module)) - -moduleName :: Q Exp -moduleName = do - Module _ (ModName name) <- thisModule - pure . LitE . StringL $ name -