Merge branch '430-fix-test-build-warnings' into 'dev'

Resolve "Fix test build warnings"

See merge request !376

bin/update-project-dependencies

@@ -18,8 +18,8 @@ fi
 # with the `sha256sum` result calculated on the `cabal.project` and
 # `cabal.project.freeze`. This ensures the files stay deterministic so that CI
 # cache can kick in.
-expected_cabal_project_hash="d5a9510a825fd2352402a7b43d0ebb3ce9342f8449c1dbef8365859e0aff918a"
-expected_cabal_project_freeze_hash="30dd1cf2cb2015351dd0576391d22b187443b1935c2be23599b821ad1ab95f23"
+expected_cabal_project_hash="2b63b5dc1e026a27dcce7cb90080802a3a81f6f968d5edf8f913b8f0fd1203eb"
+expected_cabal_project_freeze_hash="0d9d3d92afcaf2a1fbda3fa393a0990f72fc2ec766473aeecd669f7a5d805466"
 
 
 cabal --store-dir=$STORE_DIR v2-build --dry-run

cabal.project

@@ -85,12 +85,12 @@ source-repository-package
 source-repository-package
     type: git
     location: https://gitlab.iscpif.fr/gargantext/crawlers/epo-proxy-api.git
-    tag: cf4e5004f3b002bdef3fcab95e3559d65cdcd858
+    tag: 8c6286316ab7d461a4b01a2c315dde8519a4cc9f
 
 source-repository-package
     type: git
     location: https://gitlab.iscpif.fr/gargantext/crawlers/hal.git
-    tag: 229fdf40b8ccecd527fca5a7bbb554b0deb540dc
+    tag: 8bf9fc690e7ee3852465bacf8ebbd1aec8358387
 
 source-repository-package
     type: git
@@ -100,17 +100,17 @@ source-repository-package
 source-repository-package
     type: git
     location: https://gitlab.iscpif.fr/gargantext/crawlers/istex.git
-    tag: c0a08d62c40a169b7934ceb7cb12c39952160e7a
+    tag: 521ca54f1502b13f629eff2223aaf5007e6d52ec
 
 source-repository-package
     type: git
     location: https://gitlab.iscpif.fr/gargantext/crawlers/openalex.git
-    tag: 8249a40ff1ba885af45d3958f113af5b8a64c4ac
+    tag: a80e0ea57379d23f5e18a412606a71471b8ef681
 
 source-repository-package
     type: git
     location: https://gitlab.iscpif.fr/gargantext/crawlers/pubmed.git
-    tag: 300764df4f78ea6175535f9b78b884cc2aa9da61
+    tag: 01292aae6e1008e7618b88cddcfdca3b04f0d92e
 
 source-repository-package
     type: git
@@ -210,9 +210,9 @@ allow-newer:
            , accelerate-utility:accelerate
            , base:*
            , crawlerHAL:servant
-           , crawlerISTEX:servant
-           , crawlerPubMed:servant
-           , crawlerPubMed:servant-client-core
+           -- , crawlerISTEX:servant
+           -- , crawlerPubMed:servant
+           -- , crawlerPubMed:servant-client-core
            , iso639:aeson
            , iso639:text
            , morpheus-graphql-app:text

cabal.project.freeze

@@ -464,8 +464,6 @@ constraints: any.Boolean ==0.2.4,
              any.servant-auth-server ==0.4.9.0,
              any.servant-auth-swagger ==0.2.11.0,
              any.servant-blaze ==0.9.1,
-             any.servant-client ==0.19,
-             any.servant-client-core ==0.20.2,
              any.servant-ekg ==0.3.1,
              any.servant-flatten ==0.2,
              any.servant-job ==0.2.0.0,

gargantext.cabal

@@ -587,7 +587,7 @@ library
     , servant-auth-server ^>=0.4.6.0
     , servant-auth-swagger ^>= 0.2.10.1
     , servant-blaze ^>= 0.9.1
-    , servant-client >= 0.19 && < 0.20
+    , servant-client >= 0.20 && < 0.21
     , servant-client-core >= 0.20 && < 0.21
     , servant-ekg ^>= 0.3.1
     , servant-routes < 0.2
@@ -759,7 +759,7 @@ common testDependencies
     , servant-auth
     , servant-auth
     , servant-auth-client
-    , servant-client >= 0.19 && < 0.20
+    , servant-client >= 0.20 && < 0.21
     , servant-client-core >= 0.20 && < 0.21
     , servant-server >= 0.18.3 && < 0.21
     , servant-websockets >= 2.0.0 && < 2.1
