[Merge] Fix conflicts. I got error here at Test/API/Notifications.hs

README.md

@@ -346,4 +346,45 @@ Maybe you need to restore the gargantua password
 ```shell
 $ ALTER ROLE gargantua PASSWORD 'yourPasswordIn_gargantext-settings.toml'
 ```
+
 Maybe you need to change the port to 5433 for database connection in your gargantext.ini file.
+
+## `haskell-language-server`
+
+If you want to use `haskell-language-server` for GHC 9.4.7, install it
+with `ghcup`:
+```shell
+ghcup compile hls --version 2.7.0.0 --ghc 9.4.7
+```
+https://haskell-language-server.readthedocs.io/en/latest/installation.html
+
+## Running the tests
+
+Running the tests can be done via the following command:
+
+```hs
+cabal v2-test --test-show-details=streaming --flags 'test-crypto no-phylo-debug-logs'
+```
+
+The flags have the following meaning:
+
+* `test-crypto`: Switch to use very fast (but not production-secure) cryptography, so that tests runs
+  faster;
+* `no-phylo-debug-logs`: Suppresses the debugging logs which would normally be present in phylo pure (!) code.
+
+In order for some tests to run (like the phylo ones) is **required** to install the `gargantext-cli` via:
+
+```hs
+cabal v2-install gargantext:exe:gargantext-cli
+```
+
+### Modifying a golden test to accept a new (expected) output
+
+Some tests, like the Phylo one, use golden testing to ensure that the JSON Phylo we generate is
+the same as an expected one. This allows us to catch regressions in the serialisation or in the algorithm.
+Sometimes, however, we genuinely want to modify the output so that it's the new reference (i.e. the new
+golden reference). To do so, it's enough to run the testsuite passing the `--accept` flag, for example:
+
+```hs
+cabal v2-test garg-test-tasty --test-show-details=streaming --flags 'test-crypto no-phylo-debug-logs' --test-option=--pattern='/Phylo/' --test-option=--accept"
+```

gargantext.cabal

@@ -839,7 +839,8 @@ test-suite garg-test-tasty
       Test.Server.ReverseProxy
       Test.Types
       Test.Utils
-      Test.Utils.Crypto
+      Test.Utils.Crypto 
+      Test.Ngrams.Lang.Occurrences
       Test.Utils.Jobs
   hs-source-dirs:
       test bin/gargantext-cli

src/Gargantext/Core/Text/Terms/Mono.hs

@@ -33,7 +33,7 @@ words = monoTexts
 
 -- | Sentence split separators
 isSep :: Char -> Bool
-isSep = (`elem` (",.:;?!(){}[]\"\'" :: String))
+isSep = (`elem` (",.:;?!(){}[]" :: String))
 
 monoTerms :: Lang -> Text -> [TermsWithCount]
 monoTerms l txt = map (\t -> (monoText2term l t, 1)) $ monoTexts txt

test/Test/Ngrams/Lang/Occurrences.hs

