[refactor] upgrade deps (servant-client 0.20)

Also, add -Werror to tests so that no warnings in tests are reported anymore.

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

@@ -584,7 +584,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
@@ -754,7 +754,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
@@ -844,7 +844,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:
@@ -882,7 +882,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 (nonemptyJoin)
 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 $ nonemptyJoin ", " _document_authors_names
+                         , _hd_institutes = Just $ nonemptyJoin ", " $ 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 (nonemptyJoin)
 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 $ nonemptyJoin ", " (map ISTEX._author_name a)
+                           , _hd_institutes = Just $ nonemptyJoin ", " (concatMap ISTEX._author_affiliations a)
+                           , _hd_source = Just $ nonemptyJoin ", " $ 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
                            , (?!)
                            , (?|)
+                           , nonemptyJoin
                           ) where
 
 import Data.List qualified as List
@@ -72,18 +73,27 @@ 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
+
+
+-- | Join strings, but only nonempty ones
+nonemptyJoin :: Text -> [Text] -> Text
+nonemptyJoin _sep [] = ""
+nonemptyJoin _sep [x] = x
+nonemptyJoin sep ("":xs) = nonemptyJoin sep xs
+nonemptyJoin sep (x:xs) = x <> sep <> (nonemptyJoin sep 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

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/UpdateList.hs

@@ -8,6 +8,8 @@ Stability   : experimental
 Portability : POSIX
 -}
 
+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
+
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}

test/Test/Core/Utils.hs

@@ -21,6 +21,11 @@ test = do
   describe "check if groupWithCounts works" $ do
     it "simple integer array" $ groupWithCounts testArray  `shouldBe` groupedArray
     it "string"               $ groupWithCounts testString `shouldBe` groupedString
+  describe "check nonemptyJoin" $ do
+    it "empty list" $ nonemptyJoin "," [] `shouldBe` ""
+    it "simple list" $ nonemptyJoin "," ["x"] `shouldBe` "x"
+    it "two-element list" $ nonemptyJoin "," ["x", "y"] `shouldBe` "x,y"
+    it "with empty strings" $ nonemptyJoin "," ["a", "", "b", "", "c", ""] `shouldBe` "a,b,c"
   where
     testArray :: [Int]
     testArray = [1, 2, 3, 1, 2, 3]

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/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    #-}
 
@@ -224,10 +226,11 @@ 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

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