refactor: split a testing library

We split hedgehog generators, and some tasty glue into its own library
(as part of the Primer package).  We split these out to enable reuse of
generators between primer and primer-service in the future.  Note that
whilst internal libraries are supported with cabal-version: 2.4, the
ability to set visibility is only available from 3.0.

We regenerate hie.yaml via gen-hie, to make the haskell language server
aware of this new library.

hie.yaml

@@ -3,6 +3,9 @@ cradle:
     - path: "primer/src"
       component: "lib:primer"
 
+    - path: "primer/gen"
+      component: "primer:lib:primer-hedgehog"
+
     - path: "primer/test"
       component: "primer:test:primer-test"
 

primer/test/Gen/Core/Raw.hs → primer/gen/Primer/Gen/Core/Raw.hs

@@ -3,8 +3,8 @@
 -- That is, syntax trees which are not (necessarily) well-typed, or even well-scoped.
 -- It is however, fast and has good coverage properties.
 --
--- For generating well-typed terms, see "Gen.Core.Typed".
-module Gen.Core.Raw (
+-- For generating well-typed terms, see "Primer.Gen.Core.Typed".
+module Primer.Gen.Core.Raw (
   runExprGen,
   evalExprGen,
   genID,

primer/test/Gen/Core/Typed.hs → primer/gen/Primer/Gen/Core/Typed.hs

@@ -6,8 +6,8 @@
 -- This module generates well-typed terms and types.
 -- It is however, slow and the distribution is not very even.
 --
--- For quickly generating non-well-typed-or-scoped terms, see "Gen.Core.Raw".
-module Gen.Core.Typed (
+-- For quickly generating non-well-typed-or-scoped terms, see "Primer.Gen.Core.Raw".
+module Primer.Gen.Core.Typed (
   WT,
   isolateWT,
   genWTType,
@@ -32,7 +32,6 @@ import Control.Monad.Fresh (MonadFresh, fresh)
 import Control.Monad.Morph (hoist)
 import Control.Monad.Reader (mapReaderT)
 import Data.Map qualified as M
-import Gen.Core.Raw (genLVarName, genModuleName, genName, genTyVarName)
 import Hedgehog (
   GenT,
   MonadGen,
@@ -67,6 +66,7 @@ import Primer.Core (
   valConType,
  )
 import Primer.Core.Utils (freeVarsTy)
+import Primer.Gen.Core.Raw (genLVarName, genModuleName, genName, genTyVarName)
 import Primer.Module (Module)
 import Primer.Name (Name, NameCounter, freshName, unName, unsafeMkName)
 import Primer.Refine (Inst (InstAPP, InstApp, InstUnconstrainedAPP), refine)
@@ -94,8 +94,8 @@ import Primer.Typecheck (
   primConInScope,
   typeDefs,
  )
+import Tasty (Property, property)
 import TestM (TestM, evalTestM, isolateTestM)
-import TestUtils (Property, property)
 
 {-
 Generate well scoped and typed expressions.

primer/gen/Tasty.hs

@@ -0,0 +1,29 @@
+module Tasty (Property, property, withTests, withDiscards) where
+
+import Data.Coerce (coerce)
+import Data.String (fromString)
+import Hedgehog qualified as H
+import Test.Tasty.Discover qualified as TD
+import Test.Tasty.Hedgehog qualified as TH
+
+import Foreword
+
+-- | Work around tasty changes which give deprecation warnings for tasty-discover generated code
+newtype Property = Property
+  { unProperty :: H.Property
+  }
+
+instance TD.Tasty Property where
+  tasty info =
+    pure
+      . TH.testPropertyNamed (TD.descriptionOf info) (fromString (TD.descriptionOf info))
+      . unProperty
+
+property :: HasCallStack => H.PropertyT IO () -> Property
+property = Property . H.property
+
+withTests :: H.TestLimit -> Property -> Property
+withTests = coerce H.withTests
+
+withDiscards :: H.DiscardLimit -> Property -> Property
+withDiscards = coerce H.withDiscards

primer/primer.cabal

@@ -1,4 +1,4 @@
-cabal-version: 2.4
+cabal-version: 3.0
 name:          primer
 version:       0.7.2.0
 license:       AGPL-3.0-or-later
@@ -85,14 +85,45 @@ library
     , uniplate                     >=1.6      && <=1.7
     , uuid                         >=1.3      && <=1.4
 
+library primer-hedgehog
+  visibility:         public
+  exposed-modules:
+    Primer.Gen.Core.Raw
+    Primer.Gen.Core.Typed
+    Tasty
+    TestM
+
+  other-modules:
+  hs-source-dirs:     gen
+  default-language:   GHC2021
+  default-extensions:
+    NoImplicitPrelude
+    DataKinds
+    DerivingStrategies
+    DerivingVia
+    LambdaCase
+    OverloadedStrings
+
+  ghc-options:
+    -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates
+    -Wcompat -Widentities -Wredundant-constraints -fhide-source-paths
+    -threaded -rtsopts -with-rtsopts=-N
+
+  build-depends:
+    , base
+    , containers
+    , hedgehog        ^>=1.1.1
+    , mmorph          ^>=1.2.0
+    , mtl
+    , primer
+    , tasty-discover  ^>=4.2.4
+    , tasty-hedgehog  ^>=1.2.0
+
 test-suite primer-test
   type:               exitcode-stdio-1.0
   main-is:            Test.hs
   hs-source-dirs:     test
   other-modules:
-    Gen.Core.Raw
-    Gen.Core.Typed
-    TestM
     Tests.Action
     Tests.Action.Available
     Tests.Action.Capture
@@ -162,6 +193,7 @@ test-suite primer-test
       , prettyprinter                >=1.7.1   && <=1.8
       , prettyprinter-ansi-terminal  >=1.1.3   && <=1.2
       , primer
+      , primer-hedgehog
       , protolude
       , stm
       , stm-containers

primer/test/TestUtils.hs

@@ -14,10 +14,6 @@ module TestUtils (
   zeroTypeIDs,
   clearMeta,
   clearTypeMeta,
-  Property,
-  property,
-  withTests,
-  withDiscards,
   runAPI,
 ) where
 
@@ -27,10 +23,8 @@ import Control.Concurrent.STM (
   newTBQueueIO,
  )
 import Control.Monad.Fresh (MonadFresh)
-import Data.Coerce (coerce)
-import Data.String (String, fromString)
+import Data.String (String)
 import Data.Typeable (typeOf)
-import Hedgehog qualified as H
 import Optics (over, set, view)
 import Primer.API (
   Env (..),
@@ -71,13 +65,11 @@ import Primer.Database (
 import Primer.Name (Name (unName))
 import Primer.Primitives (allPrimDefs)
 import StmContainers.Map qualified as StmMap
-import Test.Tasty.Discover qualified as TD
 import Test.Tasty.HUnit (
   assertBool,
   assertFailure,
  )
 import Test.Tasty.HUnit qualified as HUnit
-import Test.Tasty.Hedgehog qualified as TH
 
 withPrimDefs :: MonadFresh ID m => (Map GVarName PrimDef -> m a) -> m a
 withPrimDefs f = do
@@ -143,26 +135,6 @@ assertException msg p action = do
     wrongException e = msg <> " threw " <> show e <> ", but we expected " <> exceptionType
     exceptionType = (show . typeOf) p
 
--- | Work around tasty changes which give deprecation warnings for tasty-discover generated code
-newtype Property = Property
-  { unProperty :: H.Property
-  }
-
-instance TD.Tasty Property where
-  tasty info =
-    pure
-      . TH.testPropertyNamed (TD.descriptionOf info) (fromString (TD.descriptionOf info))
-      . unProperty
-
-property :: HasCallStack => H.PropertyT IO () -> Property
-property = Property . H.property
-
-withTests :: H.TestLimit -> Property -> Property
-withTests = coerce H.withTests
-
-withDiscards :: H.DiscardLimit -> Property -> Property
-withDiscards = coerce H.withDiscards
-
 -- Run 2 threads: one that serves a 'NullDb', and one that runs Primer
 -- API actions. This allows us to simulate a database and API service.
 --

primer/test/Tests/API.hs

@@ -5,7 +5,6 @@ import Foreword
 import Data.ByteString.Lazy qualified as BSL
 import Data.Text.Lazy qualified as TL
 import Data.UUID.V4 (nextRandom)
-import Gen.Core.Raw (evalExprGen, genExpr, genType)
 import Hedgehog hiding (Property, property)
 import Primer.API (
   PrimerErr,
@@ -37,15 +36,18 @@ import Primer.Examples (
   comprehensive,
   even3App,
  )
+import Primer.Gen.Core.Raw (evalExprGen, genExpr, genType)
 import Protolude.Unsafe (unsafeFromJust)
+import Tasty (
+  Property,
+  property,
+ )
 import Test.Tasty (TestTree, testGroup)
 import Test.Tasty.Golden (goldenVsString)
 import Test.Tasty.HUnit hiding ((@?=))
 import TestUtils (
   ExceptionPredicate,
-  Property,
   assertException,
-  property,
   runAPI,
   (@?=),
  )

primer/test/Tests/Action.hs

@@ -5,10 +5,6 @@ import Foreword
 
 import Data.Data (Data)
 import Data.Generics.Uniplate.Data (universe)
-import Gen.Core.Raw (
-  evalExprGen,
-  genExpr,
- )
 import Hedgehog hiding (
   Action,
   Property,
@@ -32,6 +28,10 @@ import Primer.Core (
   getID,
  )
 import Primer.Core.DSL
+import Primer.Gen.Core.Raw (
+  evalExprGen,
+  genExpr,
+ )
 import Primer.Typecheck (SmartHoles (NoSmartHoles, SmartHoles))
 import Primer.Zipper (
   down,
@@ -41,9 +41,10 @@ import Primer.Zipper (
   unfocusExpr,
   unfocusType,
  )
+import Tasty (Property, property)
 import Test.Tasty.HUnit (Assertion, assertFailure, (@?=))
 import TestM (evalTestM)
-import TestUtils (Property, clearMeta, constructCon, constructRefinedCon, constructTCon, property)
+import TestUtils (clearMeta, constructCon, constructRefinedCon, constructTCon)
 
 -- Note: 'maximum' is partial, but we believe that 'maxID' itself is
 -- safe due to the fact that 'universe x' always contains at least

primer/test/Tests/AlphaEquality.hs

@@ -2,11 +2,6 @@ module Tests.AlphaEquality where
 
 import Foreword
 
-import Gen.Core.Raw (
-  evalExprGen,
-  genTyVarName,
-  genType,
- )
 import Hedgehog hiding (Property, check, property)
 import Primer.Builtins
 import Primer.Core (
@@ -15,8 +10,13 @@ import Primer.Core (
  )
 import Primer.Core.DSL
 import Primer.Core.Utils (alphaEqTy, forgetTypeMetadata)
+import Primer.Gen.Core.Raw (
+  evalExprGen,
+  genTyVarName,
+  genType,
+ )
+import Tasty (Property, property)
 import Test.Tasty.HUnit hiding (assert)
-import TestUtils (Property, property)
 
 unit_1 :: Assertion
 unit_1 =

primer/test/Tests/EvalFull.hs

@@ -9,7 +9,6 @@ import Data.Map qualified as M
 import Data.Map qualified as Map
 import Data.Set qualified as S
 import Data.String (unlines)
-import Gen.Core.Typed (WT, forAllT, genChk, genSyn, genWTType, isolateWT, propertyWT)
 import Hedgehog hiding (Property, Var, check, property, test, withDiscards, withTests)
 import Hedgehog.Gen qualified as Gen
 import Hedgehog.Internal.Property (LabelName (unLabelName))
@@ -53,6 +52,7 @@ import Primer.Examples qualified as Examples (
   map',
   odd,
  )
+import Primer.Gen.Core.Typed (WT, forAllT, genChk, genSyn, genWTType, isolateWT, propertyWT)
 import Primer.Module (Module (Module, moduleDefs, moduleName, moduleTypes), moduleDefsQualified, moduleTypesQualified)
 import Primer.Name (Name)
 import Primer.Primitives (primitiveGVar, primitiveModule, tChar, tInt)
@@ -62,14 +62,16 @@ import Primer.Typecheck (
   extendGlobalCxt,
   typeDefs,
  )
-import Test.Tasty.HUnit (Assertion, assertBool, assertFailure, (@?=))
-import TestM
-import TestUtils (
+import Tasty (
   Property,
   property,
   withDiscards,
-  withPrimDefs,
   withTests,
+ )
+import Test.Tasty.HUnit (Assertion, assertBool, assertFailure, (@?=))
+import TestM
+import TestUtils (
+  withPrimDefs,
   zeroIDs,
  )
 import Tests.Action.Prog (runAppTestM)

primer/test/Tests/Gen/Core/Typed.hs

@@ -5,16 +5,6 @@ module Tests.Gen.Core.Typed where
 
 import Data.Map qualified as M
 import Foreword hiding (diff)
-import Gen.Core.Typed (
-  WT,
-  genChk,
-  genCxtExtendingGlobal,
-  genCxtExtendingLocal,
-  genSyns,
-  genWTKind,
-  genWTType,
-  propertyWT,
- )
 import Hedgehog (
   PropertyT,
   annotateShow,
@@ -37,6 +27,16 @@ import Primer.Core.Utils (
   generateIDs,
   generateTypeIDs,
  )
+import Primer.Gen.Core.Typed (
+  WT,
+  genChk,
+  genCxtExtendingGlobal,
+  genCxtExtendingLocal,
+  genSyns,
+  genWTKind,
+  genWTType,
+  propertyWT,
+ )
 import Primer.Module (Module)
 import Primer.Primitives (primitiveModule)
 import Primer.Typecheck (
@@ -52,7 +52,7 @@ import Primer.Typecheck (
   synth,
   synthKind,
  )
-import TestUtils (Property, withDiscards, withTests)
+import Tasty (Property, withDiscards, withTests)
 
 inExtendedGlobalCxt :: PropertyT WT a -> PropertyT WT a
 inExtendedGlobalCxt p = do