Fuse hspec and tasty drivers into one

This commit fuses the two drivers into a single one.
With some appropriate usage of `beforeAllWith`, even running all the
specs in parallel seems to be yielding the expected results.

gargantext.cabal

@@ -786,12 +786,12 @@ common commonTestDependencies
     , warp
     , websockets
 
-test-suite garg-test-tasty
+test-suite garg-test
   import:
       defaults
     , commonTestDependencies
   type: exitcode-stdio-1.0
-  main-is: drivers/tasty/Main.hs
+  main-is: Main.hs
   build-depends:
       aeson-pretty ^>= 0.8.9
     , accelerate >= 1.3.0.0
@@ -802,29 +802,40 @@ test-suite garg-test-tasty
     , directory ^>= 1.3.7.1
     , graphviz ^>= 2999.20.1.0
     , massiv < 1.1
+    , process ^>= 1.6.18.0
     , scientific < 0.4
+    , servant >= 0.20.1 && < 0.21
     , split
+    , sqlite-simple >= 0.4.19 && < 0.5
     , tasty >= 1.4.3 && < 1.6
     , tasty-golden
     , tasty-hspec
     , time ^>= 1.12.2
     , unicode-collation >= 0.1.3.5
+    , unix >= 2.7.3 && < 2.9
     , unordered-containers ^>= 0.2.16.0
     , utf8-string ^>= 1.0.2
     , vector >= 0.12.3.0 && <= 0.13.1.0
   other-modules:
       CLI.Phylo.Common
       Paths_gargantext
+      Test.API
+      Test.API.Authentication
+      Test.API.Errors
+      Test.API.Export
+      Test.API.GraphQL
+      Test.API.Notifications
+      Test.API.Prelude
+      Test.API.Private
       Test.API.Private.List
       Test.API.Private.Move
       Test.API.Private.Remote
       Test.API.Private.Share
       Test.API.Private.Table
-      Test.API.Authentication
       Test.API.Routes
       Test.API.Setup
-      Test.API.Prelude
       Test.API.UpdateList
+      Test.API.Worker
       Test.Core.LinearAlgebra
       Test.Core.Notifications
       Test.Core.Orchestrator
@@ -875,53 +886,6 @@ test-suite garg-test-tasty
       test bin/gargantext-cli
   ghc-options: -Wall -Werror -threaded -rtsopts -with-rtsopts=-N
 
-test-suite garg-test-hspec
-  import:
-      defaults
-    , commonTestDependencies
-  type: exitcode-stdio-1.0
-  main-is: drivers/hspec/Main.hs
-  build-depends:
-      process ^>= 1.6.18.0
-    , servant >= 0.20.1 && < 0.21
-    , sqlite-simple >= 0.4.19 && < 0.5
-    , unix >= 2.7.3 && < 2.9
-  other-modules:
-      Paths_gargantext
-      Test.API
-      Test.API.Authentication
-      Test.API.Errors
-      Test.API.Export
-      Test.API.GraphQL
-      Test.API.Notifications
-      Test.API.Private
-      Test.API.Private.List
-      Test.API.Private.Move
-      Test.API.Private.Remote
-      Test.API.Private.Share
-      Test.API.Private.Table
-      Test.API.Routes
-      Test.API.Setup
-      Test.API.Prelude
-      Test.API.UpdateList
-      Test.API.Worker
-      Test.Database.Operations
-      Test.Database.Operations.DocumentSearch
-      Test.Database.Operations.NodeStory
-      Test.Database.Operations.PublishNode
-      Test.Database.Setup
-      Test.Database.Transactions
-      Test.Database.Types
-      Test.Instances
-      Test.Server.ReverseProxy
-      Test.Types
-      Test.Utils
-      Test.Utils.Db
-      Test.Utils.Notifications
-  hs-source-dirs:
-      test
-  ghc-options: -Wall -Werror -threaded -rtsopts -with-rtsopts=-N
-
 benchmark garg-bench
   main-is:       Main.hs
   hs-source-dirs: bench

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

