From c3892a2a74a3bcbec93088c250bda4940c2a61a0 Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Thu, 8 Feb 2024 08:52:22 -0700 Subject: [PATCH 1/7] Always `defer-failures` in tests --- .../categorifier-categories-integration-test.cabal | 2 +- .../categorifier-concat-extensions-integration-test.cabal | 1 + .../categorifier-unconcat-integration-test.cabal | 1 + .../integration-test/categorifier-vec-integration-test.cabal | 1 + 4 files changed, 4 insertions(+), 1 deletion(-) diff --git a/integrations/categories/integration-test/categorifier-categories-integration-test.cabal b/integrations/categories/integration-test/categorifier-categories-integration-test.cabal index 4e03ef9..0596bce 100644 --- a/integrations/categories/integration-test/categorifier-categories-integration-test.cabal +++ b/integrations/categories/integration-test/categorifier-categories-integration-test.cabal @@ -48,7 +48,7 @@ common hierarchy-tests hs-source-dirs: test ghc-options: -fplugin Categorifier - -- -fplugin-opt Categorifier:defer-failures + -fplugin-opt Categorifier:defer-failures -fplugin-opt Categorifier:hierarchy:Categorifier.Hierarchy.Categories.hierarchy build-depends: , adjunctions ^>=4.4 diff --git a/integrations/concat-extensions/integration-test/categorifier-concat-extensions-integration-test.cabal b/integrations/concat-extensions/integration-test/categorifier-concat-extensions-integration-test.cabal index f78d928..ebd6a00 100644 --- a/integrations/concat-extensions/integration-test/categorifier-concat-extensions-integration-test.cabal +++ b/integrations/concat-extensions/integration-test/categorifier-concat-extensions-integration-test.cabal @@ -55,6 +55,7 @@ common hierarchy-tests -- ensure unfoldings are available -fno-omit-interface-pragmas -fplugin Categorifier + -fplugin-opt Categorifier:defer-failures -fplugin-opt Categorifier:hierarchy:Categorifier.Hierarchy.ConCat.functionHierarchy -fplugin-opt Categorifier:hierarchy:Categorifier.Hierarchy.ConCatExtensions.hierarchy build-depends: diff --git a/integrations/unconcat/integration-test/categorifier-unconcat-integration-test.cabal b/integrations/unconcat/integration-test/categorifier-unconcat-integration-test.cabal index 5e5d633..6cfb6da 100644 --- a/integrations/unconcat/integration-test/categorifier-unconcat-integration-test.cabal +++ b/integrations/unconcat/integration-test/categorifier-unconcat-integration-test.cabal @@ -54,6 +54,7 @@ common hierarchy-tests -- ensure unfoldings are available -fno-omit-interface-pragmas -fplugin Categorifier + -fplugin-opt Categorifier:defer-failures -fplugin-opt Categorifier:hierarchy:Categorifier.Hierarchy.UnconCat.hierarchy -fplugin-opt Categorifier:hierarchy:Categorifier.Hierarchy.ConCat.functionHierarchy build-depends: diff --git a/integrations/vec/integration-test/categorifier-vec-integration-test.cabal b/integrations/vec/integration-test/categorifier-vec-integration-test.cabal index ef5bafd..c3fd059 100644 --- a/integrations/vec/integration-test/categorifier-vec-integration-test.cabal +++ b/integrations/vec/integration-test/categorifier-vec-integration-test.cabal @@ -56,6 +56,7 @@ common hierarchy-tests -- ensure unfoldings are available -fno-omit-interface-pragmas -fplugin Categorifier + -fplugin-opt Categorifier:defer-failures -- Using the ConCat hierarchy, because it's the only one that supports `traverse` (and probably -- other things) -fplugin-opt Categorifier:hierarchy:Categorifier.Hierarchy.ConCat.functionHierarchy From 50dfb641178ad1d7508f195db5a04b383235a8fb Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Thu, 8 Feb 2024 08:54:42 -0700 Subject: [PATCH 2/7] Preserve the error message with `defer-failures` Previously, all deferred failures had the same generic error message, and we could only see the real failure by removing `defer-failures` and performing other steps that were described in the README. Now we preserve the real message and there is no reason to disable `defer-failures` during testing. --- plugin/Categorifier/Core.hs | 54 +++++++++++++++++++++---------------- plugin/README.md | 19 +++---------- 2 files changed, 34 insertions(+), 39 deletions(-) diff --git a/plugin/Categorifier/Core.hs b/plugin/Categorifier/Core.hs index 32fd68e..9708679 100644 --- a/plugin/Categorifier/Core.hs +++ b/plugin/Categorifier/Core.hs @@ -16,11 +16,22 @@ where import qualified Categorifier.Categorify import Categorifier.CommandLineOptions (OptionGroup (..)) -import Categorifier.Common.IO.Exception (SomeException, handle, throwIOAsException) +import Categorifier.Common.IO.Exception + ( SomeException, + displayException, + handle, + throwIOAsException, + ) import qualified Categorifier.Core.BuildDictionary as BuildDictionary import Categorifier.Core.Categorify (categorify) import qualified Categorifier.Core.ErrorHandling as Errors -import Categorifier.Core.MakerMap (MakerMapFun, SymbolLookup, baseMakerMapFun, baseSymbolLookup, combineMakerMapFuns) +import Categorifier.Core.MakerMap + ( MakerMapFun, + SymbolLookup, + baseMakerMapFun, + baseSymbolLookup, + combineMakerMapFuns, + ) import Categorifier.Core.Makers (Makers, haskMakers) import qualified Categorifier.Core.PrimOp as PrimOp import Categorifier.Core.Types @@ -284,24 +295,21 @@ deferFailures :: Plugins.Type -> -- | `GHC.Stack.CallStack` Plugins.CoreExpr -> + -- | the error message + String -> Plugins.CoreExpr deferFailures throw str cat a b calls = - let convertFn = 'Categorifier.Categorify.expression - in Plugins.App - ( Plugins.App - ( Plugins.mkTyApps - (Plugins.Var throw) - [Plugins.liftedRepTy, Plugins.mkAppTys cat [a, b]] - ) - calls + Plugins.App + ( Plugins.App + ( Plugins.mkTyApps + (Plugins.Var throw) + [Plugins.liftedRepTy, Plugins.mkAppTys cat [a, b]] ) - . Plugins.App (Plugins.Var str) - . Plugins.Lit - $ Plugins.mkLitString - [fmt|A call to `{TH.nameQualified convertFn}` failed to be eliminated by -the "Categorifier" plugin. But errors from the plugin have been deferred to runtime, -so you see this message instead of the actual compile-time failure. Compile -without `-fplugin-opt Categorifier:defer-failures` to see what actually went wrong.|] + calls + ) + . Plugins.App (Plugins.Var str) + . Plugins.Lit + . Plugins.mkLitString -- | -- __TODO__: `Dynamic.getValueSafely` throws in many cases. Try to catch, accumulate, return in @@ -451,7 +459,7 @@ categorifyRules convert opts guts = -- part of that, so all that's left is to perform the `IO` as late as possible. runStack :: NonEmpty Plugins.Name -> - Maybe Plugins.CoreExpr -> + Maybe (String -> Plugins.CoreExpr) -> Plugins.DynFlags -> Plugins.UniqSupply -> Plugins.CoreExpr -> @@ -465,10 +473,10 @@ runStack hierarchyOptions defer dflags uniqS calls f = deferException = maybe id - (handle . (const . pure :: Plugins.CoreExpr -> SomeException -> IO Plugins.CoreExpr)) + (handle . (\def -> pure . def . displayException :: SomeException -> IO Plugins.CoreExpr)) defer deferLeft :: Either (NonEmpty CategoricalFailure) Plugins.CoreExpr -> IO Plugins.CoreExpr - deferLeft = either (maybe printFailure (const . pure) defer) pure + deferLeft = either (maybe throwIOAsException (\def showF -> pure . def . showF) defer showFailure) pure handlePanic :: IO b -> IO b handlePanic = handle (throwIOAsException (Text.unpack . Errors.displayPanic dflags calls)) printWarnings :: @@ -479,8 +487,8 @@ runStack hierarchyOptions defer dflags uniqS calls f = unless (Plugins.isEmptyBag warns) . hPutStrLn stderr . Text.unpack $ Errors.showWarnings dflags warns pure val - printFailure :: NonEmpty CategoricalFailure -> IO a - printFailure = throwIOAsException (Text.unpack . Errors.showFailures dflags hierarchyOptions f) + showFailure :: NonEmpty CategoricalFailure -> String + showFailure = Text.unpack . Errors.showFailures dflags hierarchyOptions f -- | __HIC SUNT DRACONES__ -- @@ -495,7 +503,7 @@ runStack hierarchyOptions defer dflags uniqS calls f = applyCategorify :: Plugins.Id -> NonEmpty Plugins.Name -> - Maybe (Plugins.Type -> Plugins.Type -> Plugins.Type -> Plugins.CoreExpr -> Plugins.CoreExpr) -> + Maybe (Plugins.Type -> Plugins.Type -> Plugins.Type -> Plugins.CoreExpr -> String -> Plugins.CoreExpr) -> Plugins.DynFlags -> Plugins.UniqSupply -> (Plugins.Type -> Plugins.CoreExpr -> CategoryStack Plugins.CoreExpr) -> diff --git a/plugin/README.md b/plugin/README.md index 753985e..ce5454a 100644 --- a/plugin/README.md +++ b/plugin/README.md @@ -178,22 +178,9 @@ expected to churn a bit, as new approaches are added and old ones are obsolesced #### dealing with failed tests -We use a flag, `Categorifier:defer-failures`, to keep conversion failures from crashing GHC. However, -for the time being, all deferred failures are identical ([SW-]()) -- they don't carry any -information about what failed. This makes them harder to debug. What you should do is constrain your -testing to _exactly_ the failed test. That means - -1. comment out the line in plugins.bzl that mentions `Categorifier:defer-failures`, -2. in TH.hs, comment out all the `testTerms` other than the failing one, -3. in the Main.hs for the appropriate hierarchy, comment out the other `*TopLevel` entries in the - list, then -4. run a specific hierarchy test, for example, `concat-class-hierarchy`. - -Not all these steps are always necessary, but it can be hard to know when you can omit one. - -This is a bit tedious, for sure. But it does often make the loop faster, and it ensures no other -errors confuse issues. In future, we should preserve the actual failure for the test so it's easier -to inspect what's happening less invasively. +We use a flag, `Categorifier:defer-failures`, to keep conversion failures from crashing GHC. This is +useful in tests so that we can collect all failures, rather than exiting on the first one. But in +non-testing situations, we _want_ compilation to fail. #### catching missed identifier conversions From 697db6721d866cb78a392e6d2bbf1e79191f1e03 Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Thu, 8 Feb 2024 08:59:28 -0700 Subject: [PATCH 3/7] Update expected failures to check error message Expected failure tests now only succeed if the error message matches what we expect. This also enables us to address #45 down the road. --- plugin-test/Categorifier/Test/TH.hs | 26 ++- plugin-test/Categorifier/Test/Tests.hs | 12 +- plugin-test/test/Base/Main.hs | 303 +++++++++++++------------ 3 files changed, 182 insertions(+), 159 deletions(-) diff --git a/plugin-test/Categorifier/Test/TH.hs b/plugin-test/Categorifier/Test/TH.hs index 65486aa..e31ad27 100644 --- a/plugin-test/Categorifier/Test/TH.hs +++ b/plugin-test/Categorifier/Test/TH.hs @@ -29,7 +29,7 @@ module Categorifier.Test.TH where import qualified Categorifier.Categorify as Categorify -import Categorifier.Common.IO.Exception (SomeException, evaluate, try) +import Categorifier.Common.IO.Exception (SomeException, displayException, evaluate, try) import Categorifier.Hedgehog (floatingEq) import Categorifier.Test.HList (HMap1 (..), zipMapLowerWith) import Control.Applicative (liftA2) @@ -37,6 +37,7 @@ import Control.Monad (join, (<=<)) import Data.Bifunctor (Bifunctor (..)) import Data.Char (toLower) import Data.Foldable (toList) +import Data.List (isInfixOf) import Data.Maybe (mapMaybe) import Data.Tuple.Extra (uncurry3) import qualified Hedgehog @@ -112,7 +113,7 @@ mkPropLabel i = (<> show i) . TH.nameBase -- | Create a TH splice defining a Hedgehog property test of the given function. This should be -- automatically found and run by tasty. expectMatch :: Q Exp -> Q Exp -> Q Exp -> Int -> TestConfig -> Q Type -> (String, Name, Q [Dec]) -expectMatch display gen calcExpected i (TestConfig arrowTy funName' post) testTy = +expectMatch gen display calcExpected i (TestConfig arrowTy funName' post) testTy = ( mkPropLabel i funName, propName, (:) <$> typeSig <*> [d|$(TH.varP propName) = Hedgehog.property $(propBody $ strategy arrowTy)|] @@ -136,10 +137,11 @@ expectMatch display gen calcExpected i (TestConfig arrowTy funName' post) testTy Hedgehog.success |] --- | Right now this simply indicates that the test failed to build in _some_ way. In future, we --- should check the specific failure that occurred, so changes in failure cases also break tests. -expectBuildFailure :: Q Exp -> Int -> TestConfig -> Q Type -> (String, Name, Q [Dec]) -expectBuildFailure calcExpected i (TestConfig arrowTy funName' _) testTy = +-- | Create a TH splice defining a Hedgehog property test of the given function. The property test +-- will succeed only if there was a build failure with a message that contains the provided +-- `String`. +expectBuildFailure :: String -> Q Exp -> Int -> TestConfig -> Q Type -> (String, Name, Q [Dec]) +expectBuildFailure partialMessage calcExpected i (TestConfig arrowTy funName' _) testTy = ( mkPropLabel i funName, propName, (:) @@ -148,7 +150,7 @@ expectBuildFailure calcExpected i (TestConfig arrowTy funName' _) testTy = $(TH.varP propName) = Hedgehog.property ( either - (const Hedgehog.success :: SomeException -> Hedgehog.PropertyT IO ()) + (Hedgehog.diff partialMessage isInfixOf . displayException @SomeException) (const Hedgehog.failure) <=< Hedgehog.evalIO . try $ evaluate (Categorify.expression $calcExpected :: $testTy) @@ -188,9 +190,9 @@ mkTestType arr input output = [t|$arr $input $output|] -- | Given an arrow `Name`, return a list of properties to construct. Each consists of the specific -- types for specializing the parametric type above, followed by an optional pair of generator and --- display function. If it's `Nothing`, that means only check that it compiles. If the list is --- empty don't run the test at all on that arrow. -newtype TestCases a = TestCases {getTestCases :: Name -> [(a, Maybe (Q Exp, Q Exp))]} +-- display function. If it's `Left`, it takes a `String` that must a substring of the error +-- message. If the list is empty don't run the test at all on that arrow. +newtype TestCases a = TestCases {getTestCases :: Name -> [(a, Either String (Q Exp, Q Exp))]} -- | This is a function that eventually returns "named definitions" (a named definition is a pair of -- a `Name` and a @`Q` [`Dec`]@ containing a definition with that name. The result is a pair of a @@ -264,9 +266,9 @@ mkExprTest testName idxTy calcExpected = ExprTest $ \props arrowTy -> in pure . zipWith ( \i (testTys, testGen) -> - maybe + either expectBuildFailure - (\(gen, showExp) -> expectMatch showExp gen) + (uncurry expectMatch) testGen calcExpected i diff --git a/plugin-test/Categorifier/Test/Tests.hs b/plugin-test/Categorifier/Test/Tests.hs index 22f2dd8..9f7c17f 100644 --- a/plugin-test/Categorifier/Test/Tests.hs +++ b/plugin-test/Categorifier/Test/Tests.hs @@ -24,6 +24,8 @@ module Categorifier.Test.Tests baseTestTerms, mkTestTerms, zerosafeUnsignedPrimitiveCases, + noCategoricalRepresentation, + unableToInline, TestCases (..), TestCategory (..), TestStrategy (..), @@ -72,11 +74,19 @@ import Unsafe.Coerce (unsafeCoerce) -- For `Unsafe.Coerce` {-# ANN module "HLint: ignore Avoid restricted module" #-} +noCategoricalRepresentation :: String -> Either String (Q Exp, Q Exp) +noCategoricalRepresentation operation = + Left $ + "There is no categorical representation defined for `" <> operation <> "` when using the" + +unableToInline :: String -> Either String (Q Exp, Q Exp) +unableToInline operation = Left $ "The Categorifier plugin was unable to inline " <> operation + -- * property sets -- Combinations of property generators that are commonly desired when dealing with `C.Cat`. -zerosafeUnsignedPrimitiveCases :: [(Q Type, Maybe (Q Exp, Q Exp))] +zerosafeUnsignedPrimitiveCases :: [(Q Type, Either String (Q Exp, Q Exp))] zerosafeUnsignedPrimitiveCases = [ ( [t|Word16|], pure ([|(,) <$> genIntegralBounded <*> Gen.integral (Range.linear 1 maxBound)|], [|show|]) diff --git a/plugin-test/test/Base/Main.hs b/plugin-test/test/Base/Main.hs index cbc096e..ce6f0be 100644 --- a/plugin-test/test/Base/Main.hs +++ b/plugin-test/test/Base/Main.hs @@ -26,13 +26,15 @@ import Categorifier.Test.Tests builtinTestCategories, defaultTestTerms, mkTestTerms, + noCategoricalRepresentation, + unableToInline, ) import Control.Applicative (liftA2) import Control.Arrow (Arrow (..), ArrowChoice (..)) import Data.Bool (bool) import Data.Either.Validation (Validation) import Data.Proxy (Proxy (..)) -import Data.Semigroup (Sum (..)) +import Data.Semigroup (Product (..), Sum (..)) import GHC.Int (Int64) import GHC.Word (Word64, Word8) import qualified Hedgehog.Gen as Gen @@ -53,7 +55,7 @@ mkTestTerms -- core . HInsert1 (Proxy @"LamId") (TestCases (const [([t|Word8|], pure ([|genIntegralBounded|], [|show|]))])) . HInsert1 (Proxy @"ComposeLam") (TestCases (const [([t|Word8|], pure ([|genIntegralBounded|], [|show|]))])) - . HInsert1 (Proxy @"ConstLam") (TestCases (const [(([t|Int64|], [t|Word8|]), Nothing)])) + . HInsert1 (Proxy @"ConstLam") (TestCases (const [(([t|Int64|], [t|Word8|]), noCategoricalRepresentation "curry")])) . HInsert1 (Proxy @"ReturnLam") (TestCases (const [([t|Word8|], pure ([|genIntegralBounded|], [|show|]))])) . HInsert1 (Proxy @"BuildTuple") (TestCases (const [([t|Word8|], pure ([|genIntegralBounded|], [|show|]))])) . HInsert1 @@ -79,7 +81,7 @@ mkTestTerms ] ) ) - . HInsert1 (Proxy @"LocalFixedPoint") (TestCases (const [])) -- no support for `curry` in Base + . HInsert1 (Proxy @"LocalFixedPoint") (TestCases (const [([t|Word8|], noCategoricalRepresentation "curry")])) . HInsert1 (Proxy @"ApplyArg") ( TestCases @@ -124,7 +126,9 @@ mkTestTerms ) -- base . HInsert1 (Proxy @"Id") (TestCases (const [([t|Word8|], pure ([|genIntegralBounded|], [|show|]))])) - . HInsert1 (Proxy @"Const") (TestCases (const [(([t|Int64|], [t|Word8|]), Nothing)])) + . HInsert1 + (Proxy @"Const") + (TestCases (const [(([t|Int64|], [t|Word8|]), noCategoricalRepresentation "curry")])) . HInsert1 (Proxy @"Snd") ( TestCases @@ -135,7 +139,9 @@ mkTestTerms ] ) ) - . HInsert1 (Proxy @"FstSnd") (TestCases (const [(([t|Word8|], [t|Word8|], [t|Word8|]), Nothing)])) + . HInsert1 + (Proxy @"FstSnd") + (TestCases (const [(([t|Word8|], [t|Word8|], [t|Word8|]), noCategoricalRepresentation "curry")])) . HInsert1 (Proxy @"FstLet") ( TestCases @@ -159,13 +165,13 @@ mkTestTerms ] ) ) - . HInsert1 (Proxy @"Fork") (TestCases (const [(([t|Int64|], [t|Word8|]), Nothing)])) - . HInsert1 (Proxy @"Join") (TestCases (const [(([t|Int64|], [t|Word8|]), Nothing)])) + . HInsert1 (Proxy @"Fork") (TestCases (const [(([t|Int64|], [t|Word8|]), noCategoricalRepresentation "curry")])) + . HInsert1 (Proxy @"Join") (TestCases (const [(([t|Int64|], [t|Word8|]), noCategoricalRepresentation "curry")])) . HInsert1 (Proxy @"Arr") (TestCases (const [([t|Double|], pure ([|genFloating|], [|show|]))])) - . HInsert1 (Proxy @"Either") (TestCases (const [(([t|Int64|], [t|Word8|]), Nothing)])) + . HInsert1 (Proxy @"Either") (TestCases (const [(([t|Int64|], [t|Word8|]), noCategoricalRepresentation "curry")])) . HInsert1 (Proxy @"Coerce") (TestCases (const [([t|Word8|], pure ([|genIntegralBounded|], [|show|]))])) - . HInsert1 (Proxy @"ComposedCoerce") (TestCases (const [([t|Word8|], Nothing)])) - . HInsert1 (Proxy @"Bool") (TestCases (const [([t|Double|], Nothing)])) + . HInsert1 (Proxy @"ComposedCoerce") (TestCases (const [([t|Word8|], noCategoricalRepresentation "curry")])) + . HInsert1 (Proxy @"Bool") (TestCases (const [([t|Double|], noCategoricalRepresentation "curry")])) . HInsert1 (Proxy @"Acos") (TestCases (const [([t|Double|], pure ([|genFloating|], [|show|]))])) . HInsert1 (Proxy @"Acosh") (TestCases (const [([t|Double|], pure ([|genFloating|], [|show|]))])) . HInsert1 (Proxy @"AcoshDouble") (TestCases (const [((), pure ([|genFloating|], [|show|]))])) @@ -200,15 +206,15 @@ mkTestTerms . HInsert1 (Proxy @"Log") (TestCases (const [([t|Double|], pure ([|genFloating|], [|show|]))])) . HInsert1 (Proxy @"LogDouble") (TestCases (const [((), pure ([|genFloating|], [|show|]))])) . HInsert1 (Proxy @"LogFloat") (TestCases (const [((), pure ([|genFloating|], [|show|]))])) - . HInsert1 (Proxy @"MinusDouble") (TestCases (const [((), Nothing)])) - . HInsert1 (Proxy @"MinusFloat") (TestCases (const [((), Nothing)])) + . HInsert1 (Proxy @"MinusDouble") (TestCases (const [((), noCategoricalRepresentation "curry")])) + . HInsert1 (Proxy @"MinusFloat") (TestCases (const [((), noCategoricalRepresentation "curry")])) . HInsert1 (Proxy @"NegateDouble") (TestCases (const [((), pure ([|genFloating|], [|show|]))])) . HInsert1 (Proxy @"NegateFloat") (TestCases (const [((), pure ([|genFloating|], [|show|]))])) - . HInsert1 (Proxy @"PlusDouble") (TestCases (const [((), Nothing)])) - . HInsert1 (Proxy @"PlusFloat") (TestCases (const [((), Nothing)])) - . HInsert1 (Proxy @"Power") (TestCases (const [([t|Double|], Nothing)])) - . HInsert1 (Proxy @"PowerDouble") (TestCases (const [((), Nothing)])) - . HInsert1 (Proxy @"PowerFloat") (TestCases (const [((), Nothing)])) + . HInsert1 (Proxy @"PlusDouble") (TestCases (const [((), noCategoricalRepresentation "curry")])) + . HInsert1 (Proxy @"PlusFloat") (TestCases (const [((), noCategoricalRepresentation "curry")])) + . HInsert1 (Proxy @"Power") (TestCases (const [([t|Double|], noCategoricalRepresentation "curry")])) + . HInsert1 (Proxy @"PowerDouble") (TestCases (const [((), noCategoricalRepresentation "curry")])) + . HInsert1 (Proxy @"PowerFloat") (TestCases (const [((), noCategoricalRepresentation "curry")])) . HInsert1 (Proxy @"Sin") (TestCases (const [([t|Double|], pure ([|genFloating|], [|show|]))])) . HInsert1 (Proxy @"Sinh") (TestCases (const [([t|Double|], pure ([|genFloating|], [|show|]))])) . HInsert1 (Proxy @"SinDouble") (TestCases (const [((), pure ([|genFloating|], [|show|]))])) @@ -224,117 +230,111 @@ mkTestTerms . HInsert1 (Proxy @"TanhDouble") (TestCases (const [((), pure ([|genFloating|], [|show|]))])) . HInsert1 (Proxy @"TanFloat") (TestCases (const [((), pure ([|genFloating|], [|show|]))])) . HInsert1 (Proxy @"TanhFloat") (TestCases (const [((), pure ([|genFloating|], [|show|]))])) - . HInsert1 (Proxy @"TimesDouble") (TestCases (const [((), Nothing)])) - . HInsert1 (Proxy @"TimesFloat") (TestCases (const [((), Nothing)])) - . HInsert1 (Proxy @"And") (TestCases (const [((), Nothing)])) - . HInsert1 (Proxy @"Or") (TestCases (const [((), Nothing)])) - . HInsert1 (Proxy @"Equal") (TestCases (const [([t|Int64|], Nothing)])) - . HInsert1 (Proxy @"NotEqual") (TestCases (const [([t|Int64|], Nothing)])) - . HInsert1 (Proxy @"Ge") (TestCases (const [([t|Int64|], Nothing)])) - . HInsert1 (Proxy @"Gt") (TestCases (const [([t|Int64|], Nothing)])) - . HInsert1 (Proxy @"Le") (TestCases (const [([t|Int64|], Nothing)])) - . HInsert1 (Proxy @"Lt") (TestCases (const [([t|Int64|], Nothing)])) - . HInsert1 (Proxy @"EqualDouble") (TestCases (const [((), Nothing)])) - . HInsert1 (Proxy @"GeDouble") (TestCases (const [((), Nothing)])) - . HInsert1 (Proxy @"GtDouble") (TestCases (const [((), Nothing)])) - . HInsert1 (Proxy @"LeDouble") (TestCases (const [((), Nothing)])) - . HInsert1 (Proxy @"LtDouble") (TestCases (const [((), Nothing)])) - . HInsert1 (Proxy @"EqualFloat") (TestCases (const [((), Nothing)])) - . HInsert1 (Proxy @"GeFloat") (TestCases (const [((), Nothing)])) - . HInsert1 (Proxy @"GtFloat") (TestCases (const [((), Nothing)])) - . HInsert1 (Proxy @"LeFloat") (TestCases (const [((), Nothing)])) - . HInsert1 (Proxy @"LtFloat") (TestCases (const [((), Nothing)])) - . HInsert1 (Proxy @"EqualInt") (TestCases (const [((), Nothing)])) - . HInsert1 (Proxy @"NotEqualInt") (TestCases (const [((), Nothing)])) - . HInsert1 (Proxy @"GeInt") (TestCases (const [((), Nothing)])) - . HInsert1 (Proxy @"GtInt") (TestCases (const [((), Nothing)])) - . HInsert1 (Proxy @"LeInt") (TestCases (const [((), Nothing)])) - . HInsert1 (Proxy @"LtInt") (TestCases (const [((), Nothing)])) - . HInsert1 (Proxy @"EqualInt16") (TestCases (const [((), Nothing)])) - . HInsert1 (Proxy @"NotEqualInt16") (TestCases (const [((), Nothing)])) - . HInsert1 (Proxy @"GeInt16") (TestCases (const [((), Nothing)])) - . HInsert1 (Proxy @"GtInt16") (TestCases (const [((), Nothing)])) - . HInsert1 (Proxy @"LeInt16") (TestCases (const [((), Nothing)])) - . HInsert1 (Proxy @"LtInt16") (TestCases (const [((), Nothing)])) - . HInsert1 (Proxy @"EqualInt32") (TestCases (const [((), Nothing)])) - . HInsert1 (Proxy @"NotEqualInt32") (TestCases (const [((), Nothing)])) - . HInsert1 (Proxy @"GeInt32") (TestCases (const [((), Nothing)])) - . HInsert1 (Proxy @"GtInt32") (TestCases (const [((), Nothing)])) - . HInsert1 (Proxy @"LeInt32") (TestCases (const [((), Nothing)])) - . HInsert1 (Proxy @"LtInt32") (TestCases (const [((), Nothing)])) - . HInsert1 (Proxy @"EqualInt64") (TestCases (const [((), Nothing)])) - . HInsert1 (Proxy @"NotEqualInt64") (TestCases (const [((), Nothing)])) - . HInsert1 (Proxy @"GeInt64") (TestCases (const [((), Nothing)])) - . HInsert1 (Proxy @"GtInt64") (TestCases (const [((), Nothing)])) - . HInsert1 (Proxy @"LeInt64") (TestCases (const [((), Nothing)])) - . HInsert1 (Proxy @"LtInt64") (TestCases (const [((), Nothing)])) - . HInsert1 (Proxy @"EqualInt8") (TestCases (const [((), Nothing)])) - . HInsert1 (Proxy @"NotEqualInt8") (TestCases (const [((), Nothing)])) - . HInsert1 (Proxy @"GeInt8") (TestCases (const [((), Nothing)])) - . HInsert1 (Proxy @"GtInt8") (TestCases (const [((), Nothing)])) - . HInsert1 (Proxy @"LeInt8") (TestCases (const [((), Nothing)])) - . HInsert1 (Proxy @"LtInt8") (TestCases (const [((), Nothing)])) - . HInsert1 (Proxy @"EqualWord") (TestCases (const [((), Nothing)])) - . HInsert1 (Proxy @"NotEqualWord") (TestCases (const [((), Nothing)])) - . HInsert1 (Proxy @"GeWord") (TestCases (const [((), Nothing)])) - . HInsert1 (Proxy @"GtWord") (TestCases (const [((), Nothing)])) - . HInsert1 (Proxy @"LeWord") (TestCases (const [((), Nothing)])) - . HInsert1 (Proxy @"LtWord") (TestCases (const [((), Nothing)])) - . HInsert1 (Proxy @"EqualWord16") (TestCases (const [((), Nothing)])) - . HInsert1 (Proxy @"NotEqualWord16") (TestCases (const [((), Nothing)])) - . HInsert1 (Proxy @"GeWord16") (TestCases (const [((), Nothing)])) - . HInsert1 (Proxy @"GtWord16") (TestCases (const [((), Nothing)])) - . HInsert1 (Proxy @"LeWord16") (TestCases (const [((), Nothing)])) - . HInsert1 (Proxy @"LtWord16") (TestCases (const [((), Nothing)])) - . HInsert1 (Proxy @"EqualWord32") (TestCases (const [((), Nothing)])) - . HInsert1 (Proxy @"NotEqualWord32") (TestCases (const [((), Nothing)])) - . HInsert1 (Proxy @"GeWord32") (TestCases (const [((), Nothing)])) - . HInsert1 (Proxy @"GtWord32") (TestCases (const [((), Nothing)])) - . HInsert1 (Proxy @"LeWord32") (TestCases (const [((), Nothing)])) - . HInsert1 (Proxy @"LtWord32") (TestCases (const [((), Nothing)])) - . HInsert1 (Proxy @"EqualWord64") (TestCases (const [((), Nothing)])) - . HInsert1 (Proxy @"NotEqualWord64") (TestCases (const [((), Nothing)])) - . HInsert1 (Proxy @"GeWord64") (TestCases (const [((), Nothing)])) - . HInsert1 (Proxy @"GtWord64") (TestCases (const [((), Nothing)])) - . HInsert1 (Proxy @"LeWord64") (TestCases (const [((), Nothing)])) - . HInsert1 (Proxy @"LtWord64") (TestCases (const [((), Nothing)])) - . HInsert1 (Proxy @"EqualWord8") (TestCases (const [((), Nothing)])) - . HInsert1 (Proxy @"NotEqualWord8") (TestCases (const [((), Nothing)])) - . HInsert1 (Proxy @"GeWord8") (TestCases (const [((), Nothing)])) - . HInsert1 (Proxy @"GtWord8") (TestCases (const [((), Nothing)])) - . HInsert1 (Proxy @"LeWord8") (TestCases (const [((), Nothing)])) - . HInsert1 (Proxy @"LtWord8") (TestCases (const [((), Nothing)])) - . HInsert1 - (Proxy @"Compare") - ( TestCases - ( \arrow -> - if arrow /= ''Hask - then [] -- Only `Hask` currently has `OrdCat'` instance - else [([t|Double|], Nothing)] - ) - ) - . HInsert1 (Proxy @"Max") (TestCases (const [([t|Double|], Nothing)])) - . HInsert1 (Proxy @"Min") (TestCases (const [([t|Double|], Nothing)])) + . HInsert1 (Proxy @"TimesDouble") (TestCases (const [((), noCategoricalRepresentation "curry")])) + . HInsert1 (Proxy @"TimesFloat") (TestCases (const [((), noCategoricalRepresentation "curry")])) + . HInsert1 (Proxy @"And") (TestCases (const [((), noCategoricalRepresentation "curry")])) + . HInsert1 (Proxy @"Or") (TestCases (const [((), noCategoricalRepresentation "curry")])) + . HInsert1 (Proxy @"Equal") (TestCases (const [([t|Int64|], noCategoricalRepresentation "curry")])) + . HInsert1 (Proxy @"NotEqual") (TestCases (const [([t|Int64|], noCategoricalRepresentation "curry")])) + . HInsert1 (Proxy @"Ge") (TestCases (const [([t|Int64|], noCategoricalRepresentation "curry")])) + . HInsert1 (Proxy @"Gt") (TestCases (const [([t|Int64|], noCategoricalRepresentation "curry")])) + . HInsert1 (Proxy @"Le") (TestCases (const [([t|Int64|], noCategoricalRepresentation "curry")])) + . HInsert1 (Proxy @"Lt") (TestCases (const [([t|Int64|], noCategoricalRepresentation "curry")])) + . HInsert1 (Proxy @"EqualDouble") (TestCases (const [((), noCategoricalRepresentation "curry")])) + . HInsert1 (Proxy @"GeDouble") (TestCases (const [((), noCategoricalRepresentation "curry")])) + . HInsert1 (Proxy @"GtDouble") (TestCases (const [((), noCategoricalRepresentation "curry")])) + . HInsert1 (Proxy @"LeDouble") (TestCases (const [((), noCategoricalRepresentation "curry")])) + . HInsert1 (Proxy @"LtDouble") (TestCases (const [((), noCategoricalRepresentation "curry")])) + . HInsert1 (Proxy @"EqualFloat") (TestCases (const [((), noCategoricalRepresentation "curry")])) + . HInsert1 (Proxy @"GeFloat") (TestCases (const [((), noCategoricalRepresentation "curry")])) + . HInsert1 (Proxy @"GtFloat") (TestCases (const [((), noCategoricalRepresentation "curry")])) + . HInsert1 (Proxy @"LeFloat") (TestCases (const [((), noCategoricalRepresentation "curry")])) + . HInsert1 (Proxy @"LtFloat") (TestCases (const [((), noCategoricalRepresentation "curry")])) + . HInsert1 (Proxy @"EqualInt") (TestCases (const [((), noCategoricalRepresentation "curry")])) + . HInsert1 (Proxy @"NotEqualInt") (TestCases (const [((), noCategoricalRepresentation "curry")])) + . HInsert1 (Proxy @"GeInt") (TestCases (const [((), noCategoricalRepresentation "curry")])) + . HInsert1 (Proxy @"GtInt") (TestCases (const [((), noCategoricalRepresentation "curry")])) + . HInsert1 (Proxy @"LeInt") (TestCases (const [((), noCategoricalRepresentation "curry")])) + . HInsert1 (Proxy @"LtInt") (TestCases (const [((), noCategoricalRepresentation "curry")])) + . HInsert1 (Proxy @"EqualInt16") (TestCases (const [((), noCategoricalRepresentation "curry")])) + . HInsert1 (Proxy @"NotEqualInt16") (TestCases (const [((), noCategoricalRepresentation "curry")])) + . HInsert1 (Proxy @"GeInt16") (TestCases (const [((), noCategoricalRepresentation "curry")])) + . HInsert1 (Proxy @"GtInt16") (TestCases (const [((), noCategoricalRepresentation "curry")])) + . HInsert1 (Proxy @"LeInt16") (TestCases (const [((), noCategoricalRepresentation "curry")])) + . HInsert1 (Proxy @"LtInt16") (TestCases (const [((), noCategoricalRepresentation "curry")])) + . HInsert1 (Proxy @"EqualInt32") (TestCases (const [((), noCategoricalRepresentation "curry")])) + . HInsert1 (Proxy @"NotEqualInt32") (TestCases (const [((), noCategoricalRepresentation "curry")])) + . HInsert1 (Proxy @"GeInt32") (TestCases (const [((), noCategoricalRepresentation "curry")])) + . HInsert1 (Proxy @"GtInt32") (TestCases (const [((), noCategoricalRepresentation "curry")])) + . HInsert1 (Proxy @"LeInt32") (TestCases (const [((), noCategoricalRepresentation "curry")])) + . HInsert1 (Proxy @"LtInt32") (TestCases (const [((), noCategoricalRepresentation "curry")])) + . HInsert1 (Proxy @"EqualInt64") (TestCases (const [((), noCategoricalRepresentation "curry")])) + . HInsert1 (Proxy @"NotEqualInt64") (TestCases (const [((), noCategoricalRepresentation "curry")])) + . HInsert1 (Proxy @"GeInt64") (TestCases (const [((), noCategoricalRepresentation "curry")])) + . HInsert1 (Proxy @"GtInt64") (TestCases (const [((), noCategoricalRepresentation "curry")])) + . HInsert1 (Proxy @"LeInt64") (TestCases (const [((), noCategoricalRepresentation "curry")])) + . HInsert1 (Proxy @"LtInt64") (TestCases (const [((), noCategoricalRepresentation "curry")])) + . HInsert1 (Proxy @"EqualInt8") (TestCases (const [((), noCategoricalRepresentation "curry")])) + . HInsert1 (Proxy @"NotEqualInt8") (TestCases (const [((), noCategoricalRepresentation "curry")])) + . HInsert1 (Proxy @"GeInt8") (TestCases (const [((), noCategoricalRepresentation "curry")])) + . HInsert1 (Proxy @"GtInt8") (TestCases (const [((), noCategoricalRepresentation "curry")])) + . HInsert1 (Proxy @"LeInt8") (TestCases (const [((), noCategoricalRepresentation "curry")])) + . HInsert1 (Proxy @"LtInt8") (TestCases (const [((), noCategoricalRepresentation "curry")])) + . HInsert1 (Proxy @"EqualWord") (TestCases (const [((), noCategoricalRepresentation "curry")])) + . HInsert1 (Proxy @"NotEqualWord") (TestCases (const [((), noCategoricalRepresentation "curry")])) + . HInsert1 (Proxy @"GeWord") (TestCases (const [((), noCategoricalRepresentation "curry")])) + . HInsert1 (Proxy @"GtWord") (TestCases (const [((), noCategoricalRepresentation "curry")])) + . HInsert1 (Proxy @"LeWord") (TestCases (const [((), noCategoricalRepresentation "curry")])) + . HInsert1 (Proxy @"LtWord") (TestCases (const [((), noCategoricalRepresentation "curry")])) + . HInsert1 (Proxy @"EqualWord16") (TestCases (const [((), noCategoricalRepresentation "curry")])) + . HInsert1 (Proxy @"NotEqualWord16") (TestCases (const [((), noCategoricalRepresentation "curry")])) + . HInsert1 (Proxy @"GeWord16") (TestCases (const [((), noCategoricalRepresentation "curry")])) + . HInsert1 (Proxy @"GtWord16") (TestCases (const [((), noCategoricalRepresentation "curry")])) + . HInsert1 (Proxy @"LeWord16") (TestCases (const [((), noCategoricalRepresentation "curry")])) + . HInsert1 (Proxy @"LtWord16") (TestCases (const [((), noCategoricalRepresentation "curry")])) + . HInsert1 (Proxy @"EqualWord32") (TestCases (const [((), noCategoricalRepresentation "curry")])) + . HInsert1 (Proxy @"NotEqualWord32") (TestCases (const [((), noCategoricalRepresentation "curry")])) + . HInsert1 (Proxy @"GeWord32") (TestCases (const [((), noCategoricalRepresentation "curry")])) + . HInsert1 (Proxy @"GtWord32") (TestCases (const [((), noCategoricalRepresentation "curry")])) + . HInsert1 (Proxy @"LeWord32") (TestCases (const [((), noCategoricalRepresentation "curry")])) + . HInsert1 (Proxy @"LtWord32") (TestCases (const [((), noCategoricalRepresentation "curry")])) + . HInsert1 (Proxy @"EqualWord64") (TestCases (const [((), noCategoricalRepresentation "curry")])) + . HInsert1 (Proxy @"NotEqualWord64") (TestCases (const [((), noCategoricalRepresentation "curry")])) + . HInsert1 (Proxy @"GeWord64") (TestCases (const [((), noCategoricalRepresentation "curry")])) + . HInsert1 (Proxy @"GtWord64") (TestCases (const [((), noCategoricalRepresentation "curry")])) + . HInsert1 (Proxy @"LeWord64") (TestCases (const [((), noCategoricalRepresentation "curry")])) + . HInsert1 (Proxy @"LtWord64") (TestCases (const [((), noCategoricalRepresentation "curry")])) + . HInsert1 (Proxy @"EqualWord8") (TestCases (const [((), noCategoricalRepresentation "curry")])) + . HInsert1 (Proxy @"NotEqualWord8") (TestCases (const [((), noCategoricalRepresentation "curry")])) + . HInsert1 (Proxy @"GeWord8") (TestCases (const [((), noCategoricalRepresentation "curry")])) + . HInsert1 (Proxy @"GtWord8") (TestCases (const [((), noCategoricalRepresentation "curry")])) + . HInsert1 (Proxy @"LeWord8") (TestCases (const [((), noCategoricalRepresentation "curry")])) + . HInsert1 (Proxy @"LtWord8") (TestCases (const [((), noCategoricalRepresentation "curry")])) + . HInsert1 (Proxy @"Compare") (TestCases (const [([t|Double|], noCategoricalRepresentation "curry")])) + . HInsert1 (Proxy @"Max") (TestCases (const [([t|Double|], noCategoricalRepresentation "curry")])) + . HInsert1 (Proxy @"Min") (TestCases (const [([t|Double|], noCategoricalRepresentation "curry")])) . HInsert1 (Proxy @"Not") (TestCases (const [((), pure ([|Gen.bool|], [|show|]))])) - . HInsert1 (Proxy @"Plus") (TestCases (const [([t|Int64|], Nothing)])) - . HInsert1 (Proxy @"Minus") (TestCases (const [([t|Int64|], Nothing)])) - . HInsert1 (Proxy @"Times") (TestCases (const [([t|Int64|], Nothing)])) - . HInsert1 (Proxy @"Quot") (TestCases (const [([t|Word8|], Nothing)])) + . HInsert1 (Proxy @"Plus") (TestCases (const [([t|Int64|], noCategoricalRepresentation "curry")])) + . HInsert1 (Proxy @"Minus") (TestCases (const [([t|Int64|], noCategoricalRepresentation "curry")])) + . HInsert1 (Proxy @"Times") (TestCases (const [([t|Int64|], noCategoricalRepresentation "curry")])) + . HInsert1 (Proxy @"Quot") (TestCases (const [([t|Word8|], noCategoricalRepresentation "curry")])) . HInsert1 (Proxy @"RealToFrac") (TestCases (const [(([t|Double|], [t|Float|]), pure ([|genFloating|], [|show|]))])) - . HInsert1 (Proxy @"Recip") (TestCases (const [([t|Double|], pure ([|genFloating|], [|show|]))])) - . HInsert1 (Proxy @"Rem") (TestCases (const [([t|Word8|], Nothing)])) - . HInsert1 (Proxy @"Div") (TestCases (const [([t|Word64|], Nothing)])) - . HInsert1 (Proxy @"Mod") (TestCases (const [([t|Word8|], Nothing)])) - . HInsert1 (Proxy @"Divide") (TestCases (const [([t|Double|], Nothing)])) - . HInsert1 (Proxy @"DivideDouble") (TestCases (const [((), Nothing)])) - . HInsert1 (Proxy @"DivideFloat") (TestCases (const [((), Nothing)])) - . HInsert1 (Proxy @"Atan2") (TestCases (const [])) -- no `curry` + . HInsert1 + (Proxy @"Recip") + (TestCases (const [([t|Double|], pure ([|genFloating|], [|show|]))])) + . HInsert1 (Proxy @"Rem") (TestCases (const [([t|Word8|], noCategoricalRepresentation "curry")])) + . HInsert1 (Proxy @"Div") (TestCases (const [([t|Word64|], noCategoricalRepresentation "curry")])) + . HInsert1 (Proxy @"Mod") (TestCases (const [([t|Word8|], noCategoricalRepresentation "curry")])) + . HInsert1 (Proxy @"Divide") (TestCases (const [([t|Double|], noCategoricalRepresentation "curry")])) + . HInsert1 (Proxy @"DivideDouble") (TestCases (const [((), noCategoricalRepresentation "curry")])) + . HInsert1 (Proxy @"DivideFloat") (TestCases (const [((), noCategoricalRepresentation "curry")])) + . HInsert1 (Proxy @"Atan2") (TestCases (const [([t|Double|], noCategoricalRepresentation "curry")])) . HInsert1 (Proxy @"Abs") (TestCases (const [([t|Double|], pure ([|genFloating|], [|show|]))])) . HInsert1 (Proxy @"Negate") (TestCases (const [([t|Double|], pure ([|genFloating|], [|show|]))])) . HInsert1 (Proxy @"Signum") (TestCases (const [([t|Double|], pure ([|genFloating|], [|show|]))])) - . HInsert1 (Proxy @"PowI") (TestCases (const [])) + . HInsert1 (Proxy @"PowI") (TestCases (const [([t|Double|], noCategoricalRepresentation "^")])) . HInsert1 (Proxy @"PowInt") (TestCases (const [([t|Double|], pure ([|genFloating|], [|show|]))])) . HInsert1 (Proxy @"FromInteger") @@ -357,12 +357,10 @@ mkTestTerms ) . HInsert1 (Proxy @"FromIntegral") - ( TestCases - (const [(([t|Int64|], [t|Double|]), pure ([|Gen.int64 Range.linearBounded|], [|show|]))]) - ) - . HInsert1 (Proxy @"Append") (TestCases (const [([t|[Word8]|], Nothing)])) - . HInsert1 (Proxy @"Mappend") (TestCases (const [([t|[Word8]|], Nothing)])) - . HInsert1 (Proxy @"ListAppend") (TestCases (const [([t|Word8|], Nothing)])) + (TestCases (const [(([t|Int64|], [t|Double|]), pure ([|Gen.int64 Range.linearBounded|], [|show|]))])) + . HInsert1 (Proxy @"Append") (TestCases (const [([t|[Word8]|], noCategoricalRepresentation "curry")])) + . HInsert1 (Proxy @"Mappend") (TestCases (const [([t|[Word8]|], noCategoricalRepresentation "curry")])) + . HInsert1 (Proxy @"ListAppend") (TestCases (const [([t|Word8|], noCategoricalRepresentation "curry")])) . HInsert1 (Proxy @"Pure") ( TestCases @@ -388,26 +386,39 @@ mkTestTerms ) . HInsert1 (Proxy @"BuildLeft") (TestCases (const [(([t|Int64|], [t|Word8|]), pure ([|genIntegralBounded|], [|show|]))])) . HInsert1 (Proxy @"BuildRight") (TestCases (const [(([t|Int64|], [t|Word8|]), pure ([|genIntegralBounded|], [|show|]))])) - . HInsert1 (Proxy @"EliminateEither") (TestCases (const [([t|Word8|], Nothing)])) - . HInsert1 (Proxy @"EliminateEitherSwapped") (TestCases (const [([t|Word8|], Nothing)])) - . HInsert1 (Proxy @"Apply") (TestCases (const [(([t|Word8|], [t|Bool|]), Nothing)])) - . HInsert1 (Proxy @"BareFMap") (TestCases (const [([t|Word8|], Nothing)])) - . HInsert1 (Proxy @"PartialFmap") (TestCases (const [([t|Word8|], Nothing)])) - . HInsert1 (Proxy @"Fmap") (TestCases (const [(([t|Pair|], [t|Word8|]), Nothing)])) - . HInsert1 (Proxy @"Fmap'") (TestCases (const [([t|Word8|], Nothing)])) - . HInsert1 (Proxy @"ConstNot") (TestCases (const [([t|Word8|], Nothing)])) - . HInsert1 (Proxy @"MapList") (TestCases (const [([t|Word8|], Nothing)])) - . HInsert1 (Proxy @"Ap") (TestCases (const [])) -- no curry - . HInsert1 (Proxy @"LiftA2") (TestCases (const [(([t|Validation ()|], [t|Int64|], [t|Int64|]), Nothing)])) - . HInsert1 (Proxy @"Bind") (TestCases (const [([t|Word8|], Nothing)])) -- no curry - . HInsert1 (Proxy @"Curry") (TestCases (const [(([t|Word8|], [t|Bool|]), Nothing)])) - . HInsert1 (Proxy @"Uncurry") (TestCases (const [(([t|Word8|], [t|Bool|]), Nothing)])) - . HInsert1 (Proxy @"SequenceA") (TestCases (const [])) - . HInsert1 (Proxy @"Traverse") (TestCases (const [])) + . HInsert1 (Proxy @"EliminateEither") (TestCases (const [([t|Word8|], noCategoricalRepresentation "curry")])) + . HInsert1 (Proxy @"EliminateEitherSwapped") (TestCases (const [([t|Word8|], noCategoricalRepresentation "curry")])) + . HInsert1 (Proxy @"Apply") (TestCases (const [(([t|Word8|], [t|Bool|]), noCategoricalRepresentation "curry")])) + . HInsert1 (Proxy @"BareFMap") (TestCases (const [([t|Word8|], noCategoricalRepresentation "map")])) + . HInsert1 (Proxy @"PartialFmap") (TestCases (const [([t|Word8|], noCategoricalRepresentation "map")])) + . HInsert1 (Proxy @"Fmap") (TestCases (const [(([t|Pair|], [t|Word8|]), noCategoricalRepresentation "map")])) + . HInsert1 (Proxy @"Fmap'") (TestCases (const [([t|Word8|], noCategoricalRepresentation "map")])) + . HInsert1 (Proxy @"ConstNot") (TestCases (const [([t|Word8|], noCategoricalRepresentation "curry")])) + . HInsert1 (Proxy @"MapList") (TestCases (const [([t|Word8|], noCategoricalRepresentation "map")])) + . HInsert1 + (Proxy @"Ap") + ( TestCases + ( const + [ ( ([t|[]|], [t|Int64|]), + pure ([|Gen.list (Range.linear 0 100) genIntegralBounded|], [|show|]) + ) + ] + ) + ) + . HInsert1 (Proxy @"LiftA2") (TestCases (const [(([t|Validation ()|], [t|Int64|], [t|Int64|]), noCategoricalRepresentation "curry")])) + . HInsert1 (Proxy @"Bind") (TestCases (const [([t|Word8|], noCategoricalRepresentation "curry")])) + . HInsert1 (Proxy @"Curry") (TestCases (const [(([t|Word8|], [t|Bool|]), noCategoricalRepresentation "curry")])) + . HInsert1 (Proxy @"Uncurry") (TestCases (const [(([t|Word8|], [t|Bool|]), noCategoricalRepresentation "curry")])) + . HInsert1 + (Proxy @"SequenceA") + (TestCases (const [(([t|Sum|], [t|Product|], [t|Word8|]), noCategoricalRepresentation "sequenceA")])) + . HInsert1 + (Proxy @"Traverse") + (TestCases (const [(([t|Sum|], [t|Product|], [t|Word8|]), noCategoricalRepresentation "traverse")])) . HInsert1 (Proxy @"UnsafeCoerce") (TestCases (const [([t|Double|], pure ([|genFloating|], [|show|]))])) - . HInsert1 (Proxy @"Sum") (TestCases (const [])) -- can only work with specialization - . HInsert1 (Proxy @"SumList") (TestCases (const [])) - . HInsert1 (Proxy @"ToList") (TestCases (const [])) -- can only work with specialization + . HInsert1 (Proxy @"Sum") (TestCases (const [])) -- hangs + . HInsert1 (Proxy @"SumList") (TestCases (const [])) -- hangs + . HInsert1 (Proxy @"ToList") (TestCases (const [(([t|Maybe|], [t|Int64|]), unableToInline "toList")])) . HInsert1 (Proxy @"Even") (TestCases (const [([t|Int64|], pure ([|genIntegralBounded|], [|show|]))])) . HInsert1 (Proxy @"Odd") (TestCases (const [([t|Int64|], pure ([|genIntegralBounded|], [|show|]))])) $ HEmpty1 From 2ca4e15f72ae2956910a89f41698b986a3ce4b36 Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Mon, 12 Feb 2024 15:10:45 -0700 Subject: [PATCH 4/7] Document and enable testing individual properties --- .../integration-test/test/Adjunctions/Main.hs | 4 ++++ .../integration-test/test/Categories/Main.hs | 4 ++++ .../integration-test/test/ConCatExtensions/Main.hs | 4 ++++ .../concat/integration-test/test/ConCat/Main.hs | 4 ++++ .../ghc-bignum/integration-test/test/GhcBignum/Main.hs | 5 ++++- .../integration-test/test/LinearBase/Main.hs | 4 ++++ .../unconcat/integration-test/test/UnconCat/Main.hs | 4 ++++ integrations/vec/integration-test/test/Vec/Main.hs | 4 ++++ plugin-test/test/Base/Main.hs | 4 ++++ plugin/README.md | 10 ++++++++++ 10 files changed, 46 insertions(+), 1 deletion(-) diff --git a/integrations/adjunctions/integration-test/test/Adjunctions/Main.hs b/integrations/adjunctions/integration-test/test/Adjunctions/Main.hs index ad52129..7267f52 100644 --- a/integrations/adjunctions/integration-test/test/Adjunctions/Main.hs +++ b/integrations/adjunctions/integration-test/test/Adjunctions/Main.hs @@ -6,6 +6,8 @@ {-# LANGUAGE TypeApplications #-} -- To avoid turning @if then else@ into `ifThenElse`. {-# LANGUAGE NoRebindableSyntax #-} +-- To allow testing of individual properties (see plugin/README.md#dealing_with_failed_tests) +{-# OPTIONS_GHC -Wno-unused-imports -Wno-unused-top-binds #-} -- | See @Test/Cat/ConCat/Main.hs@ for copious notes on the testing situation here. module Main @@ -29,6 +31,8 @@ import Data.Functor.Identity (Identity (..)) import Data.Proxy (Proxy (..)) import GHC.Int (Int64) import GHC.Word (Word8) +-- To allow testing of individual properties (see plugin/README.md#dealing_with_failed_tests) +import qualified Hedgehog import System.Exit (exitFailure, exitSuccess) -- For @NoRebindableSyntax@ diff --git a/integrations/categories/integration-test/test/Categories/Main.hs b/integrations/categories/integration-test/test/Categories/Main.hs index be8eacf..b62e280 100644 --- a/integrations/categories/integration-test/test/Categories/Main.hs +++ b/integrations/categories/integration-test/test/Categories/Main.hs @@ -7,6 +7,8 @@ {-# LANGUAGE TypeApplications #-} -- To avoid turning @if then else@ into `ifThenElse`. {-# LANGUAGE NoRebindableSyntax #-} +-- To allow testing of individual properties (see plugin/README.md#dealing_with_failed_tests) +{-# OPTIONS_GHC -Wno-unused-imports -Wno-unused-top-binds #-} -- | See @Test/Cat/ConCat/Main.hs@ for copious notes on the testing situation here. module Main @@ -33,6 +35,8 @@ import Data.Proxy (Proxy (..)) import Data.Semigroup (Sum (..)) import GHC.Int (Int16, Int32, Int64, Int8) import GHC.Word (Word16, Word32, Word64, Word8) +-- To allow testing of individual properties (see plugin/README.md#dealing_with_failed_tests) +import qualified Hedgehog import qualified Hedgehog.Gen as Gen import qualified Hedgehog.Range as Range import System.Exit (exitFailure, exitSuccess) diff --git a/integrations/concat-extensions/integration-test/test/ConCatExtensions/Main.hs b/integrations/concat-extensions/integration-test/test/ConCatExtensions/Main.hs index 1fca765..5087f2b 100644 --- a/integrations/concat-extensions/integration-test/test/ConCatExtensions/Main.hs +++ b/integrations/concat-extensions/integration-test/test/ConCatExtensions/Main.hs @@ -4,6 +4,8 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeApplications #-} +-- To allow testing of individual properties (see plugin/README.md#dealing_with_failed_tests) +{-# OPTIONS_GHC -Wno-unused-imports -Wno-unused-top-binds #-} module Main ( main, @@ -29,6 +31,8 @@ import Data.Proxy (Proxy (..)) import Data.Semigroup (Product (..), Sum (..)) import GHC.Int (Int16, Int32, Int64, Int8) import GHC.Word (Word16, Word32, Word64, Word8) +-- To allow testing of individual properties (see plugin/README.md#dealing_with_failed_tests) +import qualified Hedgehog import qualified Hedgehog.Gen as Gen import qualified Hedgehog.Range as Range import System.Exit (exitFailure, exitSuccess) diff --git a/integrations/concat/integration-test/test/ConCat/Main.hs b/integrations/concat/integration-test/test/ConCat/Main.hs index 6b60a27..b639ec4 100644 --- a/integrations/concat/integration-test/test/ConCat/Main.hs +++ b/integrations/concat/integration-test/test/ConCat/Main.hs @@ -8,6 +8,8 @@ -- To avoid turning @if then else@ into `ifThenElse`. {-# LANGUAGE NoRebindableSyntax #-} {-# OPTIONS_GHC -Wno-redundant-constraints #-} +-- To allow testing of individual properties (see plugin/README.md#dealing_with_failed_tests) +{-# OPTIONS_GHC -Wno-unused-imports -Wno-unused-top-binds #-} -- | -- Template Haskell is used to automate the generation of the same test cases for each category we @@ -62,6 +64,8 @@ import Data.Proxy (Proxy (..)) import Data.Semigroup (Product (..), Sum (..)) import GHC.Int (Int16, Int32, Int64, Int8) import GHC.Word (Word16, Word32, Word64, Word8) +-- To allow testing of individual properties (see plugin/README.md#dealing_with_failed_tests) +import qualified Hedgehog import qualified Hedgehog.Gen as Gen import qualified Hedgehog.Range as Range import System.Exit (exitFailure, exitSuccess) diff --git a/integrations/ghc-bignum/integration-test/test/GhcBignum/Main.hs b/integrations/ghc-bignum/integration-test/test/GhcBignum/Main.hs index 4f3b883..7538432 100644 --- a/integrations/ghc-bignum/integration-test/test/GhcBignum/Main.hs +++ b/integrations/ghc-bignum/integration-test/test/GhcBignum/Main.hs @@ -7,7 +7,8 @@ {-# LANGUAGE TypeApplications #-} -- To avoid turning @if then else@ into `ifThenElse`. {-# LANGUAGE NoRebindableSyntax #-} -{-# OPTIONS_GHC -Wno-orphans #-} +-- To allow testing of individual properties (see plugin/README.md#dealing_with_failed_tests) +{-# OPTIONS_GHC -Wno-unused-imports -Wno-unused-top-binds #-} -- | See @Test/Cat/ConCat/Main.hs@ for copious notes on the testing situation here. module Main @@ -31,6 +32,8 @@ import Categorifier.Test.Tests ) import Data.Bool (bool) import Data.Proxy (Proxy (..)) +-- To allow testing of individual properties (see plugin/README.md#dealing_with_failed_tests) +import qualified Hedgehog import qualified Hedgehog.Gen as Gen import System.Exit (exitFailure, exitSuccess) diff --git a/integrations/linear-base/integration-test/test/LinearBase/Main.hs b/integrations/linear-base/integration-test/test/LinearBase/Main.hs index 325e8a7..d963626 100644 --- a/integrations/linear-base/integration-test/test/LinearBase/Main.hs +++ b/integrations/linear-base/integration-test/test/LinearBase/Main.hs @@ -8,6 +8,8 @@ -- To avoid turning @if then else@ into `ifThenElse`. {-# LANGUAGE NoRebindableSyntax #-} {-# OPTIONS_GHC -Wno-orphans #-} +-- To allow testing of individual properties (see plugin/README.md#dealing_with_failed_tests) +{-# OPTIONS_GHC -Wno-unused-imports -Wno-unused-top-binds #-} -- | See @Test/Cat/ConCat/Main.hs@ for copious notes on the testing situation here. module Main @@ -41,6 +43,8 @@ import qualified Data.V.Linear import GHC.Int (Int64) import GHC.TypeNats (KnownNat) import GHC.Word (Word8) +-- To allow testing of individual properties (see plugin/README.md#dealing_with_failed_tests) +import qualified Hedgehog import qualified Hedgehog.Gen as Gen import qualified Hedgehog.Range as Range import qualified Prelude.Linear diff --git a/integrations/unconcat/integration-test/test/UnconCat/Main.hs b/integrations/unconcat/integration-test/test/UnconCat/Main.hs index d4417a9..50e1fd1 100644 --- a/integrations/unconcat/integration-test/test/UnconCat/Main.hs +++ b/integrations/unconcat/integration-test/test/UnconCat/Main.hs @@ -4,6 +4,8 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeApplications #-} +-- To allow testing of individual properties (see plugin/README.md#dealing_with_failed_tests) +{-# OPTIONS_GHC -Wno-unused-imports -Wno-unused-top-binds #-} module Main ( main, @@ -27,6 +29,8 @@ import Data.Proxy (Proxy (..)) import Data.Semigroup (Sum (..)) import GHC.Int (Int16, Int32, Int64, Int8) import GHC.Word (Word16, Word32, Word64, Word8) +-- To allow testing of individual properties (see plugin/README.md#dealing_with_failed_tests) +import qualified Hedgehog import qualified Hedgehog.Gen as Gen import qualified Hedgehog.Range as Range import System.Exit (exitFailure, exitSuccess) diff --git a/integrations/vec/integration-test/test/Vec/Main.hs b/integrations/vec/integration-test/test/Vec/Main.hs index 857e633..eecbb1d 100644 --- a/integrations/vec/integration-test/test/Vec/Main.hs +++ b/integrations/vec/integration-test/test/Vec/Main.hs @@ -6,6 +6,8 @@ {-# LANGUAGE TypeApplications #-} -- To avoid turning @if then else@ into `ifThenElse`. {-# LANGUAGE NoRebindableSyntax #-} +-- To allow testing of individual properties (see plugin/README.md#dealing_with_failed_tests) +{-# OPTIONS_GHC -Wno-unused-imports -Wno-unused-top-binds #-} -- | See @Test/Cat/ConCat/Main.hs@ for copious notes on the testing situation here. module Main @@ -31,6 +33,8 @@ import qualified Data.Type.Nat as Nat import Data.Vec.Lazy (Vec (..)) import qualified Data.Vec.Lazy as Vec import GHC.Word (Word8) +-- To allow testing of individual properties (see plugin/README.md#dealing_with_failed_tests) +import qualified Hedgehog import System.Exit (exitFailure, exitSuccess) -- For @NoRebindableSyntax@ diff --git a/plugin-test/test/Base/Main.hs b/plugin-test/test/Base/Main.hs index ce6f0be..5766af8 100644 --- a/plugin-test/test/Base/Main.hs +++ b/plugin-test/test/Base/Main.hs @@ -7,6 +7,8 @@ {-# LANGUAGE TypeApplications #-} -- To avoid turning @if then else@ into `ifThenElse`. {-# LANGUAGE NoRebindableSyntax #-} +-- To allow testing of individual properties (see plugin/README.md#dealing_with_failed_tests) +{-# OPTIONS_GHC -Wno-unused-imports -Wno-unused-top-binds #-} -- | See @Test/Cat/ConCat/Main.hs@ for copious notes on the testing situation here. module Main @@ -37,6 +39,8 @@ import Data.Proxy (Proxy (..)) import Data.Semigroup (Product (..), Sum (..)) import GHC.Int (Int64) import GHC.Word (Word64, Word8) +-- To allow testing of individual properties (see plugin/README.md#dealing_with_failed_tests) +import qualified Hedgehog import qualified Hedgehog.Gen as Gen import qualified Hedgehog.Range as Range import System.Exit (exitFailure, exitSuccess) diff --git a/plugin/README.md b/plugin/README.md index ce5454a..829854b 100644 --- a/plugin/README.md +++ b/plugin/README.md @@ -182,6 +182,16 @@ We use a flag, `Categorifier:defer-failures`, to keep conversion failures from c useful in tests so that we can collect all failures, rather than exiting on the first one. But in non-testing situations, we _want_ compilation to fail. +To test a single property, replace +```haskell +main = bool exitFailure exitSuccess . and =<< allTestTerms +``` +with +```haskell +main = bool exitFailure exitSuccess =<< Hedgehog.check hprop_<> +``` +in the `Main.hs` for the relevant `test-suite`, where `<>` is the name printed in the test output. E.g., in ` ✓ plainArrowTimes0 passed 100 tests.` the name is `plainArrowTimes0`. + #### catching missed identifier conversions The last case of `findMaker` tries to inline the identifier, which can be useful to track but it's From 7a76faa7595f3bb3674c24e9f6fd88c9adc76dc7 Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Mon, 12 Feb 2024 15:11:40 -0700 Subject: [PATCH 5/7] Test properties in parallel Now that we can debug property tests with `defer-failures`, we can also run the tests in parallel, which is faster.` --- plugin-test/Categorifier/Test/TH.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/plugin-test/Categorifier/Test/TH.hs b/plugin-test/Categorifier/Test/TH.hs index e31ad27..63e9d62 100644 --- a/plugin-test/Categorifier/Test/TH.hs +++ b/plugin-test/Categorifier/Test/TH.hs @@ -166,7 +166,7 @@ mkTopLevelPair :: TestCategory -> [(String, Name)] -> (Name, Q Exp) mkTopLevelPair arrowTy names = ( arrowLabel, [e| - Hedgehog.checkSequential $ + Hedgehog.checkParallel $ Hedgehog.Group $(nameBaseLiteral $ arrName arrowTy) $(TH.listE namePairs) From f1cd2a5cba950349add486120df18fce83f9dffb Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Mon, 12 Feb 2024 15:20:23 -0700 Subject: [PATCH 6/7] Remove the indirection of `builtinTestCategories` MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit It hasn’t been needed since GHC 8.4 support was removed (where it allowed us to centralize `CPP` usage). So now just declare the `TestCategory` directly everywhere. --- .../integration-test/test/GhcBignum/Main.hs | 12 +++++------- .../integration-test/test/LinearBase/Main.hs | 12 +++++------- plugin-test/Categorifier/Test/Tests.hs | 6 ------ plugin-test/test/Base/Main.hs | 12 +++++------- 4 files changed, 15 insertions(+), 27 deletions(-) diff --git a/integrations/ghc-bignum/integration-test/test/GhcBignum/Main.hs b/integrations/ghc-bignum/integration-test/test/GhcBignum/Main.hs index 7538432..c1c75a6 100644 --- a/integrations/ghc-bignum/integration-test/test/GhcBignum/Main.hs +++ b/integrations/ghc-bignum/integration-test/test/GhcBignum/Main.hs @@ -27,7 +27,6 @@ import Categorifier.Test.Tests ( TestCases (..), TestCategory (..), TestStrategy (..), - builtinTestCategories, mkTestTerms, ) import Data.Bool (bool) @@ -42,12 +41,11 @@ import System.Exit (exitFailure, exitSuccess) mkTestTerms GhcBignum.testTerms - -- name type prefix strategy - ( [ TestCategory ''Term [t|Term|] "term" CheckCompileOnly, - TestCategory ''Hask [t|Hask|] "hask" $ ComputeFromInput [|runHask|] - ] - <> builtinTestCategories - ) + -- name type prefix strategy + [ TestCategory ''Term [t|Term|] "term" CheckCompileOnly, + TestCategory ''Hask [t|Hask|] "hask" $ ComputeFromInput [|runHask|], + TestCategory ''(->) [t|(->)|] "plainArrow" $ ComputeFromInput [|id|] + ] -- ghc-bignum . HInsert1 (Proxy @"EqualInteger") diff --git a/integrations/linear-base/integration-test/test/LinearBase/Main.hs b/integrations/linear-base/integration-test/test/LinearBase/Main.hs index d963626..7aba10f 100644 --- a/integrations/linear-base/integration-test/test/LinearBase/Main.hs +++ b/integrations/linear-base/integration-test/test/LinearBase/Main.hs @@ -28,7 +28,6 @@ import Categorifier.Test.Tests ( TestCases (..), TestCategory (..), TestStrategy (..), - builtinTestCategories, mkTestTerms, ) import qualified Control.Functor.Linear @@ -61,12 +60,11 @@ instance (KnownNat n) => Pointed (Data.V.Linear.V n) where mkTestTerms LinearBase.testTerms - -- name type prefix strategy - ( [ TestCategory ''Term [t|Term|] "term" CheckCompileOnly, - TestCategory ''Hask [t|Hask|] "hask" $ ComputeFromInput [|runHask|] - ] - <> builtinTestCategories - ) + -- name type prefix strategy + [ TestCategory ''Term [t|Term|] "term" CheckCompileOnly, + TestCategory ''Hask [t|Hask|] "hask" $ ComputeFromInput [|runHask|], + TestCategory ''(->) [t|(->)|] "plainArrow" $ ComputeFromInput [|id|] + ] -- linear-base . HInsert1 (Proxy @"LinearAbs") diff --git a/plugin-test/Categorifier/Test/Tests.hs b/plugin-test/Categorifier/Test/Tests.hs index 9f7c17f..4df3ee4 100644 --- a/plugin-test/Categorifier/Test/Tests.hs +++ b/plugin-test/Categorifier/Test/Tests.hs @@ -16,7 +16,6 @@ -- handles exactly what's written. module Categorifier.Test.Tests ( TestTerms, - builtinTestCategories, insertTest, defaultTestTerms, coreTestTerms, @@ -105,11 +104,6 @@ zerosafeUnsignedPrimitiveCases = ) ] --- | Before GHC 8.6, `->` is an illegal type constructor and can't be TH-quoted, so we do it --- conditionally here to avoid needing to use CPP everywhere. -builtinTestCategories :: [TestCategory] -builtinTestCategories = [TestCategory ''(->) [t|(->)|] "plainArrow" $ ComputeFromInput [|id|]] - -- | A helper to avoid duplicating the key when inserting a new test. insertTest :: (KnownSymbol k) => diff --git a/plugin-test/test/Base/Main.hs b/plugin-test/test/Base/Main.hs index 5766af8..b6e0dc8 100644 --- a/plugin-test/test/Base/Main.hs +++ b/plugin-test/test/Base/Main.hs @@ -25,7 +25,6 @@ import Categorifier.Test.Tests ( TestCases (..), TestCategory (..), TestStrategy (..), - builtinTestCategories, defaultTestTerms, mkTestTerms, noCategoricalRepresentation, @@ -50,12 +49,11 @@ import System.Exit (exitFailure, exitSuccess) mkTestTerms defaultTestTerms - -- name type prefix strategy - ( [ TestCategory ''Term [t|Term|] "term" CheckCompileOnly, - TestCategory ''Hask [t|Hask|] "hask" (ComputeFromInput [|runHask|]) - ] - <> builtinTestCategories - ) + -- name type prefix strategy + [ TestCategory ''Term [t|Term|] "term" CheckCompileOnly, + TestCategory ''Hask [t|Hask|] "hask" $ ComputeFromInput [|runHask|], + TestCategory ''(->) [t|(->)|] "plainArrow" $ ComputeFromInput [|id|] + ] -- core . HInsert1 (Proxy @"LamId") (TestCases (const [([t|Word8|], pure ([|genIntegralBounded|], [|show|]))])) . HInsert1 (Proxy @"ComposeLam") (TestCases (const [([t|Word8|], pure ([|genIntegralBounded|], [|show|]))])) From 9fe6ee90ba7d30a0102797d0bb3da2eddc46967d Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Mon, 12 Feb 2024 16:27:43 -0700 Subject: [PATCH 7/7] Use `Hedgehog.defaultMain` instead of our own --- .../adjunctions/integration-test/test/Adjunctions/Main.hs | 4 ++-- .../categories/integration-test/test/Categories/Main.hs | 4 ++-- .../integration-test/test/ConCatExtensions/Main.hs | 4 ++-- integrations/concat/integration-test/test/ConCat/Main.hs | 4 ++-- .../ghc-bignum/integration-test/test/GhcBignum/Main.hs | 4 ++-- .../linear-base/integration-test/test/LinearBase/Main.hs | 4 ++-- .../unconcat/integration-test/test/UnconCat/Main.hs | 4 ++-- integrations/vec/integration-test/test/Vec/Main.hs | 4 ++-- plugin-test/Categorifier/Test/TH.hs | 6 +++--- plugin-test/test/Base/Main.hs | 4 ++-- plugin-test/test/Main.hs | 4 ++-- plugin/README.md | 8 ++++++-- 12 files changed, 29 insertions(+), 25 deletions(-) diff --git a/integrations/adjunctions/integration-test/test/Adjunctions/Main.hs b/integrations/adjunctions/integration-test/test/Adjunctions/Main.hs index 7267f52..b69a782 100644 --- a/integrations/adjunctions/integration-test/test/Adjunctions/Main.hs +++ b/integrations/adjunctions/integration-test/test/Adjunctions/Main.hs @@ -33,7 +33,7 @@ import GHC.Int (Int64) import GHC.Word (Word8) -- To allow testing of individual properties (see plugin/README.md#dealing_with_failed_tests) import qualified Hedgehog -import System.Exit (exitFailure, exitSuccess) +import qualified Hedgehog.Main as Hedgehog (defaultMain) -- For @NoRebindableSyntax@ {-# ANN module ("HLint: ignore Avoid restricted integration" :: String) #-} @@ -88,4 +88,4 @@ mkTestTerms $ HEmpty1 main :: IO () -main = bool exitFailure exitSuccess . and =<< allTestTerms +main = Hedgehog.defaultMain allTestTerms diff --git a/integrations/categories/integration-test/test/Categories/Main.hs b/integrations/categories/integration-test/test/Categories/Main.hs index b62e280..3adac1a 100644 --- a/integrations/categories/integration-test/test/Categories/Main.hs +++ b/integrations/categories/integration-test/test/Categories/Main.hs @@ -38,8 +38,8 @@ import GHC.Word (Word16, Word32, Word64, Word8) -- To allow testing of individual properties (see plugin/README.md#dealing_with_failed_tests) import qualified Hedgehog import qualified Hedgehog.Gen as Gen +import qualified Hedgehog.Main as Hedgehog (defaultMain) import qualified Hedgehog.Range as Range -import System.Exit (exitFailure, exitSuccess) -- For @NoRebindableSyntax@ {-# ANN module ("HLint: ignore Avoid restricted integration" :: String) #-} @@ -1036,4 +1036,4 @@ mkTestTerms $ HEmpty1 main :: IO () -main = bool exitFailure exitSuccess . and =<< allTestTerms +main = Hedgehog.defaultMain allTestTerms diff --git a/integrations/concat-extensions/integration-test/test/ConCatExtensions/Main.hs b/integrations/concat-extensions/integration-test/test/ConCatExtensions/Main.hs index 5087f2b..2dd67e2 100644 --- a/integrations/concat-extensions/integration-test/test/ConCatExtensions/Main.hs +++ b/integrations/concat-extensions/integration-test/test/ConCatExtensions/Main.hs @@ -34,8 +34,8 @@ import GHC.Word (Word16, Word32, Word64, Word8) -- To allow testing of individual properties (see plugin/README.md#dealing_with_failed_tests) import qualified Hedgehog import qualified Hedgehog.Gen as Gen +import qualified Hedgehog.Main as Hedgehog (defaultMain) import qualified Hedgehog.Range as Range -import System.Exit (exitFailure, exitSuccess) -- | -- @@ -993,4 +993,4 @@ mkTestTerms $ HEmpty1 main :: IO () -main = bool exitFailure exitSuccess . and =<< allTestTerms +main = Hedgehog.defaultMain allTestTerms diff --git a/integrations/concat/integration-test/test/ConCat/Main.hs b/integrations/concat/integration-test/test/ConCat/Main.hs index b639ec4..50eebba 100644 --- a/integrations/concat/integration-test/test/ConCat/Main.hs +++ b/integrations/concat/integration-test/test/ConCat/Main.hs @@ -67,8 +67,8 @@ import GHC.Word (Word16, Word32, Word64, Word8) -- To allow testing of individual properties (see plugin/README.md#dealing_with_failed_tests) import qualified Hedgehog import qualified Hedgehog.Gen as Gen +import qualified Hedgehog.Main as Hedgehog (defaultMain) import qualified Hedgehog.Range as Range -import System.Exit (exitFailure, exitSuccess) -- For @NoRebindableSyntax@ {-# ANN module ("HLint: ignore Avoid restricted integration" :: String) #-} @@ -1573,4 +1573,4 @@ mkTestTerms $ HEmpty1 main :: IO () -main = bool exitFailure exitSuccess . and =<< allTestTerms +main = Hedgehog.defaultMain allTestTerms diff --git a/integrations/ghc-bignum/integration-test/test/GhcBignum/Main.hs b/integrations/ghc-bignum/integration-test/test/GhcBignum/Main.hs index c1c75a6..a487db2 100644 --- a/integrations/ghc-bignum/integration-test/test/GhcBignum/Main.hs +++ b/integrations/ghc-bignum/integration-test/test/GhcBignum/Main.hs @@ -34,7 +34,7 @@ import Data.Proxy (Proxy (..)) -- To allow testing of individual properties (see plugin/README.md#dealing_with_failed_tests) import qualified Hedgehog import qualified Hedgehog.Gen as Gen -import System.Exit (exitFailure, exitSuccess) +import qualified Hedgehog.Main as Hedgehog (defaultMain) -- For @NoRebindableSyntax@ {-# ANN module ("HLint: ignore Avoid restricted integration" :: String) #-} @@ -164,4 +164,4 @@ mkTestTerms $ HEmpty1 main :: IO () -main = bool exitFailure exitSuccess . and =<< allTestTerms +main = Hedgehog.defaultMain allTestTerms diff --git a/integrations/linear-base/integration-test/test/LinearBase/Main.hs b/integrations/linear-base/integration-test/test/LinearBase/Main.hs index 7aba10f..c368d80 100644 --- a/integrations/linear-base/integration-test/test/LinearBase/Main.hs +++ b/integrations/linear-base/integration-test/test/LinearBase/Main.hs @@ -45,9 +45,9 @@ import GHC.Word (Word8) -- To allow testing of individual properties (see plugin/README.md#dealing_with_failed_tests) import qualified Hedgehog import qualified Hedgehog.Gen as Gen +import qualified Hedgehog.Main as Hedgehog (defaultMain) import qualified Hedgehog.Range as Range import qualified Prelude.Linear -import System.Exit (exitFailure, exitSuccess) -- For @NoRebindableSyntax@ {-# ANN module ("HLint: ignore Avoid restricted integration" :: String) #-} @@ -609,4 +609,4 @@ mkTestTerms $ HEmpty1 main :: IO () -main = bool exitFailure exitSuccess . and =<< allTestTerms +main = Hedgehog.defaultMain allTestTerms diff --git a/integrations/unconcat/integration-test/test/UnconCat/Main.hs b/integrations/unconcat/integration-test/test/UnconCat/Main.hs index 50e1fd1..2122970 100644 --- a/integrations/unconcat/integration-test/test/UnconCat/Main.hs +++ b/integrations/unconcat/integration-test/test/UnconCat/Main.hs @@ -32,8 +32,8 @@ import GHC.Word (Word16, Word32, Word64, Word8) -- To allow testing of individual properties (see plugin/README.md#dealing_with_failed_tests) import qualified Hedgehog import qualified Hedgehog.Gen as Gen +import qualified Hedgehog.Main as Hedgehog (defaultMain) import qualified Hedgehog.Range as Range -import System.Exit (exitFailure, exitSuccess) mkTestTerms defaultTestTerms @@ -818,4 +818,4 @@ mkTestTerms $ HEmpty1 main :: IO () -main = bool exitFailure exitSuccess . and =<< allTestTerms +main = Hedgehog.defaultMain allTestTerms diff --git a/integrations/vec/integration-test/test/Vec/Main.hs b/integrations/vec/integration-test/test/Vec/Main.hs index eecbb1d..688f33f 100644 --- a/integrations/vec/integration-test/test/Vec/Main.hs +++ b/integrations/vec/integration-test/test/Vec/Main.hs @@ -35,7 +35,7 @@ import qualified Data.Vec.Lazy as Vec import GHC.Word (Word8) -- To allow testing of individual properties (see plugin/README.md#dealing_with_failed_tests) import qualified Hedgehog -import System.Exit (exitFailure, exitSuccess) +import qualified Hedgehog.Main as Hedgehog (defaultMain) -- For @NoRebindableSyntax@ {-# ANN module ("HLint: ignore Avoid restricted integration" :: String) #-} @@ -105,4 +105,4 @@ mkTestTerms $ HEmpty1 main :: IO () -main = bool exitFailure exitSuccess . and =<< allTestTerms +main = Hedgehog.defaultMain allTestTerms diff --git a/plugin-test/Categorifier/Test/TH.hs b/plugin-test/Categorifier/Test/TH.hs index 63e9d62..fca0642 100644 --- a/plugin-test/Categorifier/Test/TH.hs +++ b/plugin-test/Categorifier/Test/TH.hs @@ -201,7 +201,7 @@ newtype TestCases a = TestCases {getTestCases :: Name -> [(a, Either String (Q E newtype ExprTest a = ExprTest {getExprTest :: TestCases a -> TestCategory -> Maybe [(String, Name, Q [Dec])]} --- | Provides @allTestTerms :: `IO` [`Bool`]@ to comprehensively test various categories. +-- | Provides @allTestTerms :: [`IO` `Bool`]@ to comprehensively test various categories. mkTestTerms :: -- | The expressions to test. If you are using the plugin without extension, then -- `Test.Tests.defaultTestTerms` should cover all possible expressions. @@ -224,9 +224,9 @@ mkTestTerms testTerms arrows testCases = ( \labels -> let emptyList = [|[]|] in [d| - allTestTerms :: IO [Bool] + allTestTerms :: [IO Bool] allTestTerms = - sequenceA $(foldr (TH.appE . TH.appE (TH.conE '(:)) . TH.varE) emptyList labels) + $(foldr (TH.appE . TH.appE (TH.conE '(:)) . TH.varE) emptyList labels) |] ) (pure . join) diff --git a/plugin-test/test/Base/Main.hs b/plugin-test/test/Base/Main.hs index b6e0dc8..eb7ded0 100644 --- a/plugin-test/test/Base/Main.hs +++ b/plugin-test/test/Base/Main.hs @@ -41,8 +41,8 @@ import GHC.Word (Word64, Word8) -- To allow testing of individual properties (see plugin/README.md#dealing_with_failed_tests) import qualified Hedgehog import qualified Hedgehog.Gen as Gen +import qualified Hedgehog.Main as Hedgehog (defaultMain) import qualified Hedgehog.Range as Range -import System.Exit (exitFailure, exitSuccess) -- For @NoRebindableSyntax@ {-# ANN module ("HLint: ignore Avoid restricted integration" :: String) #-} @@ -426,4 +426,4 @@ mkTestTerms $ HEmpty1 main :: IO () -main = bool exitFailure exitSuccess . and =<< allTestTerms +main = Hedgehog.defaultMain allTestTerms diff --git a/plugin-test/test/Main.hs b/plugin-test/test/Main.hs index d1f34fa..4fe43a1 100644 --- a/plugin-test/test/Main.hs +++ b/plugin-test/test/Main.hs @@ -13,9 +13,9 @@ import Data.Functor.Identity (Identity (..)) import Data.Semigroup (Sum (..)) import Data.String (String) import qualified Hedgehog.Gen as Gen +import qualified Hedgehog.Main as Hedgehog (defaultMain) import qualified Hedgehog.Range as Range import P -import System.Exit (exitFailure, exitSuccess) import System.IO (IO) import Test.Data (One (..), Pair (..)) import Test.HList (HList1 (..)) @@ -465,4 +465,4 @@ mkTestTerms defaultTestTerms [TestCategory ''Term [t|Term|] "term" CheckCompileO $ HNil1 main :: IO () -main = bool exitFailure exitSuccess . and =<< allTestTerms +main = Hedgehog.defaultMain allTestTerms diff --git a/plugin/README.md b/plugin/README.md index 829854b..3ee196b 100644 --- a/plugin/README.md +++ b/plugin/README.md @@ -183,13 +183,17 @@ useful in tests so that we can collect all failures, rather than exiting on the non-testing situations, we _want_ compilation to fail. To test a single property, replace + ```haskell -main = bool exitFailure exitSuccess . and =<< allTestTerms +main = Hedgehog.defaultMain allTestTerms ``` + with + ```haskell -main = bool exitFailure exitSuccess =<< Hedgehog.check hprop_<> +main = Hedgehog.defaultMain . pure $ Hedgehog.check hprop_<> ``` + in the `Main.hs` for the relevant `test-suite`, where `<>` is the name printed in the test output. E.g., in ` ✓ plainArrowTimes0 passed 100 tests.` the name is `plainArrowTimes0`. #### catching missed identifier conversions