Riproduce toPhyloWithoutLink test failure

gargantext.cabal

@@ -42,6 +42,9 @@ data-files:
     test-data/phylo/small-phylo.golden.json
     test-data/phylo/small_phylo_docslist.csv
     test-data/phylo/small_phylo_ngramslist.csv
+    test-data/phylo/GarganText_DocsList-nodeId-187481.csv
+    test-data/phylo/GarganText_NgramsList-nodeId-187482.csv
+    test-data/phylo/187481.json
     test-data/stemming/lancaster.txt
     test-data/test_config.ini
     gargantext-cors-settings.toml
@@ -889,6 +892,7 @@ test-suite garg-test-tasty
   build-depends:
       QuickCheck ^>= 2.14.2
     , aeson ^>= 1.5.6.0
+    , aeson-pretty ^>= 0.8.9
     , aeson-qq
     , async ^>= 2.2.4
     , boolexpr ^>= 0.2

src/Gargantext/Core/Types/Phylo.hs

@@ -19,6 +19,7 @@ Phylomemy was first described in Chavalarias, D., Cointet, J.-P., 2013. Phylomem
 .
 -}
 
+{-# LANGUAGE DeriveAnyClass     #-}
 {-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE LambdaCase         #-}
 {-# LANGUAGE TemplateHaskell    #-}
@@ -41,6 +42,7 @@ import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
 import Gargantext.Prelude
 import Test.QuickCheck
 import Test.QuickCheck.Instances.Text()
+import Data.TreeDiff
 
 ------------------------------------------------------------------------
 -- | Phylo datatype descriptor of a phylomemy
@@ -121,7 +123,7 @@ data GraphData =
     , _gd_objects       :: [ObjectData]
     , _gd_strict        :: Bool
     , _gd_data          :: GraphDataData
-    } deriving (Show, Eq, Generic)
+    } deriving (Show, Eq, Generic, ToExpr)
 
 data GraphDataData =
   GraphDataData {
@@ -149,7 +151,7 @@ data GraphDataData =
   , _gdd_ratio             :: Text
   , _gdd_splines           :: Text
   , _gdd_style             :: Text
-  } deriving (Show, Eq, Generic)
+  } deriving (Show, Eq, Generic, ToExpr)
 
 instance ToJSON GraphDataData where
   toJSON GraphDataData{..} = object [
@@ -214,7 +216,7 @@ data ObjectData =
   | BranchToNode !GvId !NodeCommonData !BranchToNodeData
   | PeriodToNode !GvId !NodeCommonData !PeriodToNodeData
   | Layer        !GvId !GraphDataData  !LayerData
-  deriving (Show, Eq, Generic)
+  deriving (Show, Eq, Generic, ToExpr)
 
 data GroupToNodeData
   = GroupToNodeData
@@ -234,7 +236,7 @@ data GroupToNodeData
     , _gtn_support    :: Text
     , _gtn_to         :: Text
     , _gtn_weight     :: Text
-    } deriving (Show, Eq, Generic)
+    } deriving (Show, Eq, Generic, ToExpr)
 
 instance ToJSON GroupToNodeData where
   toJSON GroupToNodeData{..} = object [
@@ -290,7 +292,7 @@ data BranchToNodeData
     , _btn_fontsize  :: Text
     , _btn_size      :: Text
     , _btn_style     :: Text
-    } deriving (Show, Eq, Generic)
+    } deriving (Show, Eq, Generic, ToExpr)
 
 instance ToJSON BranchToNodeData where
   toJSON BranchToNodeData{..} = object [
@@ -329,7 +331,7 @@ data PeriodToNodeData
     , _ptn_strFrom  :: Maybe Text
     , _ptn_strTo    :: Maybe Text
     , _ptn_to       :: Text
-    } deriving (Show, Eq, Generic)
+    } deriving (Show, Eq, Generic, ToExpr)
 
 instance ToJSON PeriodToNodeData where
   toJSON PeriodToNodeData{..} = object [
@@ -352,7 +354,7 @@ instance FromJSON PeriodToNodeData where
 data LayerData
   = LayerData {
     _ld_nodes :: [Int]
-    } deriving (Show, Eq, Generic)
+    } deriving (Show, Eq, Generic, ToExpr)
 
 instance ToJSON LayerData where
   toJSON LayerData{..} = object [
@@ -373,7 +375,7 @@ data NodeCommonData =
   , _nd_pos      :: !Text
   , _nd_shape    :: !Text
   , _nd_width    :: !Text
-  } deriving (Show, Eq, Generic)
+  } deriving (Show, Eq, Generic, ToExpr)
 
 instance ToJSON NodeCommonData where
   toJSON NodeCommonData{..} = object [
@@ -404,17 +406,18 @@ data EdgeCommonData =
   , _ed_pos   :: !Text
   , _ed_tail  :: !Int
   , _ed_width :: !Text
-  } deriving (Show, Eq, Generic)
+  } deriving (Show, Eq, Generic, ToExpr)
 
 newtype GvId = GvId { _GvId :: Int }