@@ -849,7 +849,7 @@ test-suite garg-test-tasty
       Test.Utils.Notifications
   hs-source-dirs:
       test bin/gargantext-cli
-  ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N
+  ghc-options: -Wall -Werror -threaded -rtsopts -with-rtsopts=-N
 
 test-suite garg-test-hspec
   import:
@@ -887,7 +887,7 @@ test-suite garg-test-hspec
       Test.Utils.Notifications
   hs-source-dirs:
       test
-  ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N
+  ghc-options: -Wall -Werror -threaded -rtsopts -with-rtsopts=-N
 
 benchmark garg-bench
   main-is:       Main.hs

src/Gargantext/Core/Text/Corpus/API/Hal.hs

@@ -17,6 +17,7 @@ import Data.LanguageCodes qualified as ISO639
 import Data.Map.Strict qualified as Map
 import Data.Text (pack)
 import Gargantext.Core.Text.Corpus.Parsers.Date qualified as Date
+import Gargantext.Core.Utils (nonemptyIntercalate)
 import Gargantext.Database.Admin.Types.Hyperdata.Document ( HyperdataDocument(..) )
 import Gargantext.Defaults qualified as Defaults
 import Gargantext.Prelude hiding (intercalate)
@@ -52,8 +53,8 @@ toDoc' la (HAL.Document { .. }) = do
                          , _hd_url = Nothing
                          , _hd_page = Nothing
                          , _hd_title = Just $ unwords _document_title
-                         , _hd_authors = Just $ foldl' (\x y -> if x == "" then y else x <> ", " <> y) "" _document_authors_names
-                         , _hd_institutes = Just $ foldl' (\x y -> if x == "" then y else x <> ", " <> y) "" $ zipWith (\affialition structId -> affialition <> " | " <> structId) _document_authors_affiliations $ map show _document_struct_id
+                         , _hd_authors = Just $ nonemptyIntercalate ", " _document_authors_names
+                         , _hd_institutes = Just $ nonemptyIntercalate ", " $ zipWith (\affialition structId -> affialition <> " | " <> structId) _document_authors_affiliations $ map show _document_struct_id
                          , _hd_source = Just $ maybe "Nothing" identity _document_source
                          , _hd_abstract = Just abstract
                          , _hd_publication_date = fmap show utctime

src/Gargantext/Core/Text/Corpus/Parsers/JSON/Istex.hs

@@ -19,6 +19,7 @@ module Gargantext.Core.Text.Corpus.Parsers.JSON.Istex where
 import Data.Text qualified as T
 import Gargantext.Core (Lang(..))
 import Gargantext.Core.Text.Corpus.Parsers.Date qualified as Date
+import Gargantext.Core.Utils (nonemptyIntercalate)
 import Gargantext.Database.Admin.Types.Hyperdata.Document (HyperdataDocument(..))
 import Gargantext.Defaults qualified as Defaults
 import Gargantext.Prelude hiding (length)
@@ -38,9 +39,9 @@ toDoc la (ISTEX.Document i t a ab d s) = do
                            , _hd_url       = Nothing
                            , _hd_page      = Nothing
                            , _hd_title     = t
-                           , _hd_authors = Just $ foldl' (\x y -> if x == "" then y else x <> ", " <> y) "" (map ISTEX._author_name a)
-                           , _hd_institutes = Just $ foldl' (\x y -> if x == "" then y else x <> ", " <> y) "" (concatMap ISTEX._author_affiliations a)
-                           , _hd_source = Just $ foldl' (\x y -> if x == "" then y else x <> ", " <> y) "" (ISTEX._source_title s)
+                           , _hd_authors = Just $ nonemptyIntercalate ", " (map ISTEX._author_name a)
+                           , _hd_institutes = Just $ nonemptyIntercalate ", " (concatMap ISTEX._author_affiliations a)
+                           , _hd_source = Just $ nonemptyIntercalate ", " $ maybeToList $ join (ISTEX._source_title <$> s)
                            , _hd_abstract = ab
                            , _hd_publication_date = fmap (T.pack . show) utctime
                            , _hd_publication_year = pub_year

src/Gargantext/Core/Utils.hs

@@ -23,6 +23,7 @@ module Gargantext.Core.Utils (
                            , addTuples
                            , (?!)
                            , (?|)
+                           , nonemptyIntercalate
                           ) where
 
 import Data.List qualified as List
@@ -72,18 +73,24 @@ groupWithCounts = map f
     f [] = panicTrace "[groupWithCounts] impossible"
     f ts@(t:_) = (t, length ts)
 
