[refactoring] ngrams and nodestory refactoring

These are large modules, moving functions around, removing unused ones.

cabal.project

@@ -6,6 +6,7 @@ with-compiler: ghc-9.4.7
 
 packages:
     ./
+    ../openalex
 
 source-repository-package
     type: git
@@ -118,10 +119,10 @@ source-repository-package
     location: https://gitlab.iscpif.fr/gargantext/crawlers/istex.git
     tag: c0a08d62c40a169b7934ceb7cb12c39952160e7a
 
-source-repository-package
-    type: git
-    location: https://gitlab.iscpif.fr/gargantext/crawlers/openalex.git
-    tag: cd179f6dda15d77a085c0176284c921b7bc50c46
+-- source-repository-package
+--     type: git
+--     location: https://gitlab.iscpif.fr/gargantext/crawlers/openalex.git
+--     tag: cd179f6dda15d77a085c0176284c921b7bc50c46
 
 source-repository-package
     type: git

devops/docker/docker-compose.yaml

@@ -57,12 +57,17 @@ services:
     ports:
       - 9000:9000
 
-  johnsnownlp:
-    image: 'johnsnowlabs/nlp-server:latest'
-    volumes:
-      - js-cache:/home/johnsnowlabs/cache_pretrained
+  spacyapi:
+    image: docker.io/bbieniek/spacyapi:en_v3
     ports:
-      - 5000:5000
+      - "127.0.0.1:9080:80"
+    
+  # johnsnownlp:
+  #   image: 'johnsnowlabs/nlp-server:latest'
+  #   volumes:
+  #     - js-cache:/home/johnsnowlabs/cache_pretrained
+  #   ports:
+  #     - 5000:5000
 
 volumes:
   #garg-pgdata:

gargantext.cabal

@@ -123,6 +123,7 @@ library
       Gargantext.Core.NLP
       Gargantext.Core.NodeStory
       Gargantext.Core.NodeStory.DB
+      Gargantext.Core.NodeStory.Utils
       Gargantext.Core.NodeStory.Types
       Gargantext.Core.Text
       Gargantext.Core.Text.Context

src/Gargantext/API/Ngrams/Prelude.hs

@@ -21,7 +21,7 @@ import Data.Map.Strict (fromList)
 import Data.Map.Strict qualified as Map
 import Data.Text qualified as Text
 import Data.Validity
-import Gargantext.API.Ngrams (getNgramsTableMap)
+import Gargantext.API.Ngrams.Tools (getNgramsTableMap)
 import Gargantext.API.Ngrams.Types
 import Gargantext.Core.NodeStory (HasNodeStory)
 import Gargantext.Core.Text.Context (TermList)

src/Gargantext/API/Ngrams/Tools.hs