+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE OverloadedStrings #-}
 {--|
 Module      : Main.hs
 Description : Main for Gargantext Tasty Tests
@@ -10,7 +12,7 @@ Portability : POSIX
 
 module Main where
 
-import Gargantext.Prelude
+import Gargantext.Prelude hiding (isInfixOf)
 
 import qualified Test.Core.LinearAlgebra         as LinearAlgebra
 import qualified Test.Core.Notifications         as Notifications
@@ -34,10 +36,20 @@ import qualified Test.Offline.Stemming.Lancaster as Lancaster
 import qualified Test.Parsers.Date               as PD
 import qualified Test.Utils.Crypto               as Crypto
 import qualified Test.Utils.Jobs                 as Jobs
+import qualified Test.API                        as API
+import qualified Test.Database.Operations        as DB
+import qualified Test.Database.Transactions      as DBT
+import qualified Test.Server.ReverseProxy        as ReverseProxy
 
+import Data.Text (isInfixOf)
+import Data.Text qualified as T
 import System.IO (hGetBuffering, hSetBuffering)
+import System.Posix.Process
+import System.Posix.Signals
+import System.Process
 import Test.Tasty
 import Test.Tasty.Hspec
+import qualified Prelude
 
 -- | https://mercurytechnologies.github.io/ghciwatch/integration/tasty.html
 protectStdoutBuffering :: IO a -> IO a
@@ -47,6 +59,37 @@ protectStdoutBuffering action =
     (\bufferMode -> hSetBuffering stdout bufferMode)
     (const action)
 
+startCoreNLPServer :: IO ProcessHandle
+startCoreNLPServer = do
+  putText "calling start core nlp"
+  devNull <- openFile "/dev/null" WriteMode
+  let p = proc "startCoreNLPServer.sh" []
+  (_, _, _, hdl) <- (createProcess $ p { cwd = Nothing
+                    -- NOTE(adn) Issue #451, this one has to stay disabled, because if we
+                    -- turn it on, despite the confusing documentation on the `process` library
+                    -- it will cause the Haskell RTS to completely ignore the Ctrl^c and instead
+                    -- delegate it exclusively to the process here, which means that our CoreNLP
+                    -- server will shut down correctly, but the test running will stop responding
+                    -- to Ctrl^C requests.
+                    , delegate_ctlc = False
+                    , create_group = True
+                    , std_out = UseHandle devNull
+                    , std_err = UseHandle devNull
+                    }) `catch` \e -> case e of
+                                           _ | True <- "does not exist" `isInfixOf` (T.pack . show @SomeException $ e)
+                                             -> Prelude.fail $ "Cannot execute the 'startCoreNLPServer.sh' script. Make sure you are in a nix environment."
+                                             | otherwise -> throwIO e
+  pure hdl
+
+killProcessTree :: ProcessHandle -> IO ()
+killProcessTree ph = do
+  pid <- getPid ph
+  case pid of
+    Nothing -> putText "Process already terminated"
+    Just p -> do
+      pgid <- getProcessGroupIDOf p
+      signalProcessGroup keyboardSignal pgid
+
 main :: IO ()
 main = do
   utilSpec         <- testSpec "Utils" Utils.test
@@ -59,30 +102,41 @@ main = do
   similaritySpec   <- testSpec "Similarity" Similarity.test
   asyncUpdatesSpec <- testSpec "Notifications" Notifications.test
   occurrencesSpec  <- testSpec "Occurrences" Occurrences.test
+  apiSpec          <- testSpec "API" API.tests
+  revProxySpec     <- testSpec "Reverse Proxy" ReverseProxy.tests
+  dbSpec           <- testSpec "Database Operations" DB.tests
+  dbTxSpec         <- testSpec "Database Transactions" DBT.tests
+  nodeStorySpec    <- testSpec "Node Story" DB.nodeStoryTests
 
-  protectStdoutBuffering $ defaultMain $ testGroup "Gargantext"
-    [ utilSpec
-    , clusteringSpec
-    , distanceSpec
-    , dateSplitSpec
-    , cryptoSpec
-    , nlpSpec
-    , jobsSpec
-    , occurrencesSpec
-    , NgramsQuery.tests
-    , occurrencesSpec
-    , CorpusQuery.tests
-    , TSVParser.tests
-    , JSON.tests
-    , Ngrams.tests
-    , Errors.tests
-    , similaritySpec
-    , Phylo.tests
-    , testGroup "Stemming" [ Lancaster.tests ]
-    , Worker.tests
-    , asyncUpdatesSpec
-    , Notifications.qcTests
-    , Orchestrator.qcTests
-    , NgramsTerms.tests
-    , LinearAlgebra.tests
-    ]
+  protectStdoutBuffering $ defaultMain $
+    withResource startCoreNLPServer killProcessTree $ \_ -> testGroup "Gargantext"
+      [ utilSpec
+      , clusteringSpec
+      , distanceSpec
+      , dateSplitSpec
+      , cryptoSpec
+      , nlpSpec
+      , jobsSpec
+      , occurrencesSpec
+      , NgramsQuery.tests
+      , occurrencesSpec
+      , CorpusQuery.tests
+      , TSVParser.tests
+      , JSON.tests
+      , Ngrams.tests
+      , Errors.tests
+      , similaritySpec
+      , Phylo.tests
+      , testGroup "Stemming" [ Lancaster.tests ]
+      , Worker.tests
+      , asyncUpdatesSpec
+      , Notifications.qcTests
+      , Orchestrator.qcTests
+      , NgramsTerms.tests
+      , LinearAlgebra.tests
+      , apiSpec
+      , revProxySpec
+      , dbSpec
+      , dbTxSpec
+      , nodeStorySpec
+      ]

test/Test/API/Private.hs

@@ -31,6 +31,7 @@ import Test.Hspec.Wai hiding (pendingWith)
 import Test.Hspec.Wai.Internal (withApplication)
 import Test.Hspec.Wai.JSON (json)
 import Test.Utils (protected, shouldRespondWithFragment, withValidLogin)
+import qualified Prelude
 
 
 nodeTests :: Spec
@@ -59,7 +60,7 @@ nodeTests = sequential $ aroundAll withTestDBAndPort $ beforeAllWith dbEnvSetup
               admin_user_api_get = (getRootsEp . rootsEp $ gargAdminClient :: ClientM [Node HyperdataUser])
 
           _nodes <- runClientM admin_user_api_get clientEnv
-          pendingWith "currently useless"
+          liftIO $ Prelude.putStrLn "currently useless"
 
     describe "GET /api/v1.0/node" $ do
 

test/Test/API/Private/List.hs

@@ -31,7 +31,7 @@ import Test.API.Prelude (newCorpusForUser, checkEither)
 import Test.API.Routes
 import Test.API.Setup
 import Test.Database.Types
-import Test.Hspec (Spec, it, aroundAll, describe, sequential)
+import Test.Hspec (Spec, it, aroundAll, describe, sequential, beforeAllWith)
 import Test.Hspec.Expectations
 import Test.Hspec.Wai.Internal (withApplication)
 import Test.Utils
@@ -80,13 +80,7 @@ importCorpusTSV (SpecContext testEnv port app _) name = do
       pure (jobLog, cId, listId)
 
 tests :: Spec
-tests = sequential $ aroundAll withTestDBAndPort $ do
-  describe "Prelude" $ do
-    it "setup DB triggers" $ \SpecContext{..} -> do
-      setupEnvironment _sctx_env
-      -- Let's create the Alice user.
-      void $ createAliceAndBob _sctx_env
-
+tests = sequential $ aroundAll withTestDBAndPort $ beforeAllWith dbEnvSetup $ do
     describe "Importing terms as TSV" $ do
 
       it "should work for TSV with a missing 'forms' column" $ \ctx@(SpecContext _ port app _) -> do

test/Test/API/Private/Move.hs

@@ -16,20 +16,14 @@ import Servant.Client.Streaming
 import Test.API.Prelude
 import Test.API.Routes
 import Test.API.Setup
-import Test.Hspec (Spec, it, aroundAll, describe, sequential)
+import Test.Hspec (Spec, it, aroundAll, describe, sequential, beforeAllWith)
 import Test.Hspec.Wai.Internal (withApplication)
 import Test.Hspec.Expectations.Lifted
 import Test.Tasty.HUnit (assertBool)
 import Test.Utils
 
 tests :: Spec
-tests = sequential $ aroundAll withTestDBAndPort $ do
-  describe "Prelude" $ do
-    it "setup DB triggers" $ \SpecContext{..} -> do
-      setupEnvironment _sctx_env
-      -- Let's create the Alice user.
-      void $ createAliceAndBob _sctx_env
-
+tests = sequential $ aroundAll withTestDBAndPort $ beforeAllWith dbEnvSetup $ do
     describe "Moving a node" $ do
 
       describe "private to private moves" $ do

test/Test/API/Private/Remote.hs

@@ -23,12 +23,14 @@ import Test.API.Prelude
 import Test.API.Setup
 import Test.Database.Setup
 import Test.Database.Types
-import Test.Hspec (Spec, it, aroundAll, describe, sequential, shouldBe)
+import Test.Hspec (Spec, it, aroundAll, describe, sequential, shouldBe, beforeAllWith)
 import Test.Hspec.Wai.Internal (withApplication)
 import Test.Utils
 
+type ExtraCtx = (TestEnv,Wai.Application,Warp.Port)
+
 -- | Helper to let us test transferring data between two instances.
-withTwoServerInstances :: (SpecContext (TestEnv,Wai.Application,Warp.Port) -> IO ()) -> IO ()
+withTwoServerInstances :: (SpecContext ExtraCtx -> IO ()) -> IO ()
 withTwoServerInstances action =
   withTestDB $ \testEnv1 -> do
     withTestDB $ \testEnv2 -> do
@@ -47,14 +49,15 @@ withTwoServerInstances action =
     server2Port = 9008
     log_cfg te  = test_config te ^. gc_logging
 
-tests :: Spec
-tests = sequential $ aroundAll withTwoServerInstances $ do
-  describe "Prelude" $ do
-    it "setup DB triggers" $ \SpecContext{..} -> do
-      forM_ [ _sctx_env, _sctx_data ^. _1 ] $ \e -> do
-        setupEnvironment e
-        void $ createAliceAndBob e
+setupRemoteDBs :: SpecContext ExtraCtx -> IO (SpecContext ExtraCtx)
+setupRemoteDBs c@SpecContext{..} = do
+  forM_ [ _sctx_env, _sctx_data ^. _1 ] $ \e -> do
+    setupEnvironment e
+    void $ createAliceAndBob e
+  pure c
 
+tests :: Spec
+tests = sequential $ aroundAll withTwoServerInstances $ beforeAllWith setupRemoteDBs $ do
     describe "Copying nodes across instances" $ do
 
       it "should forbid moving a node the user doesn't own" $ \(SpecContext testEnv1 server1Port app1 (_testEnv2, _app2, server2Port)) -> do

test/drivers/hspec/Main.hs

-{-# LANGUAGE TypeApplications #-}
-
-module Main where
-
-import Control.Monad
-import Data.Text (isInfixOf)
-import Data.Text qualified as T
-import Gargantext.Prelude hiding (isInfixOf)
-import System.IO
-import System.Process
-import System.Posix.Process
-import System.Posix.Signals
-import Test.API qualified as API
-import Test.Database.Operations qualified as DB
-import Test.Database.Transactions qualified as DBT
-import Test.Hspec
-import Test.Server.ReverseProxy qualified as ReverseProxy
-
-
-startCoreNLPServer :: IO ProcessHandle
-startCoreNLPServer = do
-  putText "calling start core nlp"
-  devNull <- openFile "/dev/null" WriteMode
-  let p = proc "startCoreNLPServer.sh" []
-  (_, _, _, hdl) <- (createProcess $ p { cwd = Nothing
-                    -- NOTE(adn) Issue #451, this one has to stay disabled, because if we
-                    -- turn it on, despite the confusing documentation on the `process` library
-                    -- it will cause the Haskell RTS to completely ignore the Ctrl^c and instead
-                    -- delegate it exclusively to the process here, which means that our CoreNLP
-                    -- server will shut down correctly, but the test running will stop responding
-                    -- to Ctrl^C requests.
-                    , delegate_ctlc = False
-                    , create_group = True
-                    , std_out = UseHandle devNull
-                    , std_err = UseHandle devNull
-                    }) `catch` \e -> case e of
-                                           _ | True <- "does not exist" `isInfixOf` (T.pack . show @SomeException $ e)
-                                             -> fail $ "Cannot execute the 'startCoreNLPServer.sh' script. Make sure you are in a nix environment."
-                                             | otherwise -> throwIO e
-  pure hdl
-
-killProcessTree :: ProcessHandle -> IO ()
-killProcessTree ph = do
-  pid <- getPid ph
-  case pid of
-    Nothing -> putText "Process already terminated"
-    Just p -> do
-      pgid <- getProcessGroupIDOf p
-      signalProcessGroup keyboardSignal pgid
-
--- 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.
---
--- /IMPORTANT/: For these tests to run correctly, you have to run
--- ./devops/coreNLP/build.sh first. You have to run it only /once/,
--- and then you are good to go for the time being.
-main :: IO ()
-main = do
-  hSetBuffering stdout NoBuffering
-  bracket startCoreNLPServer killProcessTree (const run_tests)
-  where
-    run_tests = hspec $ sequential $ do
-      API.tests
-      ReverseProxy.tests
-      DB.tests
-      DBT.tests
-      DB.nodeStoryTests
-      runIO $ putText "tests finished"