-  deriving (Show, Eq, Generic)
+  deriving stock (Show, Eq, Generic)
+  deriving anyclass ToExpr
 
 data EdgeData
   = GroupToAncestor !GvId !EdgeCommonData !GroupToAncestorData
   | GroupToGroup    !GvId !EdgeCommonData !GroupToGroupData
   | BranchToGroup   !GvId !EdgeCommonData !BranchToGroupData
   | PeriodToPeriod  !GvId !EdgeCommonData
-  deriving (Show, Eq, Generic)
+  deriving (Show, Eq, Generic, ToExpr)
 
 data GroupToAncestorData
   = GroupToAncestorData
@@ -422,20 +425,20 @@ data GroupToAncestorData
     , _gta_lbl       :: !Text
     , _gta_penwidth  :: !Text
     , _gta_style     :: !Text
-    } deriving (Show, Eq, Generic)
+    } deriving (Show, Eq, Generic, ToExpr)
 
 data GroupToGroupData
   = GroupToGroupData
     { _gtg_constraint :: !Text
     , _gtg_lbl        :: !Text
     , _gtg_penwidth   :: !Text
-    } deriving (Show, Eq, Generic)
+    } deriving (Show, Eq, Generic, ToExpr)
 
 data BranchToGroupData
   = BranchToGroupData
     { _btg_arrowhead :: !Text
     , _btg_style :: Maybe Text
-    } deriving (Show, Eq, Generic)
+    } deriving (Show, Eq, Generic, ToExpr)
 
 -- | JSON instances
 instance ToJSON GvId where

test-data/phylo/GarganText_NgramsList-187482.csv

