Split tasty and hspec runners

Alas I (Alfredo) had to split the runners for tasty and hspec because in
tasty we cannot control explicitly the level of parallelism, but for the
DB stuff we need sequential tests, whereas for the Jobs tests we need
parallelism, or rather the executable to be compiled with `-threaded`.

cabal.project.freeze

 active-repositories: hackage.haskell.org:merge
+
+allow-newer: servant-swagger:hspec
+           , servant-swagger:hspec-core
+
 constraints: any.Cabal ==3.2.1.0,
              any.Diff ==0.4.1,
              any.Glob ==0.10.2,
@@ -274,9 +278,9 @@ constraints: any.Cabal ==3.2.1.0,
              any.hslua-module-system ==0.2.2.1,
              any.hslua-module-text ==0.3.0.1,
              any.hsparql ==0.3.8,
-             any.hspec ==2.7.10,
-             any.hspec-core ==2.7.10,
-             any.hspec-discover ==2.7.10,
+             any.hspec ==2.11.1,
+             any.hspec-core ==2.11.1,
+             any.hspec-discover ==2.11.1,
              any.hspec-expectations ==0.8.3,
              any.hstatistics ==0.3.1,
              any.html-entities ==1.1.4.5,
@@ -556,7 +560,7 @@ constraints: any.Cabal ==3.2.1.0,
              any.tasty ==1.4.2.1,
              tasty +clock +unix,
              any.tasty-bench ==0.2.5,
-             any.tasty-hspec ==1.1.6,
+             any.tasty-hspec ==1.2.0.3,
              any.tasty-hunit ==0.10.0.3,
              any.tasty-quickcheck ==0.10.2,
              any.tasty-smallcheck ==0.8.2,

gargantext.cabal

@@ -874,9 +874,9 @@ executable gargantext-upgrade
     , text ^>= 1.2.4.1
   default-language: Haskell2010
 
-test-suite garg-test
+test-suite garg-test-tasty
   type: exitcode-stdio-1.0
-  main-is: Main.hs
+  main-is: tasty/Main.hs
   other-modules:
       Core.Text
       Core.Text.Corpus.Query
@@ -929,7 +929,87 @@ test-suite garg-test
       NoImplicitPrelude
       OverloadedStrings
       RankNTypes
-  ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N1
+  ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N
+  build-depends:
+      QuickCheck ^>= 2.14.2
+    , aeson ^>= 1.5.6.0
+    , async ^>= 2.2.4
+    , base ^>= 4.14.3.0
+    , boolexpr ^>= 0.2
+    , bytestring ^>= 0.10.12.0
+    , conduit ^>= 1.3.4.2
+    , containers ^>= 0.6.5.1
+    , crawlerArxiv
+    , duckling ^>= 0.2.0.0
+    , extra ^>= 1.7.9
+    , gargantext
+    , gargantext-prelude
+    , hspec ^>= 2.7.10
+    , hspec-core
+    , hspec-expectations >= 0.8 && < 0.9
+    , http-client ^>= 0.6.4.1
+    , http-client-tls ^>= 0.3.5.3
+    , lens >= 5.2.2 && < 5.3
+    , monad-control >= 1.0.3 && < 1.1
+    , mtl ^>= 2.2.2
+    , parsec ^>= 3.1.14.0
+    , patches-class ^>= 0.1.0.1
+    , patches-map ^>= 0.1.0.1
+    , postgres-options >= 0.2 && < 0.3
+    , postgresql-simple >= 0.6.4 && < 0.7
+    , quickcheck-instances ^>= 0.3.25.2
+    , raw-strings-qq
+    , recover-rtti >= 0.4 && < 0.5
+    , resource-pool >= 0.2.3.2 && < 0.2.4
+    , servant-job
+    , shelly >= 1.9 && < 2
+    , stm ^>= 2.5.0.1
+    , tasty ^>= 1.4.2.1
+    , tasty-hspec
+    , tasty-hunit
+    , tasty-quickcheck
+    , tasty-smallcheck
+    , text ^>= 1.2.4.1
+    , time ^>= 1.9.3
+    , tmp-postgres >= 1.34.1 && < 1.35
+    , unordered-containers ^>= 0.2.16.0
+    , validity ^>= 0.11.0.1
+  default-language: Haskell2010
+
+test-suite garg-test-hspec
+  type: exitcode-stdio-1.0
+  main-is: hspec/Main.hs
+  other-modules:
+      Database.Operations
+      Paths_gargantext
+  hs-source-dirs:
+      test
+  default-extensions:
+      DataKinds
+      DeriveGeneric
+      FlexibleContexts
+      FlexibleInstances
+      GADTs
+      GeneralizedNewtypeDeriving
+      ImportQualifiedPost
+      MultiParamTypeClasses
+      NamedFieldPuns
+      NoImplicitPrelude
+      OverloadedStrings
+      RankNTypes
+      RecordWildCards
+      StrictData
+      DataKinds
+      DeriveGeneric
+      FlexibleContexts
+      FlexibleInstances
+      GeneralizedNewtypeDeriving
+      ImportQualifiedPost
+      MultiParamTypeClasses
+      NoImplicitPrelude
+      OverloadedStrings
+      RankNTypes
+  ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N
   build-depends:
       QuickCheck ^>= 2.14.2
     , aeson ^>= 1.5.6.0