@@ -14,7 +14,28 @@ commentary with @some markup@.
 {-# LANGUAGE ScopedTypeVariables #-}
 
 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.Prelude
 
+test :: Spec
+test = do 
+    describe "terms in text counting" $ do
+            it "words with quotes should match" $ do
+                let ngrams = ["j'aime"]
+                let doc = "j'aime"
+                let output = []
+                    
+                termsInText EN (buildPatternsWith EN ngrams) doc `shouldBe` [("j'aime", 1)] 
+                
+            -- it "words with quotes should match and be case sentive" $ do
+            --     let ngrams = ["j'aIme"]
+            --     let doc = "j'aime"
+            --     let output = []
+                    
+            --     termsInText EN (buildPatternsWith EN ngrams) doc `shouldNotBe` [("j'aime", 1)] 
 {-
 import Test.Hspec
 

test/Test/Offline/Phylo.hs

 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE TupleSections #-}
 
 module Test.Offline.Phylo (tests) where
 
 import CLI.Phylo.Common
 import Data.Aeson as JSON
 import Data.Aeson.Types qualified as JSON
+import Data.Aeson.Encode.Pretty qualified as JSON
+import Data.ByteString.Lazy qualified as BL
 import Data.GraphViz.Attributes.Complete qualified as Graphviz
 import Data.Text.Lazy as TL
 import Data.TreeDiff
 import Data.Vector qualified as V
 import Gargantext.Core.Text.List.Formats.TSV
 import Gargantext.Core.Types.Phylo hiding (Phylo(..))
-import Gargantext.Core.Viz.Phylo hiding (EdgeType(..))
 import Gargantext.Core.Viz.Phylo.API.Tools (readPhylo, phylo2dot2json)
 import Gargantext.Core.Viz.Phylo.Example qualified as Cleopatre
+import Gargantext.Core.Viz.Phylo hiding (EdgeType(..))
 import Gargantext.Core.Viz.Phylo.PhyloExport
 import Gargantext.Core.Viz.Phylo.PhyloMaker (toPhylo, toPhyloWithoutLink)
 import Gargantext.Core.Viz.Phylo.PhyloTools
 import Paths_gargantext
 import Prelude
 import Test.Tasty
+import Test.Tasty.Golden (goldenVsStringDiff)
 import Test.Tasty.HUnit
+import qualified Test.Tasty.Golden.Advanced as Advanced
 
 phyloTestConfig :: PhyloConfig
 phyloTestConfig = PhyloConfig {
@@ -48,6 +53,32 @@ phyloTestConfig = PhyloConfig {
   , exportFilter = [ByBranchSize {_branch_size = 3.0}]
   }
 
+phyloGolden :: TestName -> (FilePath, IO BL.ByteString) -> TestTree
+phyloGolden testName (fp, action) =
+  goldenVsStringDiff testName differ fp action
+  where
+    differ ref new = [ "diff", "-u", "-w", "--color=always", ref, new]
+
+-- | Use this variant for those tests which requires a more sophisticated way of
+-- comparing outputs directly on the GraphData
+phyloGoldenGraphData :: TestName -> (FilePath, IO GraphData) -> TestTree
+phyloGoldenGraphData testName (goldenPath, getActual) =
+  Advanced.goldenTest testName getGolden getActual differ updateGolden
+  where
+    differ ref new = pure $ case compareGraphDataFuzzy ref new of
+      True  -> Nothing
+      False -> Just $ show (ansiWlEditExprCompact $ ediff ref new)
+
+    updateGolden :: GraphData -> IO ()
+    updateGolden gd = BL.writeFile goldenPath (JSON.encodePretty gd)
+
+    getGolden :: IO GraphData
+    getGolden = do
+      expected_e <- JSON.eitherDecodeFileStrict' =<< getDataFileName goldenPath
+      case expected_e of
+        Left err -> fail err
+        Right (expected :: GraphData) -> pure expected
+
 tests :: TestTree
 tests = testGroup "Phylo" [
   testGroup "Export" [
@@ -56,14 +87,14 @@ tests = testGroup "Phylo" [
   ]
   , testGroup "toPhyloWithoutLink" [
     testCase "returns expected data" testSmallPhyloWithoutLinkExpectedOutput
-  , testCase "phyloCleopatre returns expected data" testCleopatreWithoutLinkExpectedOutput
-  , testCase "Nadal canned corpus returns expected data" testNadalWithoutLinkExpectedOutput
+  , phyloGolden "phyloCleopatre returns expected data" testCleopatreWithoutLinkExpectedOutput
+  , phyloGolden "Nadal canned corpus returns expected data" testNadalWithoutLinkExpectedOutput
   ]
   , testGroup "phylo2dot2json" [
-    testCase "is deterministic" testPhylo2dot2json
+    phyloGoldenGraphData "is deterministic" testPhylo2dot2json
   ]
   , testGroup "toPhylo" [
-    testCase "is deterministic" testToPhyloDeterminism
+    phyloGolden "is deterministic" testToPhyloDeterminism
   ]
   , testGroup "relatedComponents" [
     testCase "finds simple connection" testRelComp_Connected
@@ -71,14 +102,13 @@ tests = testGroup "Phylo" [
   , testCase "parses csv phylo" testCsvPhylo
   ]
 
-testCleopatreWithoutLinkExpectedOutput :: Assertion
-testCleopatreWithoutLinkExpectedOutput = do
+testCleopatreWithoutLinkExpectedOutput :: (FilePath, IO BL.ByteString)
+testCleopatreWithoutLinkExpectedOutput =
   let actual = toPhyloWithoutLink Cleopatre.docs Cleopatre.config
-  expected <- readPhylo =<< getDataFileName "test-data/phylo/cleopatre.golden.json"
-  assertBool (show $ ansiWlEditExprCompact $ ediff expected actual) (expected == actual)
+  in ("test-data/phylo/cleopatre.golden.json", pure $ JSON.encodePretty actual)
 
-testNadalWithoutLinkExpectedOutput :: Assertion
-testNadalWithoutLinkExpectedOutput = do
+testNadalWithoutLinkExpectedOutput :: (FilePath, IO BL.ByteString)
+testNadalWithoutLinkExpectedOutput = ("test-data/phylo/nadal.golden.json",) $ do
   corpusPath'    <- getDataFileName "test-data/phylo/nadal_docslist.golden.tsv"
   listPath'      <- getDataFileName "test-data/phylo/nadal_ngramslist.golden.tsv"
   let config  = phyloTestConfig { corpusPath = corpusPath'
@@ -90,9 +120,7 @@ testNadalWithoutLinkExpectedOutput = do
                         (corpusPath config)
                         [Year 3 1 5,Month 3 1 5,Week 4 2 5]
                         mapList
-  let actual = setConfig phyloTestConfig $ toPhyloWithoutLink corpus config
-  expected   <- setConfig phyloTestConfig <$> (readPhylo =<< getDataFileName "test-data/phylo/nadal.golden.json")
-  assertBool (show $ ansiWlEditExprCompact $ ediff expected actual) (expected == actual)
+  pure $ JSON.encodePretty $ setConfig phyloTestConfig $ toPhyloWithoutLink corpus config
 
 testSmallPhyloWithoutLinkExpectedOutput :: Assertion
 testSmallPhyloWithoutLinkExpectedOutput = do
@@ -111,17 +139,12 @@ testSmallPhyloWithoutLinkExpectedOutput = do
   expected   <- setConfig phyloTestConfig <$> (readPhylo =<< getDataFileName "test-data/phylo/small-phylo.golden.json")
   assertBool (show $ ansiWlEditExprCompact $ ediff expected actual) (expected == actual)
 
-testPhylo2dot2json :: Assertion
-testPhylo2dot2json = do
-  expected_e <- JSON.eitherDecodeFileStrict' =<< getDataFileName "test-data/phylo/phylo2dot2json.golden.json"
-  case expected_e of
+testPhylo2dot2json :: (FilePath, IO GraphData)
+testPhylo2dot2json = ("test-data/phylo/phylo2dot2json.golden.json",) $ do
+  actual_e <- JSON.parseEither JSON.parseJSON <$> phylo2dot2json Cleopatre.phyloCleopatre
+  case actual_e of
     Left err -> fail err
-    Right (expected :: GraphData) -> do
-      actual_e <- JSON.parseEither JSON.parseJSON <$> phylo2dot2json Cleopatre.phyloCleopatre
-      case actual_e of
-        Left err -> fail err
-        Right (actual :: GraphData) -> do
-          assertBool ("Phylo mismatch!" <> show (ansiWlEditExprCompact $ ediff expected actual)) (expected `compareGraphDataFuzzy` actual)
+    Right (actual :: GraphData) -> pure actual
 
 compareGraphDataFuzzy :: GraphData -> GraphData -> Bool
 compareGraphDataFuzzy gd1 gd2 =
@@ -232,8 +255,8 @@ testRelComp_Connected = do
   (relatedComponents @Int) [[1,2], [3,5], [2,4],[9,5],[5,4]] @?= [[1,2,4,3,5,9]]
   (relatedComponents @Int) [[1,2,5], [4,5,9]]                @?= [[1,2,5,4,9]]
 
-testToPhyloDeterminism :: Assertion
-testToPhyloDeterminism = do
+testToPhyloDeterminism :: (FilePath, IO BL.ByteString)
+testToPhyloDeterminism = ("test-data/phylo/187481.json",) $ do
   corpusPath' <- getDataFileName "test-data/phylo/GarganText_DocsList-nodeId-187481.tsv"
   listPath'   <- getDataFileName "test-data/phylo/GarganText_NgramsList-187482.tsv"
   let config  = phyloTestConfig { corpusPath = corpusPath'
@@ -246,8 +269,7 @@ testToPhyloDeterminism = do
                               [Year 3 1 5,Month 3 1 5,Week 4 2 5]
                               mapList
   let actual = setConfig phyloTestConfig $ toPhylo $ toPhyloWithoutLink corpus config
-  expected    <- setConfig phyloTestConfig <$> (readPhylo =<< getDataFileName "test-data/phylo/187481.json")
-  assertBool ("Phylo mismatch! " <> show (ansiWlEditExprCompact $ ediff expected actual)) (expected == actual)
+  pure $ JSON.encodePretty actual
 
 testCsvPhylo :: Assertion
 testCsvPhylo = do

test/drivers/tasty/Main.hs

@@ -27,6 +27,8 @@ import qualified Test.Utils.Crypto               as Crypto
 import qualified Test.Utils.Jobs                 as Jobs
 import qualified Test.Core.Similarity            as Similarity
 import qualified Test.Core.Notifications          as Notifications
+import qualified Test.Core.AsyncUpdates          as AsyncUpdates
+import qualified Test.Ngrams.Lang.Occurrences    as Occurrences
 
 import Test.Tasty
 import Test.Tasty.Hspec
@@ -40,7 +42,8 @@ main = do
   nlpSpec          <- testSpec "NLP" NLP.test
   jobsSpec         <- testSpec "Jobs" Jobs.test
   similaritySpec   <- testSpec "Similarity" Similarity.test
-  asyncUpdatesSpec <- testSpec "Notifications" Notifications.test
+  asyncUpdatesSpec <- testSpec "AsyncUpdates" AsyncUpdates.test
+  occurrencesSepc  <- testSpec "Occurrences" Occurrences.test
 
   defaultMain $ testGroup "Gargantext"
     [ utilSpec
@@ -49,6 +52,7 @@ main = do
     , cryptoSpec
     , nlpSpec
     , jobsSpec
+    , occurrencesSepc
     , NgramsQuery.tests
     , CorpusQuery.tests
     , TSVParser.tests