Add Phylo test scaffolding

It also improves the error in case it's the first time we are running
the tests and we have no coreNLP service running.

gargantext.cabal

@@ -1048,6 +1048,7 @@ test-suite garg-test-hspec
       Test.API.Authentication
       Test.API.Errors
       Test.API.GraphQL
+      Test.API.Phylo
       Test.API.Private
       Test.API.Setup
       Test.API.UpdateList

test/Test/API.hs

@@ -8,6 +8,7 @@ import qualified Test.API.Errors as Errors
 import qualified Test.API.GraphQL as GraphQL
 import qualified Test.API.Private as Private
 import qualified Test.API.UpdateList as UpdateList
+import qualified Test.API.Phylo as Phylo
 
 tests :: Spec
 tests = describe "API" $ do
@@ -16,3 +17,4 @@ tests = describe "API" $ do
   GraphQL.tests
   Errors.tests
   UpdateList.tests
+  Phylo.tests

test/Test/API/Phylo.hs

+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE NumericUnderscores #-}
+{-# LANGUAGE ViewPatterns #-}
+
+module Test.API.Phylo (
+    tests
+  ) where
+
+import Data.Aeson.QQ
+import Data.String (fromString)
+import Data.Text qualified as T
+import Data.Text.IO qualified as TIO
+import Fmt
+import Gargantext.API.Ngrams.List ( ngramsListFromCSVData )
+import Gargantext.API.Ngrams.Types
+import Gargantext.Core.Types
+import Gargantext.Core.Types.Individu
+import Gargantext.Database.Schema.Ngrams
+import Gargantext.Prelude hiding (get)
+import Paths_gargantext (getDataFileName)
+import Test.API.Private (withValidLogin, protectedJSON, postJSONUrlEncoded, getJSON)
+import Test.API.Setup (withTestDBAndPort, setupEnvironment, mkUrl, createAliceAndBob)
+import Test.API.UpdateList (JobPollHandle(..), pollUntilFinished, newCorpusForUser)
+import Test.Hspec
+import Test.Hspec.Wai.Internal (withApplication)
+import Test.Hspec.Wai.JSON (json)
+import Test.Hspec.Wai (shouldRespondWith)
+import Web.FormUrlEncoded
+import qualified Data.Map.Strict as Map
+
+tests :: Spec
+tests = sequential $ aroundAll withTestDBAndPort $ do
+  describe "UpdateList API" $ do
+    it "setup DB triggers and users" $ \((testEnv, _), _) -> do
+      setupEnvironment testEnv
+      createAliceAndBob testEnv
+
+    describe "POST /api/v1.0/lists/:id/add/form/async (JSON)" $ do
+
+      it "allows uploading a JSON ngrams file" $ \((testEnv, port), app) -> do
+        cId <- newCorpusForUser testEnv "alice"
+        withApplication app $ do
+          withValidLogin port "alice" (GargPassword "alice") $ \token -> do
+            ([listId] :: [NodeId]) <- protectedJSON token "POST" (mkUrl port ("/node/" <> build cId)) [aesonQQ|{"pn_typename":"NodeList","pn_name":"Testing"}|]
+            -- Upload the JSON doc
+            simpleNgrams <- liftIO (TIO.readFile =<< getDataFileName "test-data/ngrams/simple.json")
+            let jsonFileFormData = [ (T.pack "_wjf_data", simpleNgrams)
+                                   , ("_wjf_filetype", "JSON")
+                                   , ("_wjf_name", "simple_ngrams.json")
+                                   ]
+            let url         = "/lists/"  +|listId|+ "/add/form/async"
+            let mkPollUrl j = "/corpus/" +|listId|+ "/add/form/async/" +|_jph_id j|+ "/poll?limit=1"
+            (j :: JobPollHandle) <- postJSONUrlEncoded token (mkUrl port url) (urlEncodeFormStable $ toForm jsonFileFormData)
+            j' <- pollUntilFinished token port mkPollUrl j
+            liftIO (_jph_status j' `shouldBe` "IsFinished")
+
+            -- Now check that we can retrieve the ngrams
+            let getUrl = "/node/" +| listId |+ "/ngrams?ngramsType=Terms&listType=MapTerm&list="+| listId |+"&limit=50"
+            getJSON token (mkUrl port getUrl)
+              `shouldRespondWith` [json| { "version": 0,
+                                            "count": 1,
+                                            "data": [
+                                                {
+                                                    "ngrams": "abelian group",
+                                                    "size": 2,
+                                                    "list": "MapTerm",
+                                                    "occurrences": [],
+                                                    "children": []
+                                                }
+                                            ]
+                                        } |]
+
+    describe "POST /api/v1.0/lists/:id/csv/add/form/async (CSV)" $ do
+
+      it "parses CSV via ngramsListFromCSVData" $ \((_testEnv, _port), _app) -> do
+        simpleNgrams <- liftIO (TIO.readFile =<< getDataFileName "test-data/ngrams/simple.csv")
+        ngramsListFromCSVData simpleNgrams `shouldBe`
+          Right (Map.fromList [ (NgramsTerms, Versioned 0 $ Map.fromList [
+                                  (NgramsTerm "abelian group", NgramsRepoElement 1 MapTerm Nothing Nothing (MSet mempty))
+                                , (NgramsTerm "brazorf", NgramsRepoElement 1 StopTerm Nothing Nothing (MSet mempty))
+                              ])])
+
+      it "allows uploading a CSV ngrams file" $ \((testEnv, port), app) -> do
+        cId <- newCorpusForUser testEnv "alice"
+        withApplication app $ do
+          withValidLogin port "alice" (GargPassword "alice") $ \token -> do
+            ([listId] :: [NodeId]) <- protectedJSON token "POST" (mkUrl port ("/node/" <> build cId)) [aesonQQ|{"pn_typename":"NodeList","pn_name":"Testing"}|]
+            -- Upload the CSV doc
+            simpleNgrams <- liftIO (TIO.readFile =<< getDataFileName "test-data/ngrams/simple.csv")
+            let tsvFileFormData = [ (T.pack "_wtf_data", simpleNgrams)
+                                  , ("_wtf_filetype", "CSV")
+                                  , ("_wtf_name", "simple.csv")
+                                  ]
+            let url         = "/lists/"  <> (fromString $ show $ _NodeId listId) <> "/csv/add/form/async"
+            let mkPollUrl j = "/corpus/" <> (fromString $ show $ _NodeId listId) <> "/add/form/async/" +|_jph_id j|+ "/poll?limit=1"
+            (j :: JobPollHandle) <- postJSONUrlEncoded token (mkUrl port url) (urlEncodeFormStable $ toForm tsvFileFormData)
+            j' <- pollUntilFinished token port mkPollUrl j
+            liftIO (_jph_status j' `shouldBe` "IsFinished")
+
+            -- Now check that we can retrieve the ngrams
+            let getTermsUrl = "/node/" +| listId |+ "/ngrams?ngramsType=Terms&listType=MapTerm&list="+| listId |+"&limit=50"
+            getJSON token (mkUrl port getTermsUrl)
+              `shouldRespondWith` [json| {"version":0
+                                         ,"count":1
+                                         ,"data":[
+                                           {"ngrams":"abelian group"
+                                           ,"size":1
+                                           ,"list":"MapTerm"
+                                           ,"occurrences":[],"children":[]}
+                                           ]
+                                         } |]
+            let getStopUrl = "/node/" +| listId |+ "/ngrams?ngramsType=Terms&listType=StopTerm&list="+| listId |+"&limit=50"
+            getJSON token (mkUrl port getStopUrl)
+              `shouldRespondWith` [json| {"version":0
+                                         ,"count":1
+                                         ,"data":[
+                                           {"ngrams":"brazorf"
+                                           ,"size":1
+                                           ,"list":"StopTerm"
+                                           ,"occurrences":[],"children":[]}
+                                           ]
+                                         } |]
+

test/Test/API/UpdateList.hs

@@ -7,6 +7,9 @@
 
 module Test.API.UpdateList (
     tests
+  , newCorpusForUser
+  , JobPollHandle(..)
+  , pollUntilFinished
   ) where
 
 import Data.Aeson qualified as JSON

test/drivers/hspec/Main.hs

+{-# LANGUAGE TypeApplications #-}
 
 module Main where
 
 import Gargantext.Prelude
 
+import Control.Monad
+import Data.Text (isInfixOf)
 import Shelly hiding (FilePath)
 import System.IO
 import System.Process
+import Test.Hspec
+import qualified Data.Text as T
 import qualified Test.API                     as API
 import qualified Test.Database.Operations     as DB
 
-import Test.Hspec
 
 startCoreNLPServer :: IO ProcessHandle
 startCoreNLPServer = do
   devNull <- openFile "/dev/null" WriteMode
   let p = proc "./startServer.sh" []
-  (_, _, _, hdl) <- createProcess $ p { cwd = Just "devops/coreNLP/stanford-corenlp-current"
+  (_, _, _, hdl) <- (createProcess $ p { cwd = Just "devops/coreNLP/stanford-corenlp-current"
                     , delegate_ctlc = True
                     , 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 'startServer.sh' script. If this is the " <>
+                                                       "first time you are running the tests, you have to run " <>
+                                                       "cd devops/coreNLP && ./build.sh first. You have to run it only once, " <>
+                                                       "and then you are good to go for the time being."
+                                             | otherwise -> throwIO e
   pure hdl
 
 stopCoreNLPServer :: ProcessHandle -> IO ()