@@ -13,29 +13,49 @@ Portability : POSIX
 {-# LANGUAGE TypeOperators #-}
 
 module Gargantext.API.Ngrams.Tools
+  ( filterListWithRoot
+  , getCoocByNgrams
+  , getCoocByNgrams'
+  , getCoocByNgrams''
+  , getListNgrams
+  , getNgramsTableMap
+  , getNodeStory
+  , getRepo
+  , getTermsWith
+  , groupNodesByNgrams
+  , mapTermListRoot
+  , mergeNgramsElement
+  , setNgramsTableScores
+  , tableNgramsPull
+
+  -- debugging
+  , dumpJsonTableMap
+  )
   where
 
--- import Gargantext.Core.NodeStoryFile qualified as NSF
-import Control.Lens (_Just, (^.), at, view, At, Index, IxValue)
-import Control.Monad.Reader
+import Control.Lens (_Just, (^.), (^..), (%~), (.~), at, each, msumOf, view, At, Each, Index, IxValue)
+import Data.Aeson.Text qualified as DAT
 import Data.HashMap.Strict (HashMap)
 import Data.HashMap.Strict qualified as HM
 import Data.Map.Strict qualified as Map
 import Data.Set qualified as Set
-import Data.Validity
--- import GHC.Conc (TVar, readTVar)
+import Data.Text qualified as T
+import Data.Text.Lazy.IO as DTL
+import Formatting (hprint, int, (%))
 import Gargantext.API.Ngrams.Types
-import Gargantext.Core.NodeStory
+import Gargantext.Core.NodeStory (ArchiveList, HasNodeStory, NodeListStory, a_history, a_state, a_version, hasNodeStory, nse_getter, nse_getter_multi, unNodeStory)
 import Gargantext.Core.Types (ListType(..), NodeId, ListId)
+import Gargantext.Database.Action.Metrics.NgramsByContext (getOccByNgramsOnlyFast)
+import Gargantext.Database.Query.Table.Ngrams qualified as TableNgrams
+import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
 import Gargantext.Database.Schema.Ngrams (NgramsType)
-import Gargantext.Prelude
+import Gargantext.Prelude hiding ((%))
+import Gargantext.Prelude.Clock (hasTime, getTime)
 
 
 mergeNgramsElement :: NgramsRepoElement -> NgramsRepoElement -> NgramsRepoElement
 mergeNgramsElement _neOld neNew = neNew
 
-type RootTerm = NgramsTerm
-
 
 getRepo :: HasNodeStory env err m
          => [ListId] -> m NodeListStory
@@ -47,16 +67,6 @@ getRepo listIds = do
   -- pure $ v'
 
 
-repoSize :: Ord k1 => NodeStory (Map.Map k1 (Map.Map k2 a)) p
-                   -> NodeId
-                   -> Map.Map k1 Int
-repoSize repo node_id = Map.map Map.size state'
-  where
-    state' = repo ^. unNodeStory
-                   . at node_id . _Just
-                   . a_state
-
-
 getNodeStory :: HasNodeStory env err m
            => ListId -> m ArchiveList
 getNodeStory l = do
@@ -136,17 +146,6 @@ mapTermListRoot nodeIds ngramsType repo =
 
 
 
-filterListWithRootHashMap :: ListType
-                          -> HashMap NgramsTerm (ListType, Maybe NgramsTerm)
-                          -> HashMap NgramsTerm (Maybe RootTerm)
-filterListWithRootHashMap lt m = snd <$> HM.filter isMapTerm m
-  where
-    isMapTerm (l, maybeRoot) = case maybeRoot of
-      Nothing -> l == lt
-      Just  r -> case HM.lookup r m of
-        Nothing -> panicTrace $ "[Garg.API.Ngrams.Tools] filterListWithRootHashMap, unknown key: " <> unNgramsTerm r
-        Just  (l',_) -> l' == lt
-
 filterListWithRoot :: [ListType]
                    -> HashMap NgramsTerm (ListType, Maybe NgramsTerm)
                    -> HashMap NgramsTerm (Maybe RootTerm)
@@ -175,8 +174,6 @@ groupNodesByNgrams syn occs = HM.fromListWith (<>) occs'
         Nothing  -> (t, ns)
         Just  r' -> (r',ns)
 
-data Diagonal = Diagonal Bool
-
 getCoocByNgrams :: Diagonal
                 -> HashMap NgramsTerm (Set NodeId)
                 -> HashMap (NgramsTerm, NgramsTerm) Int
@@ -233,7 +230,82 @@ getCoocByNgrams'' (Diagonal diag) (f1,f2) (m1,m2) =
 
 
 
+getNgramsTableMap :: HasNodeStory env err m
+                  => NodeId
+                  -> TableNgrams.NgramsType
+                  -> m (Versioned NgramsTableMap)
+getNgramsTableMap nodeId ngramsType = do
+  a <- getNodeStory nodeId
+  pure $ Versioned (a ^. a_version)
+                   (a ^. a_state . at ngramsType . _Just)
+
+
+
+dumpJsonTableMap :: HasNodeStory env err m
+                 => Text
+                 -> NodeId
+                 -> TableNgrams.NgramsType
+                 -> m ()
+dumpJsonTableMap fpath nodeId ngramsType = do
+  m <- getNgramsTableMap nodeId ngramsType
+  liftBase $ DTL.writeFile (T.unpack fpath) (DAT.encodeToLazyText m)
+  pure ()
+
+
+
+-- | Helper function to set scores on an `NgramsTable`.
+setNgramsTableScores :: forall env err m t.
+                        ( Each t t NgramsElement NgramsElement
+                        , HasNodeStory env err m
+                        , HasNodeError err )
+                     => NodeId
+                     -> ListId
+                     -> TableNgrams.NgramsType
+                     -> t
+                     -> m t
+setNgramsTableScores nId listId ngramsType table = do
+  t1 <- getTime
+  occurrences <- getOccByNgramsOnlyFast nId listId ngramsType
+  --printDebug "[setNgramsTableScores] occurrences" occurrences
+  t2 <- getTime
+  liftBase $ do
+    let ngrams_terms = table ^.. each . ne_ngrams
+    -- printDebug "ngrams_terms" ngrams_terms
+    hprint stderr
+      ("getTableNgrams/setScores #ngrams=" % int % " time=" % hasTime % "\n")
+      (length ngrams_terms) t1 t2
+  let
+    setOcc ne = ne & ne_occurrences .~ Set.fromList (msumOf (at (ne ^. ne_ngrams) . _Just) occurrences)
+
+  --printDebug "[setNgramsTableScores] with occurences" $ table & each %~ setOcc
+
+  pure $ table & each %~ setOcc
+
+
+
+
+-- This is a special case of tableNgramsPut where the input patch is empty.
+tableNgramsPull :: HasNodeStory env err m
+                => ListId
+                -> TableNgrams.NgramsType
+                -> Version
+                -> m (Versioned NgramsTablePatch)
+tableNgramsPull listId ngramsType p_version = do
+  -- printDebug "[tableNgramsPull]" (listId, ngramsType)
+  a <- getNodeStory listId
+  -- r <- liftBase $ atomically $ readTVar var
+
+  let
+    -- a = r ^. unNodeStory . at listId . non initArchive
+    q = mconcat $ take (a ^. a_version - p_version) (a ^. a_history)
+    q_table = q ^. _PatchMap . at ngramsType . _Just
+
+  pure (Versioned (a ^. a_version) q_table)
+
+
+
 ------------------------------------------
+-- Unused functions
 
 
 -- migrateFromDirToDb :: (HasNodeStory env err m) -- , HasNodeStory env err m)