+-- | Add numeric tuples, element-wise
 addTuples :: (Num a, Num b) => (a, b) -> (a, b) -> (a, b)
 addTuples (a1, b1) (a2, b2) = (a1 + a2, b1 + b2)
 
 
 infixr 4 ?!
 
--- Reverse infix form of "fromJust" with a custom error message
+-- | Reverse infix form of "fromJust" with a custom error message
 (?!) :: Maybe a -> Prelude.String -> a
 (?!) ma msg = ma ?| errorTrace msg
 
 infixr 4 ?|
 
--- Reverse infix form of "fromMaybe"
+-- | Reverse infix form of "fromMaybe"
 (?|) :: Maybe a -> a -> a
 (?|) = flip fromMaybe
+
+
+-- | Intercalate strings, but only nonempty ones
+nonemptyIntercalate :: Text -> [Text] -> Text
+nonemptyIntercalate sep xs = T.intercalate sep $ filter (/= "") xs

src/Gargantext/Core/Worker.hs

@@ -9,9 +9,10 @@ Portability : POSIX
 
 -}
 
+{-# OPTIONS_GHC -Wno-orphans      #-}  -- orphan HasNodeError IOException
+
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE UndecidableInstances #-}
-{-# OPTIONS_GHC -Wno-orphans      #-}  -- orphan HasNodeError IOException
 
 
 module Gargantext.Core.Worker where

stack.yaml

@@ -100,6 +100,7 @@
 - "servant-auth-client-0.4.2.0"
 - "servant-auth-server-0.4.9.0"
 - "servant-auth-swagger-0.2.11.0"
+- "servant-client-0.20.2"
 - "servant-client-core-0.20.2"
 - "servant-ekg-0.3.1"
 - "servant-server-0.20.2"
@@ -227,11 +228,11 @@
   git: "https://gitlab.iscpif.fr/gargantext/crawlers/arxiv-api.git"
   subdirs:
   - .
-- commit: cf4e5004f3b002bdef3fcab95e3559d65cdcd858
+- commit: 8c6286316ab7d461a4b01a2c315dde8519a4cc9f
   git: "https://gitlab.iscpif.fr/gargantext/crawlers/epo-proxy-api.git"
   subdirs:
   - .
-- commit: 229fdf40b8ccecd527fca5a7bbb554b0deb540dc
+- commit: 8bf9fc690e7ee3852465bacf8ebbd1aec8358387
   git: "https://gitlab.iscpif.fr/gargantext/crawlers/hal.git"
   subdirs:
   - .
@@ -239,15 +240,15 @@
   git: "https://gitlab.iscpif.fr/gargantext/crawlers/isidore.git"
   subdirs:
   - .
-- commit: c0a08d62c40a169b7934ceb7cb12c39952160e7a
+- commit: 521ca54f1502b13f629eff2223aaf5007e6d52ec
   git: "https://gitlab.iscpif.fr/gargantext/crawlers/istex.git"
   subdirs:
   - .
-- commit: 8249a40ff1ba885af45d3958f113af5b8a64c4ac
+- commit: a80e0ea57379d23f5e18a412606a71471b8ef681
   git: "https://gitlab.iscpif.fr/gargantext/crawlers/openalex.git"
   subdirs:
   - .
-- commit: 300764df4f78ea6175535f9b78b884cc2aa9da61
+- commit: 01292aae6e1008e7618b88cddcfdca3b04f0d92e
   git: "https://gitlab.iscpif.fr/gargantext/crawlers/pubmed.git"
   subdirs:
   - .

test/Test/API/Authentication.hs

+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
+
 {-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
-{-# OPTIONS_GHC -Wno-orphans #-}
 
 module Test.API.Authentication (
     tests

test/Test/API/Notifications.hs

@@ -28,7 +28,7 @@ import Gargantext.Core.Config (gc_notifications_config)
 import Gargantext.Core.Notifications.CentralExchange qualified as CE
 import Gargantext.Core.Notifications.CentralExchange.Types qualified as CET
 import Gargantext.Core.Notifications.Dispatcher.Types qualified as DT
-import Gargantext.System.Logging (logMsg, LogLevel(DEBUG), withLogger)
+import Gargantext.System.Logging (withLogger)
 import Network.WebSockets qualified as WS
 import Prelude
 import System.Timeout qualified as Timeout
@@ -55,7 +55,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
       wsTSem <- atomically $ newTSem 0
       tchan <- newTChanIO :: IO (TChan (Maybe DT.Notification))
       -- setup a websocket connection
-      let wsConnect conn = withLogger () $ \ioL -> do
+      let wsConnect conn = withLogger () $ \_ioL -> do
             -- logMsg ioL DEBUG $ "[wsConnect] subscribing topic: " <> show topic
             WS.sendTextData conn $ Aeson.encode (DT.WSSubscribe topic)
             -- inform the test process that we sent the subscription request
@@ -89,7 +89,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
       tchan <- newTChanIO :: IO (TChan (Maybe DT.Notification))
       
       -- setup a websocket connection
-      let wsConnect conn = withLogger () $ \ioL -> do
+      let wsConnect conn = withLogger () $ \_ioL -> do
             -- logMsg ioL DEBUG $ "[wsConnect] subscribing topic: " <> show topic
             WS.sendTextData conn $ Aeson.encode (DT.WSSubscribe topic)
             -- inform the test process that we sent the subscription request
@@ -107,9 +107,9 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
             atomically $ signalTSem wsTSem
             mTimeout <- Timeout.timeout (200_000) $ do
               -- NOTE This shouldn't happen now, we will test the tchan
-              d <- WS.receiveData conn
-              let dec = Aeson.decode d :: Maybe DT.Notification
-              atomically $ writeTChan tchan dec
+              d' <- WS.receiveData conn
+              let dec' = Aeson.decode d' :: Maybe DT.Notification
+              atomically $ writeTChan tchan dec'
             case mTimeout of
               -- It should have timed out
               Nothing -> atomically $ writeTChan tchan Nothing
@@ -140,7 +140,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
       wsTSem <- atomically $ newTSem 0  -- initially locked
       tchan <- newTChanIO :: IO (TChan (Maybe DT.Notification))
       -- setup a websocket connection
-      let wsConnect conn = withLogger () $ \ioL -> do
+      let wsConnect conn = withLogger () $ \_ioL -> do
             -- logMsg ioL DEBUG $ "[wsConnect] subscribing topic: " <> show topic
             WS.sendTextData conn $ Aeson.encode (DT.WSSubscribe topic)
             -- inform the test process that we sent the subscription request

test/Test/API/Private.hs

@@ -23,7 +23,7 @@ import Test.API.Private.Move  qualified as Move
 import Test.API.Private.Share qualified as Share
 import Test.API.Private.Table qualified as Table
 import Test.API.Routes (mkUrl, get_node, get_tree)
-import Test.API.Setup (createAliceAndBob, withTestDBAndPort, dbEnvSetup, SpecContext (..))
+import Test.API.Setup (withTestDBAndPort, dbEnvSetup, SpecContext (..))
 import Test.Hspec
 import Test.Hspec.Wai hiding (pendingWith)
 import Test.Hspec.Wai.Internal (withApplication)

test/Test/API/Setup.hs

@@ -182,7 +182,7 @@ dbEnvSetup :: SpecContext a -> IO (SpecContext a)
 dbEnvSetup ctx = do
   let testEnv = _sctx_env ctx
   setupEnvironment testEnv
-  createAliceAndBob testEnv
+  _ <- createAliceAndBob testEnv
 
   pure ctx
 

test/Test/API/UpdateList.hs

@@ -8,6 +8,8 @@ Stability   : experimental
 Portability : POSIX
 -}
 
+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
+
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
@@ -53,13 +55,9 @@ import Gargantext.Core.Text.Corpus.Query (RawQuery(..))
 import Gargantext.Core.Text.List.Social
 import Gargantext.Core.Text.Ngrams
 import Gargantext.Core.Types ( CorpusId, ListId, NodeId, _NodeId, TableResult(..))
-import Gargantext.Core.Types (TableResult(..))
 import Gargantext.Core.Types.Individu
 import Gargantext.Core.Types.Main (ListType(..))
 import Gargantext.Core.Worker.Types (JobInfo)
-import Gargantext.Database.Action.User
-import Gargantext.Database.Admin.Types.Hyperdata.Corpus
-import Gargantext.Database.Admin.Types.Hyperdata.Folder (defaultHyperdataFolderPrivate)
 import Gargantext.Database.Query.Facet qualified as Facet
 import Gargantext.Prelude hiding (get)
 import Network.Wai.Handler.Warp qualified as Wai
@@ -102,7 +100,7 @@ uploadJSONList port token cId pathToNgrams clientEnv = do
   -- j' <- pollUntilFinished token port mkPollUrl j
   ji <- checkEither $ liftIO $ runClientM (add_form_to_list token listId params) clientEnv
   -- liftIO (_jph_status j' `shouldBe` "IsFinished")
-  ji' <- pollUntilWorkFinished token port ji
+  ji' <- pollUntilWorkFinished port ji
   liftIO $ ji' `shouldBe` ji
   
   pure listId
@@ -222,7 +220,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ beforeAllWith dbEnvSetup $ do
                                       , _wtf_data = simpleNgrams
                                       , _wtf_name = "simple.tsv" }
             ji <- checkEither $ liftIO $ runClientM (add_tsv_to_list token listId params) clientEnv
-            ji' <- pollUntilWorkFinished token port ji
+            _ <- pollUntilWorkFinished port ji
 
             -- Now check that we can retrieve the ngrams
             liftIO $ do
@@ -346,7 +344,7 @@ createDocsList testDataPath testEnv port clientEnv token = do
   simpleDocs <- liftIO (TIO.readFile =<< getDataFileName testDataPath)
   let newWithForm = mkNewWithForm simpleDocs (T.pack $ takeBaseName testDataPath)
   ji <- checkEither $ liftIO $ runClientM (add_file_async token corpusId newWithForm) clientEnv
-  ji' <- pollUntilWorkFinished token port ji
+  ji' <- pollUntilWorkFinished port ji
   liftIO $ ji' `shouldBe` ji
   pure corpusId
 
@@ -358,7 +356,7 @@ updateNode :: Int -> ClientEnv -> Token -> NodeId -> WaiSession () ()
 updateNode port clientEnv token nodeId = do
   let params = UpdateNodeParamsTexts Both
   ji <- checkEither $ liftIO $ runClientM (update_node token nodeId params) clientEnv
-  ji' <- pollUntilWorkFinished token port ji
+  ji' <- pollUntilWorkFinished port ji
   liftIO $ ji' `shouldBe` ji
 
 mkNewWithForm :: T.Text -> T.Text -> NewWithForm

test/Test/Core/Text/Corpus/TSV.hs

@@ -14,7 +14,6 @@ import Data.Text.Encoding as DT
 import Prelude
 
 import Test.Tasty
-import Test.Tasty.HUnit
 import Test.Tasty.QuickCheck hiding (Positive, Negative)
 
 tests :: TestTree
@@ -246,4 +245,4 @@ testGetHeader = forAll randomHeaderList (\headers -> do
                 | not ("Title" `Prelude.elem` headers)              -> True
                 | not ("Abstract" `Prelude.elem` headers)           -> True
                 | otherwise                                         -> False
-    )
\ No newline at end of file
+    )

test/Test/Core/Utils.hs

@@ -19,8 +19,20 @@ import Test.Hspec
 test :: Spec
 test = do
   describe "check if groupWithCounts works" $ do
-    it "simple integer array" $ do
-      (groupWithCounts [1, 2, 3, 1, 2, 3]) `shouldBe` [(1, 2), (2, 2), (3, 2)]
-
-    it "string" $ do
-      (groupWithCounts "abccba") `shouldBe` [('a', 2), ('b', 2), ('c', 2)]
+    it "simple integer array" $ groupWithCounts testArray  `shouldBe` groupedArray
+    it "string"               $ groupWithCounts testString `shouldBe` groupedString
+  describe "check nonemptyIntercalate" $ do
+    it "empty list" $ nonemptyIntercalate "," [] `shouldBe` ""
+    it "simple list" $ nonemptyIntercalate "," ["x"] `shouldBe` "x"
+    it "two-element list" $ nonemptyIntercalate "," ["x", "y"] `shouldBe` "x,y"
+    it "with empty strings" $ nonemptyIntercalate "," ["a", "", "b", "", "c", ""] `shouldBe` "a,b,c"
+  where
+    testArray :: [Int]
+    testArray = [1, 2, 3, 1, 2, 3]
+    groupedArray :: [(Int, Int)]
+    groupedArray = [(1, 2), (2, 2), (3, 2)]
+    testString :: [Char]
+    testString = "abccba"
+    groupedString :: [(Char, Int)]
+    groupedString = [('a', 2), ('b', 2), ('c', 2)]
+    

test/Test/Core/Worker.hs

@@ -12,13 +12,10 @@ Portability : POSIX
 module Test.Core.Worker where
 
 import Data.Aeson qualified as Aeson
-import Gargantext.Core.Methods.Similarities.Conditional
 import Gargantext.Core.Worker.Jobs.Types (Job(..))
-import Gargantext.Core.Worker.Types (JobInfo(..))
 import Gargantext.Prelude
 import Test.Instances ()
 import Test.Tasty
-import Test.Tasty.HUnit
 import Test.Tasty.QuickCheck hiding (Positive, Negative)
 
 

test/Test/Database/Operations/NodeStory.hs

@@ -8,6 +8,7 @@ Stability   : experimental
 Portability : POSIX
 -}
 
+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
 {-# LANGUAGE QuasiQuotes       #-}
 
 module Test.Database.Operations.NodeStory where

test/Test/Database/Setup.hs

@@ -28,7 +28,7 @@ import Gargantext.Core.NodeStory (fromDBNodeStoryEnv)
 import Gargantext.Core.Worker (initWorkerState)
 import Gargantext.Core.Worker.Env (WorkerEnv(..))
 import Gargantext.Prelude
-import Gargantext.System.Logging (withLogger, withLoggerHoisted, logMsg, LogLevel(..))
+import Gargantext.System.Logging (withLoggerHoisted)
 import Paths_gargantext
 import Prelude qualified
 import Shelly hiding (FilePath, run)
@@ -100,8 +100,6 @@ setup = do
       test_nodeStory <- fromDBNodeStoryEnv pool
       withLoggerHoisted Mock $ \logger -> do
   
-        let idleTime = 60.0
-        let maxResources = 2
         let wPoolConfig = defaultPoolConfig (PG.connectPostgreSQL (Tmp.toConnectionString db))
                                             PG.close
                                             idleTime

test/Test/Database/Types.hs

@@ -23,7 +23,6 @@ import Data.IORef
 import Data.Map qualified as Map
 import Data.Pool
 import Data.Text qualified as T
-import Data.Time.Clock (getCurrentTime)
 import Database.PostgreSQL.Simple qualified as PG
 import Database.Postgres.Temp qualified as Tmp
 import Gargantext hiding (to)
@@ -36,8 +35,6 @@ import Gargantext.Core.Config.Mail (MailConfig(..), LoginType(NoAuth), SendEmail
 import Gargantext.Core.Mail.Types (HasMail(..))
 import Gargantext.Core.NLP (HasNLPServer(..))
 import Gargantext.Core.NodeStory
-import Gargantext.Database.Prelude (HasConnectionPool(..))
-import Gargantext.Prelude hiding (to)
 import Gargantext.System.Logging (HasLogger(..), Logger, MonadLogger(..))
 import Gargantext.Utils.Jobs.Monad (MonadJobStatus(..))
 import Network.URI (parseURI)
@@ -147,7 +144,6 @@ instance HasLogger (GargM TestEnv BackendInternalError) where
     pure $ GargTestLogger mode test_logger_set
   destroyLogger GargTestLogger{..} = liftIO $ FL.rmLoggerSet test_logger_set
   logMsg (GargTestLogger mode logger_set) lvl msg = do
-    t <- liftIO $ getCurrentTime
     let pfx = "[" <> show lvl <> "] " :: Text
     when (lvl `elem` (modeToLoggingLevels mode)) $
       liftIO $ FL.pushLogStrLn logger_set $ FL.toLogStr pfx <> msg

test/Test/Instances.hs

@@ -8,7 +8,7 @@ Stability   : experimental
 Portability : POSIX
 -}
 
-{-# OPTIONS_GHC -Wno-orphans #-}
+{-# OPTIONS_GHC -Wno-orphans -Wno-missing-methods #-}
 {-# OPTIONS_GHC -fconstraint-solver-iterations=10 #-}
 
 {-# LANGUAGE StandaloneDeriving #-}

test/Test/Ngrams/Lang/Occurrences.hs

@@ -15,9 +15,8 @@ commentary with @some markup@.
 
 module Test.Ngrams.Lang.Occurrences where
 import Test.Hspec
-import Data.Either
 import Gargantext.Core.Text.Terms.WithList
-import Gargantext.Core (Lang(ZH, EN))
+import Gargantext.Core (Lang(EN))
 import Gargantext.Prelude
 
 test :: Spec
@@ -26,7 +25,7 @@ test = do
             it "words with quotes should match" $ do
                 let ngrams = ["j'aime"]
                 let doc = "j'aime"
-                let output = []
+                -- let output = []
                     
                 termsInText EN (buildPatternsWith EN ngrams) doc `shouldBe` [("j'aime", 1)] 
                 

test/Test/Parsers/Types.hs

@@ -17,15 +17,12 @@ commentary with @some markup@.
 
 module Test.Parsers.Types where
 
+import Data.Time.LocalTime (ZonedTime (..), TimeZone (..), TimeOfDay(..), LocalTime(..))
 import Gargantext.Prelude
-
 import Test.Instances ()
-import Test.QuickCheck
 import Test.QuickCheck.Instances ()
+import Text.Parsec.Error (ParseError)
 
-import Text.Parsec.Pos
-import Text.Parsec.Error (ParseError, Message(..), newErrorMessage)
-import Data.Time.LocalTime (ZonedTime (..), TimeZone (..), TimeOfDay(..), LocalTime(..))
 
 deriving instance Eq ZonedTime
 

test/Test/Utils.hs

+{-# OPTIONS_GHC -Wno-deprecations #-}
+
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications    #-}
 
@@ -42,7 +44,6 @@ import Data.Text.Encoding qualified as TE
 import Data.Text.Lazy qualified as TL
 import Data.Text.Lazy.Encoding qualified as TLE
 import Data.TreeDiff
-import Fmt (Builder)
 import Gargantext.API.Admin.Auth.Types (AuthRequest(..), Token, authRes_token)
 import Gargantext.API.Admin.Orchestrator.Types
 import Gargantext.API.Routes.Types (xGargErrorScheme)
@@ -64,13 +65,12 @@ import Servant.Client.Core (BaseUrl)
 import Servant.Client.Core.Request qualified as Client
 import System.Environment (lookupEnv)
 import System.Timeout qualified as Timeout
-import Test.API.Routes (auth_api, mkUrl)
+import Test.API.Routes (auth_api)
 import Test.Hspec.Expectations
 import Test.Hspec.Wai (MatchBody(..), WaiExpectation, WaiSession, request)
 import Test.Hspec.Wai.JSON (FromValue(..))
 import Test.Hspec.Wai.Matcher (MatchHeader(..), ResponseMatcher(..), bodyEquals, formatHeader, match)
 import Test.Tasty.HUnit (Assertion, assertBool)
-import Test.Types
 import Test.Utils.Notifications (withWSConnection, millisecond)
 
 
@@ -226,21 +226,21 @@ withValidLogin port ur pwd act = do
 -- client is actually sending to the server.
 -- FIXME(adn) We cannot upgrade to servant-client 0.20 due to OpenAlex:
 -- https://gitlab.iscpif.fr/gargantext/crawlers/openalex/blob/main/src/OpenAlex/ServantClientLogging.hs#L24
-gargMkRequest :: Bool -> BaseUrl -> Client.Request -> HTTP.Request
-gargMkRequest traceEnabled bu clientRq =
-  let httpReq = defaultMakeClientRequest bu clientRq
-  in case traceEnabled of
+gargMkRequest :: Bool -> BaseUrl -> Client.Request -> IO HTTP.Request
+gargMkRequest traceEnabled bu clientRq = do
+  httpReq <- defaultMakeClientRequest bu clientRq
+  pure $
+    case traceEnabled of
        True ->
          traceShowId httpReq
        False -> httpReq
 
 
 pollUntilWorkFinished :: HasCallStack
-                      => Token
-                      -> Port
+                      => Port
                       -> JobInfo
                       -> WaiSession () JobInfo
-pollUntilWorkFinished tkn port ji = do
+pollUntilWorkFinished port ji = do
   let waitSecs = 60
   isFinishedTVar <- liftIO $ newTVarIO False
   let wsConnect =
@@ -267,11 +267,11 @@ pollUntilWorkFinished tkn port ji = do
                   pure ()
               _ -> pure ()
  
-  liftIO $ withAsync wsConnect $ \a -> do
+  liftIO $ withAsync wsConnect $ \_ -> do
     mRet <- Timeout.timeout (waitSecs * 1000 * millisecond) $ do
       let go = do
-            isFinished <- readTVarIO isFinishedTVar
-            if isFinished
+            finished <- readTVarIO isFinishedTVar
+            if finished
               then do
                 withLogger () $ \ioL ->
                   logMsg ioL DEBUG $ "[pollUntilWorkFinished] JOB FINISHED: " <> show ji

test/Test/Utils/Jobs.hs

@@ -14,40 +14,9 @@ Portability : POSIX
 
 module Test.Utils.Jobs ( test ) where
 
-import Async.Worker.Types qualified as WT
-import Control.Concurrent
-import Control.Concurrent.Async
-import Control.Concurrent.Async qualified as Async
-import Control.Concurrent.STM
-import Data.Aeson qualified as Aeson
-import Data.Sequence ((|>), fromList)
-import Data.Time
-import Debug.RecoverRTTI (anythingToString)
-import Gargantext.API.Admin.EnvTypes as EnvTypes
-import Gargantext.API.Admin.Orchestrator.Types
-import Gargantext.API.Errors.Types
-import Gargantext.API.Prelude
-import Gargantext.Core.Config (GargConfig(..))
-import Gargantext.Core.Config.Types (NotificationsConfig(..))
-import Gargantext.Core.Worker.Jobs.Types (Job(..))
-import Gargantext.Core.Worker.PGMQTypes (HasWorkerBroker, BrokerMessage, WState)
 import Gargantext.Prelude
-import Gargantext.Utils.Jobs.Error
-import Gargantext.Utils.Jobs.Monad hiding (withJob)
-import Network.HTTP.Client (Manager)
-import Network.HTTP.Client.TLS (newTlsManager)
-import Prelude qualified
-import System.IO.Unsafe
-import System.Timeout (timeout)
 import Test.Hspec
-import Test.Hspec.Expectations.Contrib (annotate)
 import Test.Instances ()  -- arbitrary instances
-import Test.Tasty (TestTree, testGroup)
-import Test.Tasty.QuickCheck hiding (Positive, Negative)
-import Test.Utils (waitUntil)
-import Test.Utils.Jobs.Types
-
-
 
 
 -- | TODO This suite did test some old-style worker internals. We
@@ -89,38 +58,38 @@ data JobT = A
 -- | This type models the schedule picked up by the orchestrator.
 newtype JobSchedule = JobSchedule { _JobSchedule :: Seq JobT } deriving (Eq, Show)
 
-addJobToSchedule :: JobT -> MVar JobSchedule -> IO ()
-addJobToSchedule jobt mvar = do
-  modifyMVar_ mvar $ \js -> do
-    let js' = js { _JobSchedule = _JobSchedule js |> jobt }
-    pure js'
+-- addJobToSchedule :: JobT -> MVar JobSchedule -> IO ()
+-- addJobToSchedule jobt mvar = do
+--   modifyMVar_ mvar $ \js -> do
+--     let js' = js { _JobSchedule = _JobSchedule js |> jobt }
+--     pure js'
 
 data Counts = Counts { countAs :: Int, countBs :: Int }
   deriving (Eq, Show)
 
 -- | In ms
-jobDuration :: Int
-jobDuration = 100
-
-type Timer = TVar Bool
-
--- | Use in conjuction with 'registerDelay' to create an 'STM' transaction
--- that will simulate the duration of a job by waiting the timeout registered
--- by 'registerDelay' before continuing.
-waitTimerSTM :: Timer -> STM ()
-waitTimerSTM tv = do
-  v <- readTVar tv
-  check v
-
--- | Samples the running jobs from the first 'TVar' and write them
--- in the queue.
-sampleRunningJobs :: Timer -> TVar [Prelude.String] -> TQueue [Prelude.String]-> STM ()
-sampleRunningJobs timer runningJs samples = do
-  waitTimerSTM timer
-  runningNow <- readTVar runningJs
-  case runningNow of
-    [] -> pure () -- ignore empty runs, when the system is kickstarting.
-    xs -> writeTQueue samples xs
+-- jobDuration :: Int
+-- jobDuration = 100
+
+-- type Timer = TVar Bool
+
+-- -- | Use in conjuction with 'registerDelay' to create an 'STM' transaction
+-- -- that will simulate the duration of a job by waiting the timeout registered
+-- -- by 'registerDelay' before continuing.
+-- waitTimerSTM :: Timer -> STM ()
+-- waitTimerSTM tv = do
+--   v <- readTVar tv
+--   check v
+
+-- -- | Samples the running jobs from the first 'TVar' and write them
+-- -- in the queue.
+-- sampleRunningJobs :: Timer -> TVar [Prelude.String] -> TQueue [Prelude.String]-> STM ()
+-- sampleRunningJobs timer runningJs samples = do
+--   waitTimerSTM timer
+--   runningNow <- readTVar runningJs
+--   case runningNow of
+--     [] -> pure () -- ignore empty runs, when the system is kickstarting.
+--     xs -> writeTQueue samples xs
 
 -- testPrios :: IO ()
 -- testPrios = do
@@ -195,9 +164,9 @@ sampleRunningJobs timer runningJs samples = do
 --     finalSchedule <- readMVar pickedSchedule
 --     pure $ finalSchedule == JobSchedule (fromList [A, A, B, A, A])) jobDuration
 
-testTlsManager :: Manager
-testTlsManager = unsafePerformIO newTlsManager
-{-# NOINLINE testTlsManager #-}
+-- testTlsManager :: Manager
+-- testTlsManager = unsafePerformIO newTlsManager
+-- {-# NOINLINE testTlsManager #-}
 
 
 -- withJob :: Env