+status	label	forms
+candidate	%	
+candidate	-	
+map	accompagnement	
+map	activités	
+map	adaptation	
+map	addiction	
+map	addictions	conduites addictives
+map	adolescence	
+map	adolescent	
+map	adolescent girls	
+map	adolescent outcomes	
+map	adolescent substance use	
+map	adolescents	adolescence|&|adolescent|&|adolescent girls|&|adolescent outcomes|&|adolescent substance use|&|nombreux adolescents|&|teenagers|&|young adolescents
+map	aide	
+map	alcool	
+candidate	an	
+candidate	analyse	
+map	analyse qualitative	
+candidate	année	
+candidate	années	année
+map	anorexie mentale	
+candidate	ans	an
+map	anxiogène	
+map	anxiété	
+stop	apparition	
+candidate	apprentissage	
+map	approche intégrative	
+map	approche systémique	
+stop	approches	
+candidate	article	
+candidate	articulation	
+candidate	association	
+map	atmosphère familiale	
+candidate	attentes	
+stop	attention	
+candidate	auteurs	
+map	autonome	autonomie
+map	autonomie	
+map	autorité	
+stop	autre part	
+candidate	base	
+candidate	bases	
+map	belle émotion	
+candidate	besoin	
+candidate	biais	
+stop	but	
+map	bébé	
+candidate	cadre	
+map	cahier	
+candidate	caractéristiques	
+stop	carte	
+candidate	cas	
+map	cas cliniques	
+candidate	centaine	
+candidate	centre	
+map	changement	
+candidate	charge	
+map	charge familiale	
+map	charge individuelle	
+candidate	chercheurs	
+candidate	choix	
+candidate	cliniciens	
+map	clinique	
+map	communication	
+candidate	complexité	
+candidate	complément	
+candidate	comportement	
+candidate	compréhension	
+candidate	compte	
+candidate	concept	
+stop	conclusion	
+stop	conditions	
+map	conduites addictives	addiction|&|transaction addictive
+map	conférence	
+candidate	considération	
+map	constellations familiales	
+stop	construction	
+map	consultation	
+candidate	contexte	
+candidate	contextes	
+candidate	continuité	
+map	coopération	
+map	couple	couples
+map	couples	
+candidate	cours	
+map	crise existentielle	
+candidate	croyances	
+candidate	culture	
+map	cycle	
+map	demande	
+stop	demi	
+candidate	dernières années	
+map	dialogue	
+candidate	difficultés	
+candidate	différences	
+candidate	différentes modalités	
+stop	discours	
+stop	discussion	discussions
+stop	discussions	discours
+candidate	dispositif	
+candidate	diversité	
+map	données	
+map	dynamique familiale	
+map	découvrir ensemble	
+map	déficience intellectuelle	
+map	dépressif	
+map	dépression	dépressif
+map	détresse	
+candidate	développement	
+candidate	effet	
+stop	effets	
+map	efficacité	
+map	emdr	
+map	emplois	
+map	enfants porteurs	
+candidate	engagement	
+candidate	ensemble	
+map	entreprise	
+map	entreprises	entreprise
+map	entretiens	
+candidate	entrée	
+candidate	espace	
+map	estime de soi	
+stop	evaluation	
+stop	exemple	
+stop	existence	
+candidate	expert	
+stop	expression	
+map	expérience	
+candidate	extraits	
+candidate	facteur	
+candidate	fait	
+map	familiale	
+map	familiarité	
+map	famille	atmosphère familiale|&|familiale|&|familles|&|familles recomposées
+map	familles	
+map	familles recomposées	
+candidate	family	
+map	fille	
+map	fièvre	
+candidate	fonction	
+map	fonctionnement	
+candidate	forme	
+map	fossé	
+map	fratries	
+map	frustration	
+map	frère	frères
+map	frères	
+map	groupe	groupes
+map	groupe familial	
+map	groupes	
+candidate	guerres	
+map	histoire	
+map	hypothèse	
+candidate	hypothèses	
+map	identification	
+map	illustration clinique	
+stop	impact	
+stop	implication	
+candidate	importance	
+candidate	incidence	
+candidate	individu	
+candidate	information	
+candidate	institutionnalisation	
+candidate	interaction	
+candidate	interactionnelles	
+map	interactions familiales	
+map	interactions négatives	
+map	interactions précoces	
+map	intervention	interventions
+map	interventions	
+candidate	introduction	
+candidate	intérêt	
+candidate	issue	
+map	jalouse	
+map	jalousie	jalouse|&|jaloux
+map	jaloux	
+map	jeu	jeux|&|jouer
+map	jeune enfant	
+candidate	jeunes	
+map	jeunes adultes	
+map	jeux	
+map	jouer	
+map	journal	
+candidate	langage	
+map	langue	
+candidate	lettre	
+stop	lettres	
+map	lettré	lettrée
+map	lettrée	
+candidate	lien	
+stop	liens	
+candidate	lieu	
+candidate	lieux	
+map	littéraire	
+map	littérature	cahier|&|littéraire|&|roman|&|romancier|&|romans|&|écriture
+candidate	l’émouvait	
+map	malade	
+map	maladie	fièvre|&|malade
+map	maman	
+candidate	maîtresse	
+map	meilleure acceptation	
+map	meilleure coopération	
+map	membres	
+map	mentalisation	
+map	mineurs	
+candidate	ministère	
+candidate	mise	
+candidate	modalités	
+candidate	modèle	
+candidate	modérateurs	
+candidate	mois	
+candidate	moitié	
+candidate	monde	
+candidate	murmure	
+map	mutations psychosociétales	
+map	mère	maman
+map	médiateur	médiateurs|&|médiation
+map	médiateurs	
+map	médiation	
+map	médication	
+map	méthode	méthodes
+map	méthodes	
+map	métiers	ouvriers
+map	nombreux adolescents	
+map	nouvelles stratégies	
+map	nouvelles technologies	
+candidate	nécessité	
+candidate	objectif	
+map	objectifs	
+map	objet	
+candidate	objets	
+candidate	organisation	
+candidate	origine	
+candidate	outils	
+map	ouvriers	
+map	paradigme	
+candidate	parallèle	
+map	parentalité	
+map	parents	père
+candidate	parole	
+candidate	part	
+candidate	participants	
+candidate	partie	
+candidate	passage	
+map	pathologie	pathologies
+map	pathologies	
+map	patient	
+stop	patients	
+candidate	perception	
+stop	personne	
+stop	perspective	
+map	petite enfance	
+map	phénomène	
+candidate	pistes	
+candidate	place	
+map	population	
+map	population française	
+candidate	possibilité	
+map	pratique	pratiques
+map	pratiques	
+map	pratiques cliniques	
+candidate	première partie	
+stop	prise	
+candidate	problème	
+candidate	problèmes	
+candidate	processus	
+map	processus thérapeutiques	
+map	processus émotionnels	
+candidate	proches	
+candidate	professionnel	
+map	professionnels	
+candidate	programme	
+stop	propos	
+map	propres stratégies	
+map	protection judiciaire	
+candidate	présence	
+stop	présentation	
+map	prévention	
+map	psychanalyste	
+map	psychiatre	psychiatrie
+map	psychiatrie	
+map	psychologues	
+map	psychométriques	
+map	psychose	
+map	psychosociale	
+map	psychothérapie	
+map	psychothérapie familiale	
+map	père	
+map	pédopsychiatrie	
+stop	période	
+map	qualité	
+map	qualité de vie	
+map	question	
+candidate	questionnaire	
+map	questions	question
+map	quête de sens	
+stop	rapport	
+map	recherche	
+candidate	recherches	
+candidate	reconnaissance	
+map	recrutement	recruter
+map	recruter	
+map	relation fraternelle	
+map	relation thérapeutique	
+candidate	rencontre	
+map	rendre compte	
+candidate	renforcement	
+map	revue	
+candidate	risque	
+map	roman	
+map	romancier	
+map	romans	
+candidate	réflexions	
+candidate	régulation	
+map	régulation émotionnelle	
+candidate	répercussions	
+candidate	réponse	
+candidate	réponses	
+candidate	réseau	
+map	résultats	
+map	rétroaction	
+map	santé	
+map	santé mentale	
+map	santé publique	
+map	schizophrenia	
+map	schizophrenie	
+map	schizophrénie	schizophrenia|&|schizophrenie
+candidate	scène	
+map	sein	
+map	sens	
+candidate	service	
+candidate	situation	
+candidate	situations	
+map	situations cliniques	
+map	sociologie	
+map	soins	
+candidate	solution	
+map	soutien	
+candidate	spécificités	
+map	stratégie	stratégies
+map	stratégies	
+map	stress	
+map	subjectivation	
+candidate	sujet	
+candidate	sujets	
+map	symptôme	
+candidate	système	
+map	système familial	
+candidate	systèmes	
+map	séance	
+map	séances	séance
+map	sœur	sœurs
+map	sœurs	
+map	teenagers	
+stop	terme	
+stop	termes	terme
+map	thérapeute	
+candidate	thérapeutes	
+map	thérapeutes familiaux	
+map	thérapie	thérapies
+map	thérapie familiale	thérapies familiales
+map	thérapie familiale psychanalytique	
+map	thérapie familiale systémique	thérapie systémique|&|thérapies systémiques
+map	thérapie individuelle	
+map	thérapie systémique	
+map	thérapies	
+map	thérapies familiales	
+map	thérapies systémiques	
+candidate	traduction	
+candidate	traitement	
+map	traitement pharmacologique	
+candidate	traitements	
+map	transaction addictive	
+map	transgénérationnel	
+candidate	transmission	
+map	transmission intergénérationnelle	
+map	trauma	trauma history|&|trauma studies|&|traumatisme
+map	trauma history	
+map	trauma studies	
+map	traumatisme	
+candidate	travail	
+map	travaux	
+candidate	travers	
+map	trouble	troubles
+map	trouble développemental	
+map	troubles	
+candidate	type	
+candidate	uns	
+stop	utilisation	
+map	victime	
+map	vie	
+map	vie familiale	
+candidate	voix	murmure
+candidate	vue	
+map	vécu	
+map	young adolescents	
+candidate	zone	
+map	échanges	
+candidate	école	maîtresse|&|éducation|&|élèves
+map	écriture	journal|&|lettre|&|lettres|&|lettré|&|lettrée|&|écrivaine
+map	écrivaine	
+candidate	éducation	
+map	éducation thérapeutique	
+candidate	élaboration	
+map	élaboration mentale	
+candidate	élèves	
+candidate	émergence	
+map	émotion	l’émouvait
+map	émotions	belle émotion|&|émotion
+candidate	épreuve	
+candidate	étapes	
+candidate	état	
+candidate	étude	
+map	évaluation	
+candidate	évidence	
+stop	évolution	
+candidate	œuvre	