@@ -945,6 +1025,7 @@ test-suite garg-test
     , gargantext
     , gargantext-prelude
     , hspec ^>= 2.7.10
+    , hspec-core
     , hspec-expectations >= 0.8 && < 0.9
     , http-client ^>= 0.6.4.1
     , http-client-tls ^>= 0.3.5.3
@@ -967,6 +1048,7 @@ test-suite garg-test
     , tasty-hspec
     , tasty-hunit
     , tasty-quickcheck
+    , tasty-smallcheck
     , text ^>= 1.2.4.1
     , time ^>= 1.9.3
     , tmp-postgres >= 1.34.1 && < 1.35

test/Database/Operations.hs

@@ -4,7 +4,9 @@
 {-# LANGUAGE UndecidableInstances #-}
 {-# OPTIONS_GHC -Wno-orphans      #-}
 
-module Database.Operations where
+module Database.Operations (
+   tests
+  ) where
 
 import Control.Exception hiding (assert)
 import Control.Lens hiding (elements)
@@ -14,7 +16,9 @@ import Control.Monad.Trans.Control
 import Data.IORef
 import Data.Pool hiding (withResource)
 import Data.String
+import Database.PostgreSQL.Simple
 import Gargantext.Core.Types.Individu
+import Gargantext.Database.Action.User
 import Gargantext.Database.Action.User.New
 import Gargantext.Database.Prelude
 import Gargantext.Database.Query.Table.Node.Error
@@ -23,9 +27,8 @@ import Gargantext.Prelude.Config
 import Prelude
 import Shelly hiding (FilePath, run)
 import Test.QuickCheck.Monadic
-import Test.Tasty
+import Test.Hspec
 import Test.Tasty.HUnit hiding (assert)
-import Test.Tasty.Hspec
 import Test.Tasty.QuickCheck
 import qualified Data.Pool as Pool
 import qualified Data.Text as T
@@ -36,8 +39,6 @@ import qualified Database.Postgres.Temp as Tmp
 import qualified Shelly as SH
 
 import Paths_gargantext
-import Database.PostgreSQL.Simple
-import Gargantext.Database.Action.User
 
 -- | Keeps a log of usernames we have already generated, so that our
 -- roundtrip tests won't fail.
@@ -101,9 +102,6 @@ fakeIniPath = getDataFileName "test-data/test_config.ini"
 gargDBSchema :: IO FilePath
 gargDBSchema = getDataFileName "devops/postgres/schema.sql"
 
-gargDBExtensionsSchema :: IO FilePath
-gargDBExtensionsSchema = getDataFileName "devops/postgres/extensions.sql"
-
 teardown :: TestEnv -> IO ()
 teardown TestEnv{..} = do
   destroyAllResources $ _DBHandle test_db
@@ -141,18 +139,16 @@ setup = do
       ugen <- emptyCounter
       pure $ TestEnv (DBHandle pool db) gargConfig ugen
 
-tests :: TestTree
-tests = withResource setup teardown $
-  \getEnv -> testGroup "Database" [unitTests getEnv]
+withTestDB :: (TestEnv -> IO ()) -> IO ()
+withTestDB = bracket setup teardown
 
-unitTests :: IO TestEnv -> TestTree
-unitTests getEnv = testGroup "Read/Writes"
-  [ testGroup "User creation" [
-      testCase     "Simple write/read" (writeRead01 getEnv)
-    , testCase     "Simple duplicate"  (mkUserDup getEnv)
-    , testProperty "Read/Write roundtrip" $ prop_userCreationRoundtrip getEnv
-    ]
-  ]
+tests :: Spec
+tests = sequential $ aroundAll withTestDB $ describe "Database" $ do
+  describe "Read/Writes" $
+    describe "User creation" $ do
+      it "Simple write/read" writeRead01
+      it "Simple duplicate"  mkUserDup
+      it "Read/Write roundtrip" prop_userCreationRoundtrip
 
 data ExpectedActual a =
     Expected a
@@ -165,9 +161,8 @@ instance Eq a => Eq (ExpectedActual a) where
   _ == _ = False
 
 
-writeRead01 :: IO TestEnv -> Assertion
-writeRead01 getEnv = do
-  env <- getEnv
+writeRead01 :: TestEnv -> Assertion
+writeRead01 env = do
   flip runReaderT env $ runTestMonad $ do
     let nur1 = mkNewUser "alfredo@well-typed.com" (GargPassword "my_secret")
     let nur2 = mkNewUser "paul@acme.com" (GargPassword "my_secret")
@@ -184,9 +179,8 @@ writeRead01 getEnv = do
     liftBase $ uid1' `shouldBe` 1
     liftBase $ uid2' `shouldBe` 2
 
-mkUserDup :: IO TestEnv -> Assertion
-mkUserDup getEnv = do
-  env <- getEnv
+mkUserDup :: TestEnv -> Assertion
+mkUserDup env = do
   let x = flip runReaderT env $ runTestMonad $ do
             -- This should fail, because user 'alfredo' exists already.
             let nur = mkNewUser "alfredo@well-typed.com" (GargPassword "my_secret")
@@ -205,9 +199,8 @@ mkUserDup getEnv = do
 runEnv :: TestEnv -> TestMonad a -> PropertyM IO a
 runEnv env act = run (flip runReaderT env $ runTestMonad act)
 
-prop_userCreationRoundtrip :: IO TestEnv -> Property
-prop_userCreationRoundtrip getEnv = monadicIO $ do
-  env  <- run getEnv
+prop_userCreationRoundtrip :: TestEnv -> Property
+prop_userCreationRoundtrip env = monadicIO $ do
   nextAvailableCounter <- run (nextCounter $ test_usernameGen env)
   nur  <- pick (uniqueArbitraryNewUser nextAvailableCounter)
   uid <- runEnv env (new_user nur)

test/Utils/Jobs.hs

@@ -228,6 +228,7 @@ instance MonadJobStatus MyDummyMonad where
   markFailure steps mb_msg jh = MyDummyMonad (markFailure steps mb_msg jh)
   markComplete jh             = MyDummyMonad (markComplete jh)
   markFailed mb_msg jh        = MyDummyMonad (markFailed mb_msg jh)
+  addMoreSteps steps jh       = MyDummyMonad (addMoreSteps steps jh)
 
 runMyDummyMonad :: Env -> MyDummyMonad a -> IO a
 runMyDummyMonad env m = do

test/hspec/Main.hs

+
+module Main where
+
+import Gargantext.Prelude
+
+import qualified Database.Operations     as DB
+
+import Test.Hspec
+
+-- It's especially important to use Hspec for DB tests, because,
+-- unlike 'tasty', 'Hspec' has explicit control over parallelism,
+-- and it's important that DB tests are run according to a very
+-- precise order, as they are not independent from each other.
+-- Unfortunately it's not possibly to use the 'tasty-hspec' adapter
+-- because by the time we get a 'TestTree' out of the adapter library,
+-- the information about parallelism is lost.
+main :: IO ()
+main = hspec DB.tests

test/Main.hs → test/tasty/Main.hs

-{-|
+{--|
 Module      : Main.hs
-Description : Main for Gargantext Tests
+Description : Main for Gargantext Tasty Tests
 Copyright   : (c) CNRS, 2017-Present
 License     : AGPL + CECILL v3
 Maintainer  : team@gargantext.org
@@ -8,6 +8,7 @@ Stability   : experimental
 Portability : POSIX
 -}
 
+module Main where
 
 import Gargantext.Prelude
 
@@ -44,5 +45,4 @@ main = do
     , NgramsQuery.tests
     , CorpusQuery.tests
     , JSON.tests
-    , DB.tests
     ]