Commit 1e10b29f authored by Grégoire Locqueville's avatar Grégoire Locqueville

Removed a bunch of build warnings

I fixed those warnings that were easy to fix: redundant imports, unused
variables, etc. (I might have missed some though)

The warnings I deliberately left for now are:
* In `Test.API.UpdateList`: Incomplete pattern matching (we would need
  to think a bit about error handling to fix this)
* In `Test.Utils`: `traceShowId` remains in code (we would need to think
  a bit about proper logging to fix this)
parent 9a8cff4c
Pipeline #7095 passed with stages
in 62 minutes and 35 seconds
...@@ -23,7 +23,7 @@ import Test.API.Private.Move qualified as Move ...@@ -23,7 +23,7 @@ import Test.API.Private.Move qualified as Move
import Test.API.Private.Share qualified as Share import Test.API.Private.Share qualified as Share
import Test.API.Private.Table qualified as Table import Test.API.Private.Table qualified as Table
import Test.API.Routes (mkUrl, get_node, get_tree) 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
import Test.Hspec.Wai hiding (pendingWith) import Test.Hspec.Wai hiding (pendingWith)
import Test.Hspec.Wai.Internal (withApplication) import Test.Hspec.Wai.Internal (withApplication)
......
...@@ -182,7 +182,7 @@ dbEnvSetup :: SpecContext a -> IO (SpecContext a) ...@@ -182,7 +182,7 @@ dbEnvSetup :: SpecContext a -> IO (SpecContext a)
dbEnvSetup ctx = do dbEnvSetup ctx = do
let testEnv = _sctx_env ctx let testEnv = _sctx_env ctx
setupEnvironment testEnv setupEnvironment testEnv
createAliceAndBob testEnv _ <- createAliceAndBob testEnv
pure ctx pure ctx
......
...@@ -53,13 +53,9 @@ import Gargantext.Core.Text.Corpus.Query (RawQuery(..)) ...@@ -53,13 +53,9 @@ import Gargantext.Core.Text.Corpus.Query (RawQuery(..))
import Gargantext.Core.Text.List.Social import Gargantext.Core.Text.List.Social
import Gargantext.Core.Text.Ngrams import Gargantext.Core.Text.Ngrams
import Gargantext.Core.Types ( CorpusId, ListId, NodeId, _NodeId, TableResult(..)) import Gargantext.Core.Types ( CorpusId, ListId, NodeId, _NodeId, TableResult(..))
import Gargantext.Core.Types (TableResult(..))
import Gargantext.Core.Types.Individu import Gargantext.Core.Types.Individu
import Gargantext.Core.Types.Main (ListType(..)) import Gargantext.Core.Types.Main (ListType(..))
import Gargantext.Core.Worker.Types (JobInfo) 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.Database.Query.Facet qualified as Facet
import Gargantext.Prelude hiding (get) import Gargantext.Prelude hiding (get)
import Network.Wai.Handler.Warp qualified as Wai import Network.Wai.Handler.Warp qualified as Wai
...@@ -102,7 +98,7 @@ uploadJSONList port token cId pathToNgrams clientEnv = do ...@@ -102,7 +98,7 @@ uploadJSONList port token cId pathToNgrams clientEnv = do
-- j' <- pollUntilFinished token port mkPollUrl j -- j' <- pollUntilFinished token port mkPollUrl j
ji <- checkEither $ liftIO $ runClientM (add_form_to_list token listId params) clientEnv ji <- checkEither $ liftIO $ runClientM (add_form_to_list token listId params) clientEnv
-- liftIO (_jph_status j' `shouldBe` "IsFinished") -- liftIO (_jph_status j' `shouldBe` "IsFinished")
ji' <- pollUntilWorkFinished token port ji ji' <- pollUntilWorkFinished port ji
liftIO $ ji' `shouldBe` ji liftIO $ ji' `shouldBe` ji
pure listId pure listId
...@@ -222,7 +218,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ beforeAllWith dbEnvSetup $ do ...@@ -222,7 +218,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ beforeAllWith dbEnvSetup $ do
, _wtf_data = simpleNgrams , _wtf_data = simpleNgrams
, _wtf_name = "simple.tsv" } , _wtf_name = "simple.tsv" }
ji <- checkEither $ liftIO $ runClientM (add_tsv_to_list token listId params) clientEnv 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 -- Now check that we can retrieve the ngrams
liftIO $ do liftIO $ do
...@@ -346,7 +342,7 @@ createDocsList testDataPath testEnv port clientEnv token = do ...@@ -346,7 +342,7 @@ createDocsList testDataPath testEnv port clientEnv token = do
simpleDocs <- liftIO (TIO.readFile =<< getDataFileName testDataPath) simpleDocs <- liftIO (TIO.readFile =<< getDataFileName testDataPath)
let newWithForm = mkNewWithForm simpleDocs (T.pack $ takeBaseName testDataPath) let newWithForm = mkNewWithForm simpleDocs (T.pack $ takeBaseName testDataPath)
ji <- checkEither $ liftIO $ runClientM (add_file_async token corpusId newWithForm) clientEnv ji <- checkEither $ liftIO $ runClientM (add_file_async token corpusId newWithForm) clientEnv
ji' <- pollUntilWorkFinished token port ji ji' <- pollUntilWorkFinished port ji
liftIO $ ji' `shouldBe` ji liftIO $ ji' `shouldBe` ji
pure corpusId pure corpusId
...@@ -358,7 +354,7 @@ updateNode :: Int -> ClientEnv -> Token -> NodeId -> WaiSession () () ...@@ -358,7 +354,7 @@ updateNode :: Int -> ClientEnv -> Token -> NodeId -> WaiSession () ()
updateNode port clientEnv token nodeId = do updateNode port clientEnv token nodeId = do
let params = UpdateNodeParamsTexts Both let params = UpdateNodeParamsTexts Both
ji <- checkEither $ liftIO $ runClientM (update_node token nodeId params) clientEnv ji <- checkEither $ liftIO $ runClientM (update_node token nodeId params) clientEnv
ji' <- pollUntilWorkFinished token port ji ji' <- pollUntilWorkFinished port ji
liftIO $ ji' `shouldBe` ji liftIO $ ji' `shouldBe` ji
mkNewWithForm :: T.Text -> T.Text -> NewWithForm mkNewWithForm :: T.Text -> T.Text -> NewWithForm
......
...@@ -14,7 +14,6 @@ import Data.Text.Encoding as DT ...@@ -14,7 +14,6 @@ import Data.Text.Encoding as DT
import Prelude import Prelude
import Test.Tasty import Test.Tasty
import Test.Tasty.HUnit
import Test.Tasty.QuickCheck hiding (Positive, Negative) import Test.Tasty.QuickCheck hiding (Positive, Negative)
tests :: TestTree tests :: TestTree
...@@ -246,4 +245,4 @@ testGetHeader = forAll randomHeaderList (\headers -> do ...@@ -246,4 +245,4 @@ testGetHeader = forAll randomHeaderList (\headers -> do
| not ("Title" `Prelude.elem` headers) -> True | not ("Title" `Prelude.elem` headers) -> True
| not ("Abstract" `Prelude.elem` headers) -> True | not ("Abstract" `Prelude.elem` headers) -> True
| otherwise -> False | otherwise -> False
) )
\ No newline at end of file
...@@ -19,8 +19,15 @@ import Test.Hspec ...@@ -19,8 +19,15 @@ import Test.Hspec
test :: Spec test :: Spec
test = do test = do
describe "check if groupWithCounts works" $ do describe "check if groupWithCounts works" $ do
it "simple integer array" $ do it "simple integer array" $ groupWithCounts testArray `shouldBe` groupedArray
(groupWithCounts [1, 2, 3, 1, 2, 3]) `shouldBe` [(1, 2), (2, 2), (3, 2)] it "string" $ groupWithCounts testString `shouldBe` groupedString
where
it "string" $ do testArray :: [Int]
(groupWithCounts "abccba") `shouldBe` [('a', 2), ('b', 2), ('c', 2)] 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)]
...@@ -28,7 +28,7 @@ import Gargantext.Core.NodeStory (fromDBNodeStoryEnv) ...@@ -28,7 +28,7 @@ import Gargantext.Core.NodeStory (fromDBNodeStoryEnv)
import Gargantext.Core.Worker (initWorkerState) import Gargantext.Core.Worker (initWorkerState)
import Gargantext.Core.Worker.Env (WorkerEnv(..)) import Gargantext.Core.Worker.Env (WorkerEnv(..))
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.System.Logging (withLogger, withLoggerHoisted, logMsg, LogLevel(..)) import Gargantext.System.Logging (withLoggerHoisted)
import Paths_gargantext import Paths_gargantext
import Prelude qualified import Prelude qualified
import Shelly hiding (FilePath, run) import Shelly hiding (FilePath, run)
...@@ -100,8 +100,6 @@ setup = do ...@@ -100,8 +100,6 @@ setup = do
test_nodeStory <- fromDBNodeStoryEnv pool test_nodeStory <- fromDBNodeStoryEnv pool
withLoggerHoisted Mock $ \logger -> do withLoggerHoisted Mock $ \logger -> do
let idleTime = 60.0
let maxResources = 2
let wPoolConfig = defaultPoolConfig (PG.connectPostgreSQL (Tmp.toConnectionString db)) let wPoolConfig = defaultPoolConfig (PG.connectPostgreSQL (Tmp.toConnectionString db))
PG.close PG.close
idleTime idleTime
......
...@@ -23,7 +23,6 @@ import Data.IORef ...@@ -23,7 +23,6 @@ import Data.IORef
import Data.Map qualified as Map import Data.Map qualified as Map
import Data.Pool import Data.Pool
import Data.Text qualified as T import Data.Text qualified as T
import Data.Time.Clock (getCurrentTime)
import Database.PostgreSQL.Simple qualified as PG import Database.PostgreSQL.Simple qualified as PG
import Database.Postgres.Temp qualified as Tmp import Database.Postgres.Temp qualified as Tmp
import Gargantext hiding (to) import Gargantext hiding (to)
...@@ -36,8 +35,6 @@ import Gargantext.Core.Config.Mail (MailConfig(..), LoginType(NoAuth), SendEmail ...@@ -36,8 +35,6 @@ import Gargantext.Core.Config.Mail (MailConfig(..), LoginType(NoAuth), SendEmail
import Gargantext.Core.Mail.Types (HasMail(..)) import Gargantext.Core.Mail.Types (HasMail(..))
import Gargantext.Core.NLP (HasNLPServer(..)) import Gargantext.Core.NLP (HasNLPServer(..))
import Gargantext.Core.NodeStory import Gargantext.Core.NodeStory
import Gargantext.Database.Prelude (HasConnectionPool(..))
import Gargantext.Prelude hiding (to)
import Gargantext.System.Logging (HasLogger(..), Logger, MonadLogger(..)) import Gargantext.System.Logging (HasLogger(..), Logger, MonadLogger(..))
import Gargantext.Utils.Jobs.Monad (MonadJobStatus(..)) import Gargantext.Utils.Jobs.Monad (MonadJobStatus(..))
import Network.URI (parseURI) import Network.URI (parseURI)
...@@ -147,7 +144,6 @@ instance HasLogger (GargM TestEnv BackendInternalError) where ...@@ -147,7 +144,6 @@ instance HasLogger (GargM TestEnv BackendInternalError) where
pure $ GargTestLogger mode test_logger_set pure $ GargTestLogger mode test_logger_set
destroyLogger GargTestLogger{..} = liftIO $ FL.rmLoggerSet test_logger_set destroyLogger GargTestLogger{..} = liftIO $ FL.rmLoggerSet test_logger_set
logMsg (GargTestLogger mode logger_set) lvl msg = do logMsg (GargTestLogger mode logger_set) lvl msg = do
t <- liftIO $ getCurrentTime
let pfx = "[" <> show lvl <> "] " :: Text let pfx = "[" <> show lvl <> "] " :: Text
when (lvl `elem` (modeToLoggingLevels mode)) $ when (lvl `elem` (modeToLoggingLevels mode)) $
liftIO $ FL.pushLogStrLn logger_set $ FL.toLogStr pfx <> msg liftIO $ FL.pushLogStrLn logger_set $ FL.toLogStr pfx <> msg
......
...@@ -42,7 +42,6 @@ import Data.Text.Encoding qualified as TE ...@@ -42,7 +42,6 @@ import Data.Text.Encoding qualified as TE
import Data.Text.Lazy qualified as TL import Data.Text.Lazy qualified as TL
import Data.Text.Lazy.Encoding qualified as TLE import Data.Text.Lazy.Encoding qualified as TLE
import Data.TreeDiff import Data.TreeDiff
import Fmt (Builder)
import Gargantext.API.Admin.Auth.Types (AuthRequest(..), Token, authRes_token) import Gargantext.API.Admin.Auth.Types (AuthRequest(..), Token, authRes_token)
import Gargantext.API.Admin.Orchestrator.Types import Gargantext.API.Admin.Orchestrator.Types
import Gargantext.API.Routes.Types (xGargErrorScheme) import Gargantext.API.Routes.Types (xGargErrorScheme)
...@@ -64,13 +63,12 @@ import Servant.Client.Core (BaseUrl) ...@@ -64,13 +63,12 @@ import Servant.Client.Core (BaseUrl)
import Servant.Client.Core.Request qualified as Client import Servant.Client.Core.Request qualified as Client
import System.Environment (lookupEnv) import System.Environment (lookupEnv)
import System.Timeout qualified as Timeout 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.Expectations
import Test.Hspec.Wai (MatchBody(..), WaiExpectation, WaiSession, request) import Test.Hspec.Wai (MatchBody(..), WaiExpectation, WaiSession, request)
import Test.Hspec.Wai.JSON (FromValue(..)) import Test.Hspec.Wai.JSON (FromValue(..))
import Test.Hspec.Wai.Matcher (MatchHeader(..), ResponseMatcher(..), bodyEquals, formatHeader, match) import Test.Hspec.Wai.Matcher (MatchHeader(..), ResponseMatcher(..), bodyEquals, formatHeader, match)
import Test.Tasty.HUnit (Assertion, assertBool) import Test.Tasty.HUnit (Assertion, assertBool)
import Test.Types
import Test.Utils.Notifications (withWSConnection, millisecond) import Test.Utils.Notifications (withWSConnection, millisecond)
...@@ -236,11 +234,10 @@ gargMkRequest traceEnabled bu clientRq = ...@@ -236,11 +234,10 @@ gargMkRequest traceEnabled bu clientRq =
pollUntilWorkFinished :: HasCallStack pollUntilWorkFinished :: HasCallStack
=> Token => Port
-> Port
-> JobInfo -> JobInfo
-> WaiSession () JobInfo -> WaiSession () JobInfo
pollUntilWorkFinished tkn port ji = do pollUntilWorkFinished port ji = do
let waitSecs = 60 let waitSecs = 60
isFinishedTVar <- liftIO $ newTVarIO False isFinishedTVar <- liftIO $ newTVarIO False
let wsConnect = let wsConnect =
...@@ -267,11 +264,11 @@ pollUntilWorkFinished tkn port ji = do ...@@ -267,11 +264,11 @@ pollUntilWorkFinished tkn port ji = do
pure () pure ()
_ -> pure () _ -> pure ()
liftIO $ withAsync wsConnect $ \a -> do liftIO $ withAsync wsConnect $ \_ -> do
mRet <- Timeout.timeout (waitSecs * 1000 * millisecond) $ do mRet <- Timeout.timeout (waitSecs * 1000 * millisecond) $ do
let go = do let go = do
isFinished <- readTVarIO isFinishedTVar finished <- readTVarIO isFinishedTVar
if isFinished if finished
then do then do
withLogger () $ \ioL -> withLogger () $ \ioL ->
logMsg ioL DEBUG $ "[pollUntilWorkFinished] JOB FINISHED: " <> show ji logMsg ioL DEBUG $ "[pollUntilWorkFinished] JOB FINISHED: " <> show ji
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment