Add Phylo golden test

gargantext.cabal

@@ -34,6 +34,7 @@ data-files:
     test-data/ngrams/simple.csv
     test-data/phylo/bpa_phylo_test.json
     test-data/phylo/open_science.json
+    test-data/phylo/issue-290-small.golden.json
     test-data/test_config.ini
     .clippy.dhall
 
@@ -952,6 +953,7 @@ test-suite garg-test-tasty
       Test.Ngrams.Query.PaginationCorpus
       Test.Offline.Errors
       Test.Offline.JSON
+      Test.Offline.Phylo
       Test.Parsers.Date
       Test.Parsers.Types
       Test.Parsers.WOS
@@ -1050,7 +1052,6 @@ 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,7 +8,6 @@ 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
@@ -17,4 +16,3 @@ 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/Offline/Phylo.hs

+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE QuasiQuotes #-}
+
+module Test.Offline.Phylo (tests) where
+
+import Gargantext.Core.Viz.Phylo
+import Gargantext.Core.Viz.Phylo.API.Tools (readPhylo, writePhylo)
+import Gargantext.Core.Viz.Phylo.PhyloMaker (toPhylo)
+import Gargantext.Core.Viz.Phylo.PhyloTools
+import Prelude
+import Test.Tasty
+import Test.Tasty.HUnit
+import Test.Tasty.QuickCheck
+
+import Paths_gargantext
+
+phyloConfig :: PhyloConfig
+phyloConfig = PhyloConfig {
+    corpusPath = "corpus.csv"
+  , listPath = "list.csv"
+  , outputPath = "data/"
+  , corpusParser = Csv {_csv_limit = 150000}
+  , listParser = V4
+  , phyloName = "Phylo Name"
+  , phyloScale = 2
+  , similarity = WeightedLogJaccard {_wlj_sensibility = 0.5, _wlj_minSharedNgrams = 2}
+  , seaElevation = Constante {_cons_start = 0.1, _cons_gap = 0.1}
+  , defaultMode = True
+  , findAncestors = True
+  , phyloSynchrony = ByProximityThreshold {_bpt_threshold = 0.5, _bpt_sensibility = 0.0, _bpt_scope = AllBranches, _bpt_strategy = MergeAllGroups}
+  , phyloQuality = Quality {_qua_granularity = 0.8, _qua_minBranch = 3}
+  , timeUnit = Year {_year_period = 3, _year_step = 1, _year_matchingFrame = 5}
+  , clique = MaxClique {_mcl_size = 5, _mcl_threshold = 1.0e-4, _mcl_filter = ByThreshold}
+  , exportLabel = [ BranchLabel {_branch_labelTagger = MostEmergentTfIdf, _branch_labelSize = 2}
+                  , GroupLabel {_group_labelTagger = MostEmergentInclusive, _group_labelSize = 2}
+                  ]
+  , exportSort = ByHierarchy {_sort_order = Desc}
+  , exportFilter = [ByBranchSize {_branch_size = 3.0}]
+  }
+
+tests :: TestTree
+tests = testGroup "Phylo" [
+  testCase "returns expected data" testSmallPhyloExpectedOutput
+  ]
+
+testSmallPhyloExpectedOutput :: Assertion
+testSmallPhyloExpectedOutput = do
+  issue290PhyloSmall <- setConfig phyloConfig <$> (readPhylo =<< getDataFileName "bench-data/phylo/issue-290-small.json")
+  expected <- readPhylo =<< getDataFileName "test-data/phylo/issue-290-small.golden.json"
+  let actual = toPhylo issue290PhyloSmall
+  expected @?= actual

test/drivers/tasty/Main.hs

@@ -19,6 +19,7 @@ import qualified Test.Ngrams.NLP              as NLP
 import qualified Test.Ngrams.Query            as NgramsQuery
 import qualified Test.Offline.JSON            as JSON
 import qualified Test.Offline.Errors          as Errors
+import qualified Test.Offline.Phylo           as Phylo
 import qualified Test.Parsers.Date            as PD
 import qualified Test.Utils.Crypto            as Crypto
 import qualified Test.Utils.Jobs              as Jobs
@@ -48,4 +49,5 @@ main = do
     , CorpusQuery.tests
     , JSON.tests
     , Errors.tests
+    , Phylo.tests
     ]