@@ -253,3 +325,26 @@ getCoocByNgrams'' (Diagonal diag) (f1,f2) (m1,m2) =
 --               ) $ Map.toList nls
 --     --_ <- nodeStoryIncs (Just $ NodeStory nls) listIds
 --     pure ()
+
+
+-- filterListWithRootHashMap :: ListType
+--                           -> HashMap NgramsTerm (ListType, Maybe NgramsTerm)
+--                           -> HashMap NgramsTerm (Maybe RootTerm)
+-- filterListWithRootHashMap lt m = snd <$> HM.filter isMapTerm m
+--   where
+--     isMapTerm (l, maybeRoot) = case maybeRoot of
+--       Nothing -> l == lt
+--       Just  r -> case HM.lookup r m of
+--         Nothing -> panicTrace $ "[Garg.API.Ngrams.Tools] filterListWithRootHashMap, unknown key: " <> unNgramsTerm r
+--         Just  (l',_) -> l' == lt
+
+
+
+-- repoSize :: Ord k1 => NodeStory (Map.Map k1 (Map.Map k2 a)) p
+--                    -> NodeId
+--                    -> Map.Map k1 Int
+-- repoSize repo node_id = Map.map Map.size state'
+--   where
+--     state' = repo ^. unNodeStory
+--                    . at node_id . _Just
+--                    . a_state

src/Gargantext/API/Ngrams/Types.hs

@@ -15,7 +15,108 @@ Portability : POSIX
 {-# LANGUAGE TypeFamilies      #-}
 {-# OPTIONS -fno-warn-orphans #-}
 
-module Gargantext.API.Ngrams.Types where
+module Gargantext.API.Ngrams.Types
+  ( AddRem
+  , addPatch
+  
+  , ConflictResolutionNgramsPatch
+
+  , Diagonal(..)
+  
+  , QueryParamR
+
+  , mkNgramsTablePatch
+  
+  , MSet(..)
+  , mSetFromList
+  , mSetFromSet
+  , mSetToList
+  , mSetToSet
+
+  , NgramsElement(..)
+  , mkNgramsElement
+  , ne_children
+  , ne_list
+  , ne_ngrams
+  , ne_occurrences
+  , ne_parent
+  , ne_root
+  , ne_size
+
+  , NgramsList
+  
+  , NgramsPatch(..)
+  , patch_list
+  , patch_new
+  , patch_old
+
+  , NgramsRepoElement(..)
+  , nre_children
+  , nre_list
+  , nre_parent
+  , nre_root
+  , nre_size
+  
+  , NgramsSearchQuery(..)
+
+  , NgramsTable(..)
+  , _NgramsTable
+  , mockTable
+  
+  , NgramsTableMap
+  
+  , NgramsTablePatch(..)
+  , _NgramsTablePatch
+
+  , NgramsTerm(..)
+
+  , ngramsElementFromRepo
+  , ngramsElementToRepo
+  , ngramsTypeFromTabType
+
+  , OrderBy(..)
+
+  , PatchMap
+  , _PatchMap
+
+  , PatchMSet(..)
+  , unPatchMSet
+
+  , PatchSet(..)
+  , add
+  , rem
+
+  , Repo(..)
+  , initRepo
+  , r_version
+  , r_state
+  , r_history
+  , RepoCmdM
+
+  , RootParent(..)
+  , rp_parent
+
+  , RootTerm
+
+  , TabType(..)
+  
+  , UpdateTableNgramsCharts(..)
+  , utn_list_id
+  , utn_tab_type
+
+  , Version
+  
+  , Versioned(..)
+  , v_data
+  , v_version
+  
+  , VersionedWithCount(..)
+  , toVersionedWithCount
+  , vc_count
+  , vc_data
+  , vc_version
+  )
+where
 
 import Codec.Serialise (Serialise())
 import Control.Category ((>>>))
@@ -43,7 +144,7 @@ import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixUntagged, unPrefixSwagger
 import Gargantext.Database.Admin.Types.Node (ContextId)
 import Gargantext.Database.Prelude (fromField', HasConnectionPool, HasConfig, CmdM')
 import Gargantext.Database.Query.Table.Ngrams qualified as TableNgrams
-import Gargantext.Prelude hiding (IsString, hash, from, replace, to)
+import Gargantext.Prelude hiding (IsString, hash, from, rem, replace, to)
 import Gargantext.Prelude.Crypto.Hash (IsHashable(..))
 import Servant hiding (Patch)
 import Servant.Job.Utils (jsonOptions)
@@ -54,6 +155,13 @@ import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
 
 type QueryParamR = QueryParam' '[Required, Strict]
 
+
+type RootTerm = NgramsTerm
+
+
+
+data Diagonal = Diagonal Bool
+
 ------------------------------------------------------------------------
 --data FacetFormat = Table | Chart
 data TabType   = Docs   | Trash   | MoreFav | MoreTrash

src/Gargantext/API/Node/Corpus/New.hs

@@ -32,7 +32,8 @@ import Data.Text.Encoding qualified as TE
 import EPO.API.Client.Types qualified as EPO
 import Gargantext.API.Admin.Orchestrator.Types (JobLog(..), AsyncJobs)
 import Gargantext.API.Admin.Types (HasSettings)
-import Gargantext.API.Ngrams (commitStatePatch, Versioned(..))
+import Gargantext.API.Ngrams (commitStatePatch)
+import Gargantext.API.Ngrams.Types (Versioned(..))
 import Gargantext.API.Node.Corpus.New.Types
 import Gargantext.API.Node.Corpus.Searx
 import Gargantext.API.Node.Corpus.Types

src/Gargantext/API/Node/DocumentsFromWriteNodes.hs

@@ -27,7 +27,8 @@ import Gargantext.API.Admin.EnvTypes (Env, GargJob(..))
 import Gargantext.API.Admin.Orchestrator.Types (JobLog(..), AsyncJobs)
 import Gargantext.API.Admin.Types (HasSettings)
 import Gargantext.API.Errors.Types
-import Gargantext.API.Ngrams (commitStatePatch, Versioned(..))
+import Gargantext.API.Ngrams (commitStatePatch)
+import Gargantext.API.Ngrams.Types (Versioned(..))
 import Gargantext.API.Prelude (GargM)
 import Gargantext.Core (Lang(..))
 import Gargantext.Core.NodeStory (HasNodeStoryImmediateSaver, HasNodeArchiveStoryImmediateSaver, currentVersion)

src/Gargantext/Core/NodeStory/Utils.hs

+{-|
+Module      : Gargantext.Core.NodeStory.Utils
+Description : NodeStory utilities
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+-}
+
+module Gargantext.Core.NodeStory.Utils
+  ( saveNodeStory )
+where
+
+import Control.Lens (view)
+import Gargantext.Core.NodeStory
+import Gargantext.Core.Types (NodeId)
+import Gargantext.Prelude
+
+
+
+saveNodeStory :: ( MonadReader env m, MonadBase IO m, HasNodeStoryImmediateSaver env )
+              => NodeId -> ArchiveList -> m ()
+saveNodeStory nId a = do
+  saver <- view hasNodeStoryImmediateSaver
+  liftBase $ saver nId a

src/Gargantext/Core/Text/List/Merge.hs

@@ -20,8 +20,7 @@ module Gargantext.Core.Text.List.Merge
 
 import Control.Lens (view)
 import Data.Map.Strict.Patch hiding (PatchMap)
-import Gargantext.API.Ngrams
-import Gargantext.API.Ngrams.Types
+import Gargantext.API.Ngrams.Types (NgramsRepoElement, NgramsTerm, PatchMap, Versioned(..), v_data, v_version)
 import Gargantext.Prelude hiding (diff)
 
 type List = Map NgramsTerm NgramsRepoElement

src/Gargantext/Core/Viz/Graph/API.hs

@@ -21,32 +21,33 @@ module Gargantext.Core.Viz.Graph.API
 import Control.Lens (set, (^.), _Just, (^?), at)
 import Data.Aeson
 import Data.HashMap.Strict qualified as HashMap
-import Data.Swagger
+import Data.Swagger (ToSchema)
 import Gargantext.API.Admin.EnvTypes (GargJob(..), Env)
 import Gargantext.API.Admin.Orchestrator.Types
-import Gargantext.API.Errors.Types
-import Gargantext.API.Ngrams.Tools
-import Gargantext.API.Prelude
+import Gargantext.API.Errors.Types (BackendInternalError)
+import Gargantext.API.Ngrams.Tools (filterListWithRoot, getCoocByNgrams'', getRepo, groupNodesByNgrams, mapTermListRoot)
+import Gargantext.API.Ngrams.Types (Diagonal(..))
+import Gargantext.API.Prelude (GargM, GargServer)
 import Gargantext.Core.Methods.Similarities (Similarity(..), GraphMetric(..), withMetric)
-import Gargantext.Core.NodeStory
-import Gargantext.Core.Types.Main
+import Gargantext.Core.NodeStory (HasNodeStory, NodeListStory, a_version, unNodeStory)
+import Gargantext.Core.Types.Main (ListType(MapTerm))
 import Gargantext.Core.Viz.Graph.GEXF ()
 import Gargantext.Core.Viz.Graph.Tools -- (cooc2graph)
-import Gargantext.Core.Viz.Graph.Types
+import Gargantext.Core.Viz.Graph.Types (Graph, GraphMetadata(..), HyperdataGraph(..), HyperdataGraphAPI(..), LegendField(..), ListForGraph(..), MultiPartite(..), Partite(..), Strength(Strong), hyperdataGraph, gm_edgesStrength, gm_list, gm_metric, gm_startForceAtlas, graph_metadata, hyperdataCamera, lfg_version)
 import Gargantext.Database.Action.Metrics.NgramsByContext (getContextsByNgramsOnlyUser)
 import Gargantext.Database.Action.Node (mkNodeWithParent)
-import Gargantext.Database.Admin.Config
-import Gargantext.Database.Admin.Types.Node
+import Gargantext.Database.Admin.Config (userMaster)
+import Gargantext.Database.Admin.Types.Node (CorpusId, ListId, NodeId, NodeType(NodeCorpus, NodeGraph, NodeList), UserId)
 import Gargantext.Database.Prelude (DBCmd)
-import Gargantext.Database.Query.Table.Node
+import Gargantext.Database.Query.Table.Node (defaultList, getClosestParentIdByType, getNodeWith, getOrMkList)
 import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
-import Gargantext.Database.Query.Table.Node.Select
+import Gargantext.Database.Query.Table.Node.Select (selectNodesWithUsername)
 import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
-import Gargantext.Database.Schema.Ngrams
-import Gargantext.Database.Schema.Node
+import Gargantext.Database.Schema.Ngrams (NgramsType(NgramsTerms))
+import Gargantext.Database.Schema.Node (node_hyperdata, node_name)
 import Gargantext.Prelude
 import Gargantext.Utils.Jobs (serveJobsAPI, MonadJobStatus(..))
-import Servant
+import Servant ((:>), (:<|>)(..), Get, Header, Headers, JSON, Post, ReqBody, ServerT, Summary, addHeader)
 import Servant.Job.Async (AsyncJobsAPI)
 import Servant.XML.Conduit (XML)
 
@@ -58,7 +59,7 @@ type GraphAPI   =  Get  '[JSON] HyperdataGraphAPI
               :<|> "clone"
                    :> ReqBody '[JSON] HyperdataGraphAPI
                    :> Post '[JSON] NodeId
-              :<|> "gexf" :> Get '[XML] (Headers '[Servant.Header "Content-Disposition" Text] Graph)
+              :<|> "gexf" :> Get '[XML] (Headers '[Header "Content-Disposition" Text] Graph)
               :<|> "versions" :> GraphVersionsAPI
 
 data GraphVersions =
@@ -337,10 +338,10 @@ graphClone userId pId (HyperdataGraphAPI { _hyperdataAPIGraph = graph
 ------------------------------------------------------------
 --getGraphGexf :: UserId
 --             -> NodeId
---             -> GargNoServer (Headers '[Servant.Header "Content-Disposition" Text] Graph)
+--             -> GargNoServer (Headers '[Header "Content-Disposition" Text] Graph)
 getGraphGexf :: HasNodeStory env err m
               => NodeId
-             -> m (Headers '[Servant.Header "Content-Disposition" Text] Graph)
+             -> m (Headers '[Header "Content-Disposition" Text] Graph)
 getGraphGexf nId = do
   HyperdataGraphAPI { _hyperdataAPIGraph = graph } <- getGraph nId
   pure $ addHeader "attachment; filename=graph.gexf" graph

src/Gargantext/Database/Action/Flow/List.hs

@@ -23,10 +23,10 @@ import Data.List qualified as List
 import Data.Map.Strict (toList)
 import Data.Map.Strict qualified as Map
 import Data.Map.Strict.Patch qualified as PM
-import Gargantext.API.Ngrams (saveNodeStory)
 import Gargantext.API.Ngrams.Tools (getNodeStory)
 import Gargantext.API.Ngrams.Types
 import Gargantext.Core.NodeStory (HasNodeStory, a_history, a_state, a_version)
+import Gargantext.Core.NodeStory.Utils (saveNodeStory)
 import Gargantext.Core.Types (HasValidationError(..), assertValid)
 import Gargantext.Core.Types.Main (ListType(CandidateTerm))
 import Gargantext.Database.Admin.Types.Node

src/Gargantext/Database/Action/Metrics.hs

@@ -27,7 +27,8 @@ import Database.PostgreSQL.Simple (Query, Only(..))
 import Database.PostgreSQL.Simple.SqlQQ (sql)
 import Database.PostgreSQL.Simple.ToField (toField, Action{-, ToField-})
 import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..))
-import Gargantext.API.Ngrams.Tools (filterListWithRoot, groupNodesByNgrams, Diagonal(..), getCoocByNgrams, mapTermListRoot, RootTerm, getRepo)
+import Gargantext.API.Ngrams.Tools (filterListWithRoot, groupNodesByNgrams, getCoocByNgrams, mapTermListRoot, getRepo)
+import Gargantext.API.Ngrams.Types (Diagonal(..), RootTerm)
 import Gargantext.API.Ngrams.Types (TabType(..), ngramsTypeFromTabType, NgramsTerm(..))
 import Gargantext.Core (HasDBid(toDBid))
 import Gargantext.Core.NodeStory

test/Test/Database/Operations/NodeStory.hs

@@ -20,11 +20,12 @@ import Data.Map.Strict.Patch qualified as PM
 import Data.Set qualified as Set
 import Database.PostgreSQL.Simple qualified as PSQL
 import Database.PostgreSQL.Simple.SqlQQ
-import Gargantext.API.Ngrams (commitStatePatch, mSetFromList, setListNgrams, saveNodeStory)
-import Gargantext.API.Ngrams.Types (MSet(..), NgramsPatch(..), NgramsRepoElement(..), NgramsTerm(..), Versioned(..), mkNgramsTablePatch, nre_children, nre_list, nre_parent, nre_root)
+import Gargantext.API.Ngrams (commitStatePatch, setListNgrams)
+import Gargantext.API.Ngrams.Types (MSet(..), NgramsPatch(..), NgramsRepoElement(..), NgramsTerm(..), Versioned(..), mkNgramsTablePatch, mSetFromList, nre_children, nre_list, nre_parent, nre_root)
 import Gargantext.API.Ngrams.Tools (getNodeStory)
-import Gargantext.Core.NodeStory hiding (runPGSQuery)
-import Gargantext.Core.Types.Individu
+import Gargantext.Core.NodeStory (ArchiveList, a_state, a_version, currentVersion, initArchive)
+import Gargantext.Core.NodeStory.Utils (saveNodeStory)
+import Gargantext.Core.Types.Individu ()
 import Gargantext.Core.Types (ListType(..), ListId, NodeId, UserId)
 import Gargantext.Database.Action.User (getUserId)
 import Gargantext.Database.Admin.Config (userMaster)
@@ -124,7 +125,7 @@ insertNewTermsToNodeStoryTest env = do
     a <- getNodeStory listId
 
     liftIO $ do
-      a `shouldBe` (initArchiveList { _a_state = Map.singleton NgramsTerms nls })
+      a `shouldBe` (initArchiveList & a_state .~ Map.singleton NgramsTerms nls )
     -- check that the ngrams are in the DB as well
     ngramsMap <- selectNgramsId [unNgramsTerm terms]
     liftIO $ (snd <$> Map.toList ngramsMap) `shouldBe` [unNgramsTerm terms]
@@ -154,7 +155,7 @@ insertNewTermsWithChildrenToNodeStoryTest env = do
     a <- getNodeStory listId
 
     liftIO $ do
-      a `shouldBe` (initArchiveList { _a_state = Map.singleton NgramsTerms nls })
+      a `shouldBe` (initArchiveList & a_state .~ Map.singleton NgramsTerms nls )
 
     -- `setListNgrams` calls saveNodeStory already so we should have
     -- the terms in the DB by now
@@ -196,7 +197,7 @@ insertNodeStoryChildrenWithDifferentNgramsTypeThanParentTest env = do
     a <- getNodeStory listId
 
     liftIO $ do
-      a `shouldBe` (initArchiveList { _a_state = Map.singleton NgramsTerms nlsWithChildFixed })
+      a `shouldBe` (initArchiveList & a_state .~ Map.singleton NgramsTerms nlsWithChildFixed )
 
     ngramsMap <- selectNgramsId terms
     liftIO $ (snd <$> Map.toList ngramsMap) `shouldBe` terms
@@ -228,7 +229,7 @@ setListNgramsUpdatesNodeStoryTest env = do
     a <- getNodeStory listId
 
     liftIO $ do
-      a `shouldBe` (initArchiveList { _a_state = Map.singleton NgramsTerms nls })
+      a `shouldBe` (initArchiveList & a_state .~ Map.singleton NgramsTerms nls )
     -- check that the ngrams are in the DB as well
     ngramsMap <- selectNgramsId [unNgramsTerm terms]
     liftIO $ (snd <$> Map.toList ngramsMap) `shouldBe` [unNgramsTerm terms]
@@ -245,7 +246,7 @@ setListNgramsUpdatesNodeStoryTest env = do
     a' <- getNodeStory listId
 
     liftIO $ do
-      a' `shouldBe` (initArchiveList { _a_state = Map.singleton NgramsTerms $ nls <> nls2 })
+      a' `shouldBe` (initArchiveList & a_state .~ (Map.singleton NgramsTerms $ nls <> nls2 ) )
 
 
 setListNgramsUpdatesNodeStoryWithChildrenTest :: TestEnv -> Assertion
@@ -261,7 +262,7 @@ setListNgramsUpdatesNodeStoryWithChildrenTest env = do
     a <- getNodeStory listId
 
     liftIO $ do
-      a `shouldBe` (initArchiveList { _a_state = Map.singleton NgramsTerms nls })
+      a `shouldBe` (initArchiveList & a_state .~ Map.singleton NgramsTerms nls )
 
     -- OK, now we substitute parent with no children, the parent of
     -- 'nreChild' should become Nothing
@@ -276,7 +277,7 @@ setListNgramsUpdatesNodeStoryWithChildrenTest env = do
     a' <- getNodeStory listId
 
     liftIO $ do
-      a' `shouldBe` (initArchiveList { _a_state = Map.singleton NgramsTerms nlsNew })
+      a' `shouldBe` (initArchiveList & a_state .~ Map.singleton NgramsTerms nlsNew )
 
 
 commitPatchSimpleTest :: TestEnv -> Assertion
@@ -286,7 +287,7 @@ commitPatchSimpleTest env = do
 
     -- initially, the node story table is empty
     liftIO $ do
-      a `shouldBe` (initArchiveList { _a_state = Map.empty })
+      a `shouldBe` (initArchiveList & a_state .~ Map.empty )
 
     let (term, nre) = simpleTerm
     let tPatch = NgramsReplace { _patch_old = Nothing
@@ -303,5 +304,5 @@ commitPatchSimpleTest env = do
     a' <- getNodeStory listId
 
     liftIO $ do
-      a' `shouldBe` (initArchiveList { _a_state = Map.singleton NgramsTerms nls
-                                     , _a_version = ver + 1 })
+      a' `shouldBe` (initArchiveList & a_state .~ Map.singleton NgramsTerms nls
+                                     & a_version .~ ver + 1 )