test/Test/Offline/Phylo.hs

@@ -6,13 +6,20 @@
 module Test.Offline.Phylo (tests) where
 
 import Common
-import Data.Aeson
+import Data.Aeson as JSON
+import Data.Aeson.Encode.Pretty qualified as JSON
+import Data.Aeson.Types qualified as JSON
+import Data.ByteString.Lazy qualified as BL
 import Data.GraphViz.Attributes.Complete qualified as Graphviz
+import Data.Text.Encoding qualified as TE
 import Data.Text.Lazy as TL
 import Data.TreeDiff
 import Data.Vector qualified as V
+import Gargantext.Core.Text.List.Formats.CSV
+import Gargantext.Core.Types.Phylo
 import Gargantext.Core.Viz.Phylo
-import Gargantext.Core.Viz.Phylo.API.Tools (readPhylo, writePhylo)
+import Gargantext.Core.Viz.Phylo.API
+import Gargantext.Core.Viz.Phylo.API.Tools (readPhylo, writePhylo, phylo2dot2json)
 import Gargantext.Core.Viz.Phylo.Example qualified as Cleopatre
 import Gargantext.Core.Viz.Phylo.PhyloExport
 import Gargantext.Core.Viz.Phylo.PhyloMaker (toPhylo, toPhyloWithoutLink)
