refactor: Create primer-testlib and primer-rel8-testlib packages.

primer-rel8/test/TestUtils.hs

@@ -2,7 +2,6 @@
 
 module TestUtils (
   insertSessionRow,
-  testApp,
   withDbSetup,
   lowPrecisionCurrentTime,
   runTmpDb,
@@ -17,7 +16,6 @@ import Control.Monad.Log (
   discardLogging,
  )
 import Data.ByteString.Lazy.UTF8 as BL
-import Data.Map.Strict qualified as Map
 import Data.String (String)
 import Data.Time (
   UTCTime (..),
@@ -47,17 +45,6 @@ import Hasql.Pool (
  )
 import Hasql.Session (statement)
 import Network.Socket.Free (getFreePort)
-import Primer.App (
-  App,
-  Prog (..),
-  defaultProg,
-  mkApp,
- )
-import Primer.Core (
-  baseName,
-  mkSimpleModuleName,
- )
-import Primer.Core.DSL (create)
 import Primer.Database (
   LastModified (..),
   getCurrentTime,
@@ -67,17 +54,6 @@ import Primer.Database.Rel8 (
   runRel8DbT,
  )
 import Primer.Database.Rel8.Schema as Schema hiding (app)
-import Primer.Examples (comprehensive)
-import Primer.Module (
-  Module (
-    Module,
-    moduleDefs,
-    moduleName,
-    moduleTypes
-  ),
-  builtinModule,
-  primitiveModule,
- )
 import Rel8 (
   Expr,
   Insert (Insert, into, onConflict, returning, rows),
@@ -182,27 +158,6 @@ insertSessionRow row pool =
             , returning = NumberOfRowsAffected
             }
 
--- | An initial test 'App' instance that contains all default type
--- definitions (including primitive types), all primitive functions,
--- and a top-level definition with extensive coverage of Primer's
--- core language.
-testApp :: App
-testApp =
-  let modName = mkSimpleModuleName "TestModule"
-      ((defName, def), id_) = create $ comprehensive modName
-      testProg =
-        defaultProg
-          { progImports = [builtinModule, primitiveModule]
-          , progModules =
-              [ Module
-                  { moduleName = mkSimpleModuleName "TestModule"
-                  , moduleTypes = mempty
-                  , moduleDefs = Map.singleton (baseName defName) def
-                  }
-              ]
-          }
-   in mkApp id_ (toEnum 0) testProg
-
 -- | PostgreSQL's timestamp type has a precision of 1 microsecond, but
 -- 'getCurrentTime' has a precision of 1 picosecond. In order to
 -- compare times for our tests, we need to truncate the precision of

primer-rel8/test/Tests/InsertSession.hs

@@ -19,6 +19,9 @@ import Primer.Database (
 import Primer.Database.Rel8.Rel8Db (
   Rel8DbException (InsertError),
  )
+import Primer.Test.App (
+  comprehensive,
+ )
 import Primer.Test.Util (
   assertException,
   (@?=),
@@ -28,7 +31,6 @@ import Test.Tasty.HUnit (testCaseSteps)
 import TestUtils (
   lowPrecisionCurrentTime,
   runTmpDb,
-  testApp,
  )
 
 expectedError :: SessionId -> Rel8DbException -> Bool
@@ -39,44 +41,44 @@ test_insertSession_roundtrip :: TestTree
 test_insertSession_roundtrip = testCaseSteps "insertSession database round-tripping" $ \step' ->
   runTmpDb $ do
     let step = liftIO . step'
-    step "Insert testApp"
+    step "Insert comprehensive"
     now <- lowPrecisionCurrentTime
     let version = "git123"
-    let name = safeMkSessionName "testApp"
+    let name = safeMkSessionName "comprehensive"
     sessionId <- liftIO newSessionId
-    insertSession version sessionId testApp name now
+    insertSession version sessionId comprehensive name now
 
     step "Retrieve it"
     result <- querySessionId sessionId
-    result @?= Right (SessionData testApp name now)
+    result @?= Right (SessionData comprehensive name now)
 
     let jpName = safeMkSessionName "サンプルプログラム"
     step "Insert app with Japanese name"
     sid1 <- liftIO newSessionId
-    insertSession version sid1 testApp jpName now
+    insertSession version sid1 comprehensive jpName now
     r1 <- querySessionId sid1
-    r1 @?= Right (SessionData testApp jpName now)
+    r1 @?= Right (SessionData comprehensive jpName now)
 
     let cnName = safeMkSessionName "示例程序"
     step "Insert app with simplified Chinese name"
     sid2 <- liftIO newSessionId
-    insertSession version sid2 testApp cnName now
+    insertSession version sid2 comprehensive cnName now
     r2 <- querySessionId sid2
-    r2 @?= Right (SessionData testApp cnName now)
+    r2 @?= Right (SessionData comprehensive cnName now)
 
     let arName = safeMkSessionName "برنامج مثال"
     step "Insert app with Arabic name"
     sid3 <- liftIO newSessionId
-    insertSession version sid3 testApp arName now
+    insertSession version sid3 comprehensive arName now
     r3 <- querySessionId sid3
-    r3 @?= Right (SessionData testApp arName now)
+    r3 @?= Right (SessionData comprehensive arName now)
 
     let emName = safeMkSessionName "😄😂🤣🤗 🦊 🦈"
     step "Insert app with emoji name"
     sid4 <- liftIO newSessionId
-    insertSession version sid4 testApp emName now
+    insertSession version sid4 comprehensive emName now
     r4 <- querySessionId sid4
-    r4 @?= Right (SessionData testApp emName now)
+    r4 @?= Right (SessionData comprehensive emName now)
 
 test_insertSession_failure :: TestTree
 test_insertSession_failure = testCaseSteps "insertSession failure modes" $ \step' ->

primer-rel8/test/Tests/UpdateSessionApp.hs

@@ -20,6 +20,9 @@ import Primer.Database (
 import Primer.Database.Rel8 (
   Rel8DbException (UpdateAppNonExistentSession),
  )
+import Primer.Test.App (
+  comprehensive,
+ )
 import Primer.Test.Util (
   assertException,
   (@?=),
@@ -29,7 +32,6 @@ import Test.Tasty.HUnit (testCaseSteps)
 import TestUtils (
   lowPrecisionCurrentTime,
   runTmpDb,
-  testApp,
  )
 
 expectedError :: SessionId -> Rel8DbException -> Bool
@@ -60,15 +62,15 @@ test_updateSessionApp_roundtrip = testCaseSteps "updateSessionApp database round
     r2 @?= Right (SessionData newEmptyApp name now)
 
     step "Update it with a new app"
-    updateSessionApp newVersion sessionId testApp now
+    updateSessionApp newVersion sessionId comprehensive now
     r3 <- querySessionId sessionId
-    r3 @?= Right (SessionData testApp name now)
+    r3 @?= Right (SessionData comprehensive name now)
 
     step "Update it with a new time"
     now' <- lowPrecisionCurrentTime
-    updateSessionApp newVersion sessionId testApp now'
+    updateSessionApp newVersion sessionId comprehensive now'
     r4 <- querySessionId sessionId
-    r4 @?= Right (SessionData testApp name now')
+    r4 @?= Right (SessionData comprehensive name now')
 
 test_updateSessionApp_failure :: TestTree
 test_updateSessionApp_failure = testCaseSteps "updateSessionApp failure modes" $ \step' ->

primer/primer.cabal

@@ -166,7 +166,10 @@ library primer-hedgehog
 
 library primer-testlib
   visibility:         public
-  exposed-modules:    Primer.Test.Util
+  exposed-modules:
+    Primer.Test.App
+    Primer.Test.Util
+
   other-modules:
   hs-source-dirs:     testlib
   default-language:   GHC2021

primer/testlib/Primer/Test/App.hs

@@ -0,0 +1,50 @@
+module Primer.Test.App (
+  comprehensive,
+) where
+
+import Foreword
+
+import Data.Map.Strict qualified as Map
+import Primer.App (
+  App,
+  Prog (..),
+  defaultProg,
+  mkApp,
+ )
+import Primer.Core (
+  baseName,
+  mkSimpleModuleName,
+ )
+import Primer.Core.DSL (create)
+import Primer.Examples qualified as Examples
+import Primer.Module (
+  Module (
+    Module,
+    moduleDefs,
+    moduleName,
+    moduleTypes
+  ),
+  builtinModule,
+  primitiveModule,
+ )
+
+-- | An initial test 'App' instance that contains all default type
+-- definitions (including primitive types), all primitive functions,
+-- and a top-level definition with extensive coverage of Primer's
+-- core language.
+comprehensive :: App
+comprehensive =
+  let modName = mkSimpleModuleName "TestModule"
+      ((defName, def), id_) = create $ Examples.comprehensive modName
+      testProg =
+        defaultProg
+          { progImports = [builtinModule, primitiveModule]
+          , progModules =
+              [ Module
+                  { moduleName = mkSimpleModuleName "TestModule"
+                  , moduleTypes = mempty
+                  , moduleDefs = Map.singleton (baseName defName) def
+                  }
+              ]
+          }
+   in mkApp id_ (toEnum 0) testProg