@@ -61,6 +68,7 @@ tests = testGroup "Phylo" [
   ]
   , testGroup "toPhylo" [
     --testProperty "returns expected data" testSmallPhyloExpectedOutput
+    testCase "is deterministic" testToPhyloDeterminism
   ]
   , testGroup "relatedComponents" [
     testCase "finds simple connection" testRelComp_Connected
@@ -120,3 +128,33 @@ testRelComp_Connected = do
   (relatedComponents @Int) [[1,2], [3,5], [2,4]]             @?= [[3,5], [1,2,4]]
   (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
+  -- Acquire the config from the golden file.
+  expected_e <- JSON.eitherDecodeFileStrict' =<< getDataFileName "test-data/phylo/187481.json"
+  case expected_e of
+    Left err -> fail err
+    Right (pd :: PhyloData) -> do
+      let goldenCfg  = pd_config pd
+      corpusPath'    <- getDataFileName "test-data/phylo/GarganText_DocsList-nodeId-187481.csv"
+      listPath'      <- getDataFileName "test-data/phylo/GarganText_NgramsList-187482.csv"
+      let config     = goldenCfg { corpusPath = corpusPath'
+                                 , listPath   = listPath'
+                                 , listParser = V3
+                                 }
+      mapList <- csvMapTermList (listPath config)
+      corpus <- fileToDocsDefault (corpusParser config)
+                                  (corpusPath config)
+                                  [Year 3 1 5,Month 3 1 5,Week 4 2 5]
+                                  mapList
+      let actualPhylo = toPhylo $ toPhyloWithoutLink corpus config
+      actual_e   <- JSON.parseEither JSON.parseJSON <$> phylo2dot2json actualPhylo
+      case actual_e of
+        Left err -> fail err
+        Right (expected :: GraphData) -> do
+          assertBool ("Phylo mismatch! " <> show (ansiWlEditExpr $ ediff' expected (pd_data pd))) (expected == pd_data pd)
+          let prettyConfig = JSON.defConfig { JSON.confCompare = compare }
+          let actualJSON   = TE.decodeUtf8 (BL.toStrict $ JSON.encodePretty' prettyConfig $ pd_data pd)
+          let expectedJSON = TE.decodeUtf8 (BL.toStrict $ JSON.encodePretty' prettyConfig $ expected)
+          assertBool ("JSON mismatch!" <> show (ansiWlEditExpr $ ediff' expectedJSON actualJSON)) (expectedJSON == actualJSON)