[NodeStory] NodeStory Integration, compilation with warning ok (WIP)

src/Gargantext/API.hs

@@ -28,36 +28,34 @@ Pouillard (who mainly made it).
 
 {-# LANGUAGE ScopedTypeVariables  #-}
 
----------------------------------------------------------------------
 module Gargantext.API
       where
----------------------------------------------------------------------
+
 import Control.Exception (finally)
 import Control.Lens
 import Control.Monad.Reader (runReaderT)
 import Data.List (lookup)
 import Data.Text.Encoding (encodeUtf8)
+import Data.Text.IO (putStrLn)
 import Data.Validity
 import GHC.Base (Applicative)
 import GHC.Generics (Generic)
-import Network.HTTP.Types hiding (Query)
-import Network.Wai
-import Network.Wai.Handler.Warp hiding (defaultSettings)
-import Network.Wai.Middleware.Cors
-import Network.Wai.Middleware.RequestLogger
-import Servant
-import System.IO (FilePath)
-import Data.Text.IO (putStrLn)
-
 import Gargantext.API.Admin.Auth.Types (AuthContext)
 import Gargantext.API.Admin.Settings (newEnv)
 import Gargantext.API.Admin.Types (FireWall(..), PortNumber, cookieSettings, jwtSettings, settings)
 import Gargantext.API.Ngrams (saveRepo)
-import Gargantext.API.Ngrams.Types (HasRepoSaver(..))
 import Gargantext.API.Prelude
 import Gargantext.API.Routes
 import Gargantext.API.Server (server)
+import Gargantext.Core.NodeStory
 import Gargantext.Prelude hiding (putStrLn)
+import Network.HTTP.Types hiding (Query)
+import Network.Wai
+import Network.Wai.Handler.Warp hiding (defaultSettings)
+import Network.Wai.Middleware.Cors
+import Network.Wai.Middleware.RequestLogger
+import Servant
+import System.IO (FilePath)
 
 
 data Mode = Dev | Mock | Prod 
@@ -79,7 +77,7 @@ portRouteInfo port = do
   putStrLn $ "http://localhost:" <> toUrlPiece port <> "/swagger-ui"
 
 -- TODO clean this Monad condition (more generic) ?
-stopGargantext :: HasRepoSaver env => env -> IO ()
+stopGargantext :: HasNodeStorySaver env => env -> IO ()
 stopGargantext env = do
   putStrLn "----- Stopping gargantext -----"
   runReaderT saveRepo env
@@ -226,4 +224,4 @@ type family GenericTypeName t (r :: *) :: Symbol where
     GenericTypeName t (D1 ('MetaData name mod pkg nt) f x) = name
 
 type Desc t n = Description (AppendSymbol (TypeName t) (AppendSymbol " | " n))
--}
\ No newline at end of file
+-}

src/Gargantext/API/Admin/EnvTypes.hs

@@ -16,7 +16,6 @@ import qualified Servant.Job.Core
 
 import Gargantext.API.Admin.Types
 import Gargantext.API.Admin.Orchestrator.Types
-import Gargantext.API.Ngrams.Types (HasRepoVar(..), HasRepoSaver(..), HasRepo(..), RepoEnv(..))
 import Gargantext.Database.Prelude (HasConnectionPool(..), HasConfig(..))
 import Gargantext.Prelude
 import Gargantext.Prelude.Config (GargConfig(..))
@@ -26,7 +25,6 @@ data Env = Env
   { _env_settings  :: !Settings
   , _env_logger    :: !LoggerSet
   , _env_pool      :: !(Pool Connection)
-  , _env_repo      :: !RepoEnv
   , _env_nodeStory :: !NodeStoryEnv
   , _env_manager   :: !Manager
   , _env_self_url  :: !BaseUrl
@@ -43,6 +41,7 @@ instance HasConfig Env where
 instance HasConnectionPool Env where
   connPool = env_pool
 
+{- To be removed
 instance HasRepoVar Env where
   repoVar = repoEnv . repoVar
 
@@ -51,6 +50,13 @@ instance HasRepoSaver Env where
 
 instance HasRepo Env where
   repoEnv = env_repo
+-}
+
+-- TODONS
+instance HasNodeStorySaver Env
+instance HasNodeStoryEnv Env
+instance HasNodeStoryVar Env
+
 
 instance HasSettings Env where
   settings = env_settings
@@ -71,7 +77,7 @@ makeLenses ''MockEnv
 
 data DevEnv = DevEnv
   { _dev_env_pool     :: !(Pool Connection)
-  , _dev_env_repo     :: !RepoEnv
+  , _dev_env_nodeStory :: !NodeStoryEnv
   , _dev_env_settings :: !Settings
   , _dev_env_config   :: !GargConfig
   }
@@ -84,6 +90,10 @@ instance HasConfig DevEnv where
 instance HasConnectionPool DevEnv where
   connPool = dev_env_pool
 
+-- TODONS
+instance HasNodeStorySaver DevEnv
+
+{-
 instance HasRepoVar DevEnv where
   repoVar = repoEnv . repoVar
 
@@ -92,6 +102,7 @@ instance HasRepoSaver DevEnv where
 
 instance HasRepo DevEnv where
   repoEnv = dev_env_repo
+-}
 
 instance HasSettings DevEnv where
   settings = dev_env_settings

src/Gargantext/API/Admin/Settings.hs

@@ -29,7 +29,6 @@ import Data.Pool (Pool, createPool)
 import Database.PostgreSQL.Simple (Connection, connect, close, ConnectInfo)
 import Gargantext.API.Admin.EnvTypes
 import Gargantext.API.Admin.Types
-import Gargantext.API.Ngrams.Types (NgramsRepo, HasRepo(..), RepoEnv(..), r_version, initRepo, renv_var, renv_lock)
 import Gargantext.Core.NodeStory
 import Gargantext.Database.Prelude (databaseParameters, HasConfig(..))
 import Gargantext.Prelude
@@ -110,6 +109,7 @@ repoSaverAction repoDir a = do
 
 
 
+{-
 -- The use of mkDebounce makes sure that repoSaverAction is not called too often.
 -- If repoSaverAction start taking more time than the debounceFreq then it should
 -- be increased.
@@ -158,6 +158,7 @@ readRepoEnv repoDir = do
   -- TODO save in DB here
   saver <- mkRepoSaver repoDir mvar
   pure $ RepoEnv { _renv_var = mvar, _renv_saver = saver, _renv_lock = lock }
+-}
 
 devJwkFile :: FilePath
 devJwkFile = "dev.jwk"
@@ -173,7 +174,7 @@ newEnv port file = do
   self_url_env  <- parseBaseUrl $ "http://0.0.0.0:" <> show port
   dbParam       <- databaseParameters file
   pool          <- newPool dbParam
-  repo          <- readRepoEnv (_gc_repofilepath config_env)
+--  repo          <- readRepoEnv (_gc_repofilepath config_env)
   nodeStory_env <- readNodeStoryEnv (_gc_repofilepath config_env)
   scrapers_env  <- newJobEnv defaultSettings manager_env
   logger        <- newStderrLoggerSet defaultBufSize
@@ -182,7 +183,7 @@ newEnv port file = do
     { _env_settings  = settings'
     , _env_logger    = logger
     , _env_pool      = pool
-    , _env_repo      = repo
+--    , _env_repo      = repo
     , _env_nodeStory = nodeStory_env
     , _env_manager   = manager_env
     , _env_scrapers  = scrapers_env
@@ -193,9 +194,10 @@ newEnv port file = do
 newPool :: ConnectInfo -> IO (Pool Connection)
 newPool param = createPool (connect param) close 1 (60*60) 8
 
+{-
 cleanEnv :: (HasConfig env, HasRepo env) => env -> IO ()
 cleanEnv env = do
   r <- takeMVar (env ^. repoEnv . renv_var)
   repoSaverAction (env ^. hasConfig . gc_repofilepath) r
   unlockFile (env ^. repoEnv . renv_lock)
-
+-}

src/Gargantext/API/Dev.hs

@@ -15,15 +15,15 @@ module Gargantext.API.Dev where
 import Control.Exception (finally)
 import Control.Monad (fail)
 import Control.Monad.Reader (runReaderT)
-import Servant
-
-import Gargantext.API.Prelude
-import Gargantext.API.Admin.Settings
 import Gargantext.API.Admin.EnvTypes
+import Gargantext.API.Admin.Settings
 import Gargantext.API.Ngrams (saveRepo)
+import Gargantext.API.Prelude
+import Gargantext.Core.NodeStory
 import Gargantext.Database.Prelude
 import Gargantext.Prelude
 import Gargantext.Prelude.Config (GargConfig(..), readConfig)
+import Servant
 import System.IO (FilePath)
 
 type IniPath  = FilePath
@@ -31,24 +31,25 @@ type IniPath  = FilePath
 withDevEnv :: IniPath -> (DevEnv -> IO a) -> IO a
 withDevEnv iniPath k = do
   env <- newDevEnv
-  k env `finally` cleanEnv env
+  k env
+  -- k env `finally` cleanEnv env
 
   where
     newDevEnv = do
       cfg     <- readConfig         iniPath
       dbParam <- databaseParameters iniPath
+      nodeStory_env <- readNodeStoryEnv (_gc_repofilepath cfg)
       pool    <- newPool            dbParam
-      repo    <- readRepoEnv        (_gc_repofilepath cfg)
       setts   <- devSettings devJwkFile
       pure $ DevEnv
         { _dev_env_pool     = pool
-        , _dev_env_repo     = repo
+        , _dev_env_nodeStory  = nodeStory_env
         , _dev_env_settings = setts
         , _dev_env_config   = cfg
         }
 
 -- | Run Cmd Sugar for the Repl (GHCI)
-runCmdRepl :: Show err => Cmd'' DevEnv err a -> IO a
+runCmdRepl :: (Show err, HasNodeStorySaver DevEnv) => Cmd'' DevEnv err a -> IO a
 runCmdRepl f = withDevEnv "gargantext.ini" $ \env -> runCmdDev env f
 
 runCmdReplServantErr :: Cmd'' DevEnv ServerError a -> IO a
@@ -58,17 +59,17 @@ runCmdReplServantErr = runCmdRepl
 -- the command.
 -- This function is constrained to the DevEnv rather than
 -- using HasConnectionPool and HasRepoVar.
-runCmdDev :: Show err => DevEnv -> Cmd'' DevEnv err a -> IO a
+runCmdDev :: (Show err, HasNodeStorySaver DevEnv) => DevEnv -> Cmd'' DevEnv err a -> IO a
 runCmdDev env f =
   (either (fail . show) pure =<< runCmd env f)
     `finally`
   runReaderT saveRepo env
 
-runCmdDevNoErr :: DevEnv -> Cmd' DevEnv () a -> IO a
+runCmdDevNoErr :: (HasNodeStorySaver DevEnv) => DevEnv -> Cmd' DevEnv () a -> IO a
 runCmdDevNoErr = runCmdDev
 
-runCmdDevServantErr :: DevEnv -> Cmd' DevEnv ServerError a -> IO a
+runCmdDevServantErr :: (HasNodeStorySaver DevEnv) => DevEnv -> Cmd' DevEnv ServerError a -> IO a
 runCmdDevServantErr = runCmdDev
 
-runCmdReplEasy :: Cmd'' DevEnv GargError a -> IO a
+runCmdReplEasy :: (HasNodeStorySaver DevEnv) => Cmd'' DevEnv GargError a -> IO a
 runCmdReplEasy f = withDevEnv "gargantext.ini" $ \env -> runCmdDev env f

src/Gargantext/API/Metrics.hs

@@ -30,10 +30,10 @@ import Gargantext.Core.Text.Metrics (Scored(..), {-normalizeGlobal,-} normalizeL
 import Gargantext.Core.Types (CorpusId, Limit, ListId, ListType(..))
 import Gargantext.Core.Viz.Chart
 import Gargantext.Core.Viz.Types
-import Gargantext.Database.Action.Flow
 import Gargantext.Database.Admin.Types.Hyperdata (HyperdataList(..), hl_chart, hl_pie, hl_scatter, hl_tree)
 import Gargantext.Database.Admin.Types.Metrics (ChartMetrics(..), Metric(..), Metrics(..))
 import Gargantext.Database.Admin.Types.Node (NodeId)
+import Gargantext.Database.Action.Flow.Types (FlowCmdM)
 import Gargantext.Database.Prelude
 import Gargantext.Database.Query.Table.Node (defaultList, getNodeWith)
 import Gargantext.Database.Query.Table.Node.Error (HasNodeError)

src/Gargantext/API/Ngrams/List.hs

@@ -24,22 +24,13 @@ import Data.Set (Set)
 import Data.Swagger (ToSchema, declareNamedSchema, genericDeclareNamedSchema)
 import Data.Text (Text, concat, pack)
 import GHC.Generics (Generic)
-import Network.HTTP.Media ((//), (/:))
-import Servant
-import Servant.Job.Async
-import Servant.Job.Utils (jsonOptions)
-import Web.FormUrlEncoded (FromForm)
-import qualified Data.HashMap.Strict as HashMap
-import qualified Data.List           as List
-import qualified Data.Map            as Map
-import qualified Data.Text           as Text
-
 import Gargantext.API.Admin.Orchestrator.Types
 import Gargantext.API.Ngrams (getNgramsTableMap, setListNgrams)
 import Gargantext.API.Ngrams.Tools (getTermsWith)
 import Gargantext.API.Ngrams.Types
 import Gargantext.API.Node.Corpus.New.File (FileType(..))
 import Gargantext.API.Prelude (GargServer)
+import Gargantext.Core.NodeStory
 import Gargantext.Core.Text.Terms (ExtractedNgrams(..))
 import Gargantext.Core.Text.Terms.WithList (buildPatterns, termsInText)
 import Gargantext.Core.Types.Main (ListType(..))
@@ -54,6 +45,15 @@ import Gargantext.Database.Schema.Ngrams
 import Gargantext.Database.Schema.Node
 import Gargantext.Database.Types (Indexed(..))
 import Gargantext.Prelude
+import Network.HTTP.Media ((//), (/:))
+import Servant
+import Servant.Job.Async
+import Servant.Job.Utils (jsonOptions)
+import Web.FormUrlEncoded (FromForm)
+import qualified Data.HashMap.Strict as HashMap
+import qualified Data.List           as List
+import qualified Data.Map            as Map
+import qualified Data.Text           as Text
 
 ------------------------------------------------------------------------
 -- | TODO refactor 
@@ -110,7 +110,7 @@ csvApi = csvPostAsync
 
 
 ------------------------------------------------------------------------
-get :: RepoCmdM env err m =>
+get :: HasNodeStory env err m =>
        ListId -> m (Headers '[Header "Content-Disposition" Text] NgramsList)
 get lId = do
   lst <- get' lId
@@ -121,7 +121,7 @@ get lId = do
                              ]
                      ) lst
 
-get' :: RepoCmdM env err m
+get' :: HasNodeStory env err m
     => ListId -> m NgramsList
 get' lId = fromList
        <$> zip ngramsTypes
@@ -153,8 +153,8 @@ csvPost l m  = do
 
 -----------------------------------------------------------------------------
 -- | Re-index documents of a corpus with new ngrams (called orphans here)
-reIndexWith :: ( HasRepo env
-               , FlowCmdM env err m
+reIndexWith :: ( HasNodeStory env err m
+               , FlowCmdM     env err m
                )
             => CorpusId
             -> ListId

src/Gargantext/API/Ngrams/Tools.hs

@@ -36,11 +36,6 @@ mergeNgramsElement _neOld neNew = neNew
 
 type RootTerm = NgramsTerm
 
-getRepo :: RepoCmdM env err m => m NgramsRepo
-getRepo = do
-  v <- view repoVar
-  liftBase $ readMVar v
-
 getRepo' :: HasNodeStory env err m
          => [ListId] -> m NodeListStory
 getRepo' listIds = do
@@ -80,19 +75,8 @@ getNodeListStory'' n = do
 
 
 listNgramsFromRepo :: [ListId] -> NgramsType
-                   -> NgramsRepo -> HashMap NgramsTerm NgramsRepoElement
-listNgramsFromRepo nodeIds ngramsType repo = ngrams
-  where
-    ngramsMap = repo ^. r_state . at ngramsType . _Just
-
-    -- TODO HashMap linked
-    ngrams    = HM.fromList $ Map.toList $ Map.unionsWith mergeNgramsElement
-                [ ngramsMap ^. at nodeId . _Just | nodeId <- nodeIds ]
-
-
-listNgramsFromRepo' :: [ListId] -> NgramsType
                    -> NodeListStory -> HashMap NgramsTerm NgramsRepoElement
-listNgramsFromRepo' nodeIds ngramsType repo =
+listNgramsFromRepo nodeIds ngramsType repo =
   HM.fromList $ Map.toList
               $ Map.unionsWith mergeNgramsElement ngrams
     where
@@ -110,41 +94,22 @@ listNgramsFromRepo' nodeIds ngramsType repo =
 --              Add a static capability parameter would be nice.
 --              Ideally this is the access to `repoVar` which needs to
 --              be properly guarded.
-getListNgrams :: RepoCmdM env err m
+getListNgrams :: HasNodeStory env err m
               => [ListId] -> NgramsType
               -> m (HashMap NgramsTerm NgramsRepoElement)
-getListNgrams nodeIds ngramsType = listNgramsFromRepo nodeIds ngramsType <$> getRepo
-
-getListNgrams' :: HasNodeStory env err m
-              => [ListId] -> NgramsType
-              -> m (HashMap NgramsTerm NgramsRepoElement)
-getListNgrams' nodeIds ngramsType = listNgramsFromRepo' nodeIds ngramsType
+getListNgrams nodeIds ngramsType = listNgramsFromRepo nodeIds ngramsType
                                  <$> getRepo' nodeIds
 
 
-getTermsWith :: (RepoCmdM env err m, Eq a, Hashable a)
+getTermsWith :: (HasNodeStory env err m, Eq a, Hashable a)
           => (NgramsTerm -> a) -> [ListId]
           -> NgramsType -> Set ListType
           -> m (HashMap a [a])
-getTermsWith f ls ngt lts = HM.fromListWith (<>)
+getTermsWith f ls ngt lts  = HM.fromListWith (<>)
                       <$> map toTreeWith
                       <$> HM.toList
                       <$> HM.filter (\f' -> Set.member (fst f') lts)
                       <$> mapTermListRoot ls ngt
-                      <$> getRepo
-  where
-    toTreeWith (t, (_lt, maybeRoot)) = case maybeRoot of
-      Nothing -> (f t, [])
-      Just  r -> (f r, [f t])
-getTermsWith' :: (HasNodeStory env err m, Eq a, Hashable a)
-          => (NgramsTerm -> a) -> [ListId]
-          -> NgramsType -> Set ListType
-          -> m (HashMap a [a])
-getTermsWith' f ls ngt lts  = HM.fromListWith (<>)
-                      <$> map toTreeWith
-                      <$> HM.toList
-                      <$> HM.filter (\f' -> Set.member (fst f') lts)
-                      <$> mapTermListRoot' ls ngt
                       <$> getRepo' ls
   where
     toTreeWith (t, (_lt, maybeRoot)) = case maybeRoot of
@@ -153,22 +118,13 @@ getTermsWith' f ls ngt lts  = HM.fromListWith (<>)
 
 
 
-
 mapTermListRoot :: [ListId]
                 -> NgramsType
-                -> NgramsRepo
+                -> NodeListStory
                 -> HashMap NgramsTerm (ListType, Maybe NgramsTerm)
 mapTermListRoot nodeIds ngramsType repo =
       (\nre -> (_nre_list nre, _nre_root nre))
   <$> listNgramsFromRepo nodeIds ngramsType repo
-mapTermListRoot' :: [ListId]
-                -> NgramsType
-                -> NodeListStory
-                -> HashMap NgramsTerm (ListType, Maybe NgramsTerm)
-mapTermListRoot' nodeIds ngramsType repo =
-      (\nre -> (_nre_list nre, _nre_root nre))
-  <$> listNgramsFromRepo' nodeIds ngramsType repo
-
 
 
 

src/Gargantext/API/Ngrams/Types.hs

@@ -719,6 +719,7 @@ data RepoEnv = RepoEnv
 
 makeLenses ''RepoEnv
 
+{-
 type RepoCmdM   env err m =
   ( CmdM'             env err m
   , HasRepo           env
@@ -743,7 +744,7 @@ instance HasRepoVar RepoEnv where
   repoVar = renv_var
 instance HasRepoSaver RepoEnv where
   repoSaver = renv_saver
-
+-}
 
 ------------------------------------------------------------------------
 

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

@@ -21,10 +21,11 @@ import Data.Maybe (fromMaybe)
 import Data.Set (Set)
 import Gargantext.API.Node.Corpus.Export.Types
 import Gargantext.API.Ngrams.Types
-import Gargantext.API.Ngrams.Tools (filterListWithRoot, mapTermListRoot, getRepo)
+import Gargantext.API.Ngrams.Tools (filterListWithRoot, mapTermListRoot, getRepo')
 import Gargantext.API.Prelude (GargNoServer)
 import Gargantext.Prelude.Crypto.Hash (hash)
 import Gargantext.Core.Types
+import Gargantext.Core.NodeStory
 import Gargantext.Database.Action.Metrics.NgramsByNode (getNgramsByNodeOnlyUser)
 import Gargantext.Database.Admin.Config (userMaster)
 import Gargantext.Database.Admin.Types.Hyperdata (HyperdataDocument(..))
@@ -57,7 +58,8 @@ getCorpus cId lId nt' = do
   ns   <- Map.fromList
        <$> map (\n -> (_node_id n, n))
        <$> selectDocNodes cId
-  repo <- getRepo
+
+  repo <- getRepo' [fromMaybe (panic "[Gargantext.API.Node.Corpus.Export]") lId]
   ngs  <- getNodeNgrams cId lId nt repo
   let  -- uniqId is hash computed already for each document imported in database
     r = Map.intersectionWith (\a b -> Document a (Ngrams (Set.toList b) (hash b)) (d_hash a b)
@@ -74,7 +76,7 @@ getNodeNgrams :: HasNodeError err
         => CorpusId
         -> Maybe ListId
         -> NgramsType
-        -> NgramsRepo
+        -> NodeListStory
         -> Cmd err (Map NodeId (Set NgramsTerm))
 getNodeNgrams cId lId' nt repo = do
   lId <- case lId' of

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

@@ -18,6 +18,8 @@ New corpus means either:
 module Gargantext.API.Node.Corpus.New
       where
 
+-- import Servant.Multipart
+-- import Test.QuickCheck (elements)
 import Control.Lens hiding (elements, Empty)
 import Data.Aeson
 import Data.Aeson.TH (deriveJSON)
@@ -25,36 +27,33 @@ import Data.Either
 import Data.Maybe (fromMaybe)
 import Data.Swagger
 import Data.Text (Text)
-import qualified Data.Text as T
 import GHC.Generics (Generic)
-import Servant
-import Servant.Job.Utils (jsonOptions)
--- import Servant.Multipart
--- import Test.QuickCheck (elements)
-import Test.QuickCheck.Arbitrary
-
-import Gargantext.Prelude
-
 import Gargantext.API.Admin.Orchestrator.Types (JobLog(..), AsyncJobs)
-import qualified Gargantext.API.Admin.Orchestrator.Types as T
 import Gargantext.API.Admin.Types (HasSettings)
 import Gargantext.API.Node.Corpus.New.File
 import Gargantext.API.Node.Types
 import Gargantext.Core (Lang(..){-, allLangs-})
-import Gargantext.Database.Action.Mail (sendMail)
 import Gargantext.Core.Types.Individu (User(..))
 import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
-import Gargantext.Database.Action.Flow (FlowCmdM, flowCorpus, getDataText, flowDataText, TermType(..), DataOrigin(..){-, allDataOrigins-})
-import Gargantext.Database.Action.User (getUserId)
+import Gargantext.Database.Action.Flow (flowCorpus, getDataText, flowDataText, TermType(..), DataOrigin(..){-, allDataOrigins-})
+import Gargantext.Database.Action.Flow.Types (FlowCmdM)
+import Gargantext.Database.Action.Mail (sendMail)
 import Gargantext.Database.Action.Node (mkNodeWithParent)
+import Gargantext.Database.Action.User (getUserId)
 import Gargantext.Database.Admin.Types.Hyperdata
 import Gargantext.Database.Admin.Types.Node (CorpusId, NodeType(..), UserId)
 import Gargantext.Database.Query.Table.Node (getNodeWith)
 import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
 import Gargantext.Database.Schema.Node (node_hyperdata)
-import qualified Gargantext.Database.GargDB as GargDB
+import Gargantext.Prelude
+import Servant
+import Servant.Job.Utils (jsonOptions)
+import Test.QuickCheck.Arbitrary
+import qualified Data.Text as T
+import qualified Gargantext.API.Admin.Orchestrator.Types as T
 import qualified Gargantext.Core.Text.Corpus.API as API
 import qualified Gargantext.Core.Text.Corpus.Parsers as Parser (FileFormat(..), parseFormat)
+import qualified Gargantext.Database.GargDB as GargDB
 
 ------------------------------------------------------------------------
 {-

src/Gargantext/API/Prelude.hs

@@ -35,6 +35,7 @@ import Gargantext.API.Admin.Orchestrator.Types
 import Gargantext.API.Admin.Types
 import Gargantext.API.Ngrams.Types
 import Gargantext.Core.Types
+import Gargantext.Core.NodeStory
 import Gargantext.Database.Prelude
 import Gargantext.Database.Query.Table.Node.Error (NodeError(..), HasNodeError(..))
 import Gargantext.Database.Query.Tree
@@ -51,10 +52,10 @@ joseError = throwError . (_JoseError #)
 
 type EnvC env =
   ( HasConnectionPool env
-  , HasRepo           env  -- TODO rename HasNgramsRepo
   , HasSettings       env  -- TODO rename HasDbSettings
   , HasJobEnv         env JobLog JobLog
   , HasConfig         env
+  , HasNodeStoryEnv    env
   )
 
 type ErrC err =
@@ -69,6 +70,7 @@ type ErrC err =
 
 type GargServerC env err m =
   ( CmdRandom env err m
+  , HasNodeStory env err m
   , EnvC  env
   , ErrC      err
   , MimeRender JSON err
@@ -91,7 +93,7 @@ type GargNoServer t =
 
 type GargNoServer' env err m =
   ( CmdM           env err m
-  , HasRepo        env
+  , HasNodeStory   env err m
   , HasSettings    env
   , HasNodeError       err
   )

src/Gargantext/Core/NodeStory.hs

@@ -15,30 +15,32 @@ Portability : POSIX
 
 module Gargantext.Core.NodeStory where
 
-import System.IO (FilePath, hClose)
-import Data.Maybe (fromMaybe)
 import Codec.Serialise (Serialise(), serialise, deserialise)
-import Control.Monad.Reader
-import Control.Monad.Except
 import Control.Concurrent (MVar(), withMVar, newMVar)
+import Control.Debounce (mkDebounce, defaultDebounceSettings, debounceFreq, debounceAction)
 import Control.Lens (makeLenses, Getter, (^.))
+import Control.Monad.Except
+import Control.Monad.Reader
 import Data.Aeson hiding ((.=))
-import qualified Data.List as List
-import Data.Map as Map
+import Data.Map.Strict (Map)
+import Data.Maybe (fromMaybe)
 import Data.Monoid
 import Data.Semigroup
 import GHC.Generics (Generic)
 import Gargantext.API.Ngrams.Types
 import Gargantext.Core.Types (NodeId)
 import Gargantext.Core.Utils.Prefix (unPrefix)
+import Gargantext.Database.Prelude (CmdM', HasConnectionPool, HasConfig)
+import Gargantext.Database.Query.Table.Node.Error (HasNodeError())
 import Gargantext.Prelude
-import qualified Gargantext.Database.Query.Table.Ngrams as TableNgrams
-import qualified Data.Map.Strict.Patch.Internal as Patch
-import qualified Data.ByteString.Lazy as L
 import System.Directory (renameFile, createDirectoryIfMissing, doesFileExist)
+import System.IO (FilePath, hClose)
 import System.IO.Temp (withTempFile)
-import Control.Debounce (mkDebounce, defaultDebounceSettings, debounceFreq, debounceAction)
-import Gargantext.Database.Prelude (CmdM', HasConnectionPool, HasConfig)
+import qualified Data.ByteString.Lazy as L
+import qualified Data.List as List
+import qualified Data.Map.Strict as Map
+import qualified Data.Map.Strict.Patch.Internal as Patch
+import qualified Gargantext.Database.Query.Table.Ngrams as TableNgrams
 
 ------------------------------------------------------------------------
 data NodeStoryEnv = NodeStoryEnv
@@ -56,6 +58,7 @@ type HasNodeStory env err m = ( CmdM' env err m
                               , HasNodeStoryEnv env
                               , HasConfig env
                               , HasConnectionPool env
+                              , HasNodeError err
                               )
 
 class (HasNodeStoryVar env, HasNodeStorySaver env)

src/Gargantext/Core/Text/List.hs

@@ -23,7 +23,8 @@ import Data.Monoid (mempty)
 import Data.Ord (Down(..))
 import Data.Set (Set)
 import Data.Tuple.Extra (both)
-import Gargantext.API.Ngrams.Types (NgramsElement, RepoCmdM, NgramsTerm(..))
+import Gargantext.API.Ngrams.Types (NgramsElement, NgramsTerm(..))
+import Gargantext.Core.NodeStory
 import Gargantext.Core.Text (size)
 import Gargantext.Core.Text.List.Group
 import Gargantext.Core.Text.List.Group.Prelude
@@ -38,18 +39,18 @@ import Gargantext.Database.Action.Metrics.TFICF (getTficf)
 import Gargantext.Database.Admin.Types.Node (NodeId)
 import Gargantext.Database.Prelude (CmdM)
 import Gargantext.Database.Query.Table.Ngrams (text2ngrams)
-import Gargantext.Database.Query.Table.Node (defaultList)
 import Gargantext.Database.Query.Table.NgramsPostag (selectLems)
+import Gargantext.Database.Query.Table.Node (defaultList)
 import Gargantext.Database.Query.Table.Node.Error (HasNodeError())
 import Gargantext.Database.Query.Tree.Error (HasTreeError)
 import Gargantext.Database.Schema.Ngrams (NgramsType(..), Ngrams(..))
 import Gargantext.Prelude
 import qualified Data.HashMap.Strict as HashMap
+import qualified Data.HashSet as HashSet
 import qualified Data.List    as List
 import qualified Data.Map     as Map
 import qualified Data.Set     as Set
 import qualified Gargantext.Data.HashMap.Strict.Utils as HashMap
-import qualified Data.HashSet as HashSet
 
 {-
 -- TODO maybe useful for later
@@ -61,7 +62,7 @@ isStopTerm (StopSize n) x = Text.length x < n || any isStopChar (Text.unpack x)
 
 
 -- | TODO improve grouping functions of Authors, Sources, Institutes..
-buildNgramsLists :: ( RepoCmdM env err m
+buildNgramsLists :: ( HasNodeStory env err m
                     , CmdM     env err m
                     , HasTreeError err
                     , HasNodeError err
@@ -86,7 +87,7 @@ data MapListSize = MapListSize { unMapListSize :: !Int }
 
 buildNgramsOthersList ::( HasNodeError err
                         , CmdM     env err m
-                        , RepoCmdM env err m
+                        , HasNodeStory env err m
                         , HasTreeError err
                         )
                         => User
@@ -128,7 +129,7 @@ buildNgramsOthersList user uCid _groupParams (nt, MapListSize mapListSize) = do
 
 getGroupParams :: ( HasNodeError err
                   , CmdM     env err m
-                  , RepoCmdM env err m
+                  , HasNodeStory env err m
                   , HasTreeError err
                   )
                => GroupParams -> HashSet Ngrams -> m GroupParams
@@ -142,7 +143,7 @@ getGroupParams gp _ = pure gp
 -- TODO use ListIds
 buildNgramsTermsList :: ( HasNodeError err
                         , CmdM     env err m
-                        , RepoCmdM env err m
+                        , HasNodeStory env err m
                         , HasTreeError err
                         )
                         => User

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

@@ -16,6 +16,7 @@ import Data.Map (Map)
 import Data.Monoid (mconcat)
 import Gargantext.API.Ngrams.Tools
 import Gargantext.API.Ngrams.Types
+import Gargantext.Core.NodeStory
 import Gargantext.Core.Text.List.Social.Find
 import Gargantext.Core.Text.List.Social.History
 import Gargantext.Core.Text.List.Social.Patch
@@ -49,7 +50,7 @@ keepAllParents _           = KeepAllParents True
 -}
 
 ------------------------------------------------------------------------
-flowSocialList :: ( RepoCmdM env err m
+flowSocialList :: ( HasNodeStory env err m
                    , CmdM     env err m
                    , HasNodeError err
                    , HasTreeError err
@@ -63,7 +64,7 @@ flowSocialList flowPriority user nt flc =
                    (flowSocialListPriority flowPriority)
     where
 
-      flowSocialListByMode' :: ( RepoCmdM env err m
+      flowSocialListByMode' :: ( HasNodeStory env err m
                                , CmdM     env err m
                                , HasNodeError err
                                , HasTreeError err
@@ -77,7 +78,7 @@ flowSocialList flowPriority user nt flc =
         >>= flowSocialListByModeWith nt' flc'
 
 
-      flowSocialListByModeWith :: ( RepoCmdM env err m
+      flowSocialListByModeWith :: ( HasNodeStory env err m
                                   , CmdM     env err m
                                   , HasNodeError err
                                   , HasTreeError err
@@ -94,10 +95,10 @@ flowSocialList flowPriority user nt flc =
           . toFlowListScores (keepAllParents nt'') flc''
         -}
 -----------------------------------------------------------------
-getHistoryScores :: ( RepoCmdM env err m
-                    , CmdM     env err m
-                    , HasNodeError err
-                    , HasTreeError err
+getHistoryScores :: ( HasNodeStory env err m
+                    , CmdM         env err m
+                    , HasNodeError     err
+                    , HasTreeError     err
                     )
                  => History
                  -> NgramsType
@@ -107,7 +108,7 @@ getHistoryScores :: ( RepoCmdM env err m
 getHistoryScores hist nt fl listes =
   addScorePatches nt listes fl <$> getHistory hist nt listes
 
-getHistory :: ( RepoCmdM env err m
+getHistory :: ( HasNodeStory env err m
               , CmdM     env err m
               , HasNodeError err
               , HasTreeError err
@@ -115,7 +116,7 @@ getHistory :: ( RepoCmdM env err m
            => History
            -> NgramsType
            -> [ListId]
-           -> m (Map NgramsType (Map ListId [HashMap NgramsTerm NgramsPatch]))
+           -> m (Map ListId (Map NgramsType [HashMap NgramsTerm NgramsPatch]))
 getHistory hist nt listes =
-  history hist [nt] listes  <$> getRepo
+  history hist [nt] listes  <$> getRepo' listes
 

src/Gargantext/Core/Text/List/Social/History.hs

@@ -15,12 +15,14 @@ import Control.Lens hiding (cons)
 import Data.HashMap.Strict (HashMap)
 import Data.Map (Map)
 import Gargantext.API.Ngrams.Types
+import Gargantext.Core.NodeStory
 import Gargantext.Core.Text.List.Social.Prelude
 import Gargantext.Core.Types (ListId)
 import Gargantext.Database.Schema.Ngrams (NgramsType(..))
 import Gargantext.Prelude
 import qualified Data.List           as List
 import qualified Data.Map.Strict     as Map
+import qualified Data.HashMap.Strict as HasMap
 
 -- TODO put this in Prelude
 cons :: a -> [a]
@@ -37,8 +39,8 @@ data History = History_User
 history :: History
         -> [NgramsType]
         -> [ListId]
-        -> Repo s NgramsStatePatch
-        -> Map NgramsType (Map ListId [HashMap NgramsTerm NgramsPatch])
+        -> NodeStory s NgramsStatePatch'
+        -> Map ListId (Map NgramsType [HashMap NgramsTerm NgramsPatch])
 history History_User t l = clean . (history' t l)
   where
     clean = Map.map (Map.map List.init)
@@ -53,35 +55,20 @@ history _ t l = history' t l
 ------------------------------------------------------------------------
 history' :: [NgramsType]
         -> [ListId]
-        -> Repo s NgramsStatePatch
-        -> Map NgramsType (Map ListId [HashMap NgramsTerm NgramsPatch])
-history' types lists = merge
-                    . map (Map.map ( Map.map cons))
-                    . map (Map.map ((Map.filterWithKey (\k _ -> List.elem k lists))))
-                    . map           (Map.filterWithKey (\k _ -> List.elem k types))
-                    . map toMap
-                    . view r_history
-
-
-merge :: [Map NgramsType (Map ListId [HashMap NgramsTerm NgramsPatch])]
-      ->  Map NgramsType (Map ListId [HashMap NgramsTerm NgramsPatch])
-merge = Map.unionsWith merge'
+        -> NodeStory s NgramsStatePatch'
+        -> Map ListId (Map NgramsType [HashMap NgramsTerm NgramsPatch])
+history' types lists = (Map.map (Map.unionsWith (<>)))
+                    . (Map.map (map (Map.filterWithKey (\k _ -> List.elem k types))))
+                    . (Map.map (map toMap))
+                    . (Map.map (view a_history))
+                    . (Map.filterWithKey (\k _ -> List.elem k lists))
+                    . (view unNodeStory)
   where
-    merge' :: Map ListId [HashMap NgramsTerm NgramsPatch]
-           -> Map ListId [HashMap NgramsTerm NgramsPatch]
-           -> Map ListId [HashMap NgramsTerm NgramsPatch]
-    merge' = Map.unionWith (<>)
+
+    toMap :: PatchMap NgramsType NgramsTablePatch
+          -> Map NgramsType [HashMap NgramsTerm NgramsPatch]
+    toMap m = Map.map (cons . unNgramsTablePatch)
+            $ unPatchMapToMap m
 
 
-toMap :: PatchMap NgramsType
-           (PatchMap ListId
-            (NgramsTablePatch
-            )
-          )
-        -> Map NgramsType
-           (Map ListId
-            (HashMap NgramsTerm NgramsPatch
-            )
-           )
-toMap = Map.map (Map.map unNgramsTablePatch) . (Map.map unPatchMapToMap) . unPatchMapToMap
 

src/Gargantext/Core/Text/List/Social/Patch.hs

@@ -30,27 +30,29 @@ import qualified Data.Patch.Class    as Patch (Replace(..))
 
 addScorePatches :: NgramsType -> [ListId]
                 -> FlowCont NgramsTerm FlowListScores
-                -> Map NgramsType (Map ListId [HashMap NgramsTerm NgramsPatch])
+                -> Map ListId (Map NgramsType [HashMap NgramsTerm NgramsPatch])
                 -> FlowCont NgramsTerm FlowListScores
-addScorePatches nt listes fl repo = foldl' (addScorePatchesList nt repo) fl listes
+addScorePatches nt listes fl repo =
+  foldl' (addScorePatchesList nt repo) fl listes
 
 
 addScorePatchesList :: NgramsType
-                   -> Map NgramsType (Map ListId [HashMap NgramsTerm NgramsPatch])
+                   -- -> Map NgramsType (Map ListId [HashMap NgramsTerm NgramsPatch])
+                   -> Map ListId (Map NgramsType [HashMap NgramsTerm NgramsPatch])
                    -> FlowCont NgramsTerm FlowListScores
                    -> ListId
                    -> FlowCont NgramsTerm FlowListScores
-addScorePatchesList nt repo fl lid = foldl' addScorePatch fl patches
+addScorePatchesList nt repo fl lid =
+  foldl' addScorePatch fl patches
   where
     patches = maybe [] (List.concat . (map HashMap.toList)) patches'
 
     patches' = do
-      lists      <- Map.lookup nt repo
-      mapPatches <- Map.lookup lid lists
+      lists      <- Map.lookup lid repo
+      mapPatches <- Map.lookup nt lists
       pure mapPatches
 
 
-
 addScorePatch :: FlowCont NgramsTerm FlowListScores
               -> (NgramsTerm , NgramsPatch)
               -> FlowCont NgramsTerm FlowListScores

src/Gargantext/Core/Viz/Chart.hs

@@ -35,7 +35,7 @@ import Gargantext.API.Ngrams.NgramsTree
 import Gargantext.API.Ngrams.Tools
 import Gargantext.API.Ngrams.Types
 import Gargantext.Core.Types
-import Gargantext.Database.Action.Flow
+import Gargantext.Database.Action.Flow.Types
 import Gargantext.Database.Action.Metrics.NgramsByNode
 import Gargantext.Database.Schema.Ngrams
 import Gargantext.Core.Viz.Types
@@ -59,7 +59,7 @@ chartData :: FlowCmdM env err m
 chartData cId nt lt = do
   ls' <- selectNodesWithUsername NodeList userMaster
   ls <- map (_node_id) <$> getListsWithParentId cId
-  ts <- mapTermListRoot ls nt <$> getRepo
+  ts <- mapTermListRoot ls nt <$> getRepo' ls
   let
     dico = filterListWithRoot lt ts
     terms = catMaybes $ List.concat $ map (\(a,b) -> [Just a, b]) $ HashMap.toList dico
@@ -79,7 +79,7 @@ treeData :: FlowCmdM env err m
 treeData cId nt lt = do
   ls' <- selectNodesWithUsername NodeList userMaster
   ls <- map (_node_id) <$> getListsWithParentId cId
-  ts <- mapTermListRoot ls nt <$> getRepo
+  ts <- mapTermListRoot ls nt <$> getRepo' ls
 
   let
     dico = filterListWithRoot lt ts

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

@@ -16,11 +16,11 @@ Portability : POSIX
 module Gargantext.Core.Viz.Graph.API
   where
 
-import Control.Lens (set, (^.), _Just, (^?))
+import Control.Lens (set, (^.), _Just, (^?), at, view)
 import Data.Aeson
 import Data.Maybe (fromMaybe)
 import Data.Swagger
-import Data.Text
+import Data.Text hiding (head)
 import Debug.Trace (trace)
 import GHC.Generics (Generic)
 import Gargantext.API.Admin.Orchestrator.Types
@@ -28,6 +28,7 @@ import Gargantext.API.Ngrams.Tools
 import Gargantext.API.Ngrams.Types (NgramsRepo, r_version)
 import Gargantext.API.Prelude
 import Gargantext.Core.Methods.Distances (Distance(..), GraphMetric(..), withMetric)
+import Gargantext.Core.NodeStory
 import Gargantext.Core.Types.Main
 import Gargantext.Core.Viz.Graph
 import Gargantext.Core.Viz.Graph.GEXF ()
@@ -48,7 +49,10 @@ import Gargantext.Prelude
 import Servant
 import Servant.Job.Async
 import Servant.XML
+import qualified Gargantext.Database.Schema.Node as Node
 import qualified Data.HashMap.Strict as HashMap
+import qualified Data.List           as List
+
 ------------------------------------------------------------------------
 -- | There is no Delete specific API for Graph since it can be deleted
 -- as simple Node.
@@ -80,7 +84,6 @@ graphAPI u n = getGraph         u n
 getGraph :: UserId -> NodeId -> GargNoServer HyperdataGraphAPI
 getGraph _uId nId = do
   nodeGraph <- getNodeWith nId (Proxy :: Proxy HyperdataGraph)
-  repo <- getRepo
 
   let
     graph  = nodeGraph ^. node_hyperdata . hyperdataGraph
@@ -89,6 +92,9 @@ getGraph _uId nId = do
                   identity
                   $ nodeGraph ^. node_parent_id
 
+  listId <- defaultList cId
+  repo <- getRepo' [listId]
+
   -- TODO Distance in Graph params
   case graph of
     Nothing     -> do
@@ -118,9 +124,7 @@ recomputeGraph _uId nId maybeDistance = do
                       Nothing -> graph ^? _Just . graph_metadata . _Just . gm_metric
                       _       -> maybeDistance
 
-  repo <- getRepo
   let
-    v   = repo ^. r_version
     cId = maybe (panic "[G.V.G.API.recomputeGraph] Node has no parent")
                   identity
                   $ nodeGraph ^. node_parent_id
@@ -128,6 +132,10 @@ recomputeGraph _uId nId maybeDistance = do
                    Nothing -> withMetric Order1
                    Just m  -> withMetric m
 
+  listId  <- defaultList cId
+  repo <- getRepo' [listId]
+  let v   = repo ^. unNodeStory . at listId . _Just . a_version
+
   case graph of
     Nothing     -> do
       graph' <- computeGraph cId similarity NgramsTerms repo
@@ -150,7 +158,7 @@ computeGraph :: HasNodeError err
              => CorpusId
              -> Distance
              -> NgramsType
-             -> NgramsRepo
+             -> NodeListStory
              -> Cmd err Graph
 computeGraph cId d nt repo = do
   lId  <- defaultList cId
@@ -175,7 +183,7 @@ computeGraph cId d nt repo = do
 defaultGraphMetadata :: HasNodeError err
                      => CorpusId
                      -> Text
-                     -> NgramsRepo
+                     -> NodeListStory
                      -> GraphMetric
                      -> Cmd err GraphMetadata
 defaultGraphMetadata cId t repo gm = do
@@ -191,7 +199,7 @@ defaultGraphMetadata cId t repo gm = do
         , LegendField 3 "#FFF" "Cluster3"
         , LegendField 4 "#FFF" "Cluster4"
         ]
-      , _gm_list = (ListForGraph lId (repo ^. r_version))
+      , _gm_list = (ListForGraph lId (repo ^. unNodeStory . at lId . _Just . a_version))
       , _gm_startForceAtlas = True
     }
                          -- (map (\n -> LegendField n "#FFFFFF" (pack $ show n)) [1..10])
@@ -252,8 +260,13 @@ graphVersions nId = do
                 . gm_list
                 . lfg_version
 
-  repo <- getRepo
-  let v = repo ^. r_version
+    cId = maybe (panic "[G.V.G.API] Node has no parent")
+                  identity
+                  $ nodeGraph ^. node_parent_id
+
+  listId <- defaultList cId
+  repo <- getRepo' [listId]
+  let v = repo ^. unNodeStory . at listId . _Just . a_version
 
   pure $ GraphVersions { gv_graph = listVersion
                        , gv_repo = v }

src/Gargantext/Core/Viz/Phylo/Legacy/LegacyMain.hs

@@ -29,6 +29,7 @@ import Gargantext.Core.Text.Terms.WithList
 import Gargantext.Database.Query.Table.Node(defaultList)
 import Gargantext.Prelude
 import Gargantext.Database.Action.Flow
+import Gargantext.Database.Action.Flow.Types
 import Gargantext.Core.Viz.LegacyPhylo hiding (Svg, Dot)
 import Gargantext.Database.Admin.Types.Hyperdata
 import Gargantext.Database.Schema.Ngrams (NgramsType(..))

src/Gargantext/Database/Action/Flow.hs

@@ -24,8 +24,7 @@ Portability : POSIX
 {-# LANGUAGE TemplateHaskell         #-}
 
 module Gargantext.Database.Action.Flow -- (flowDatabase, ngrams2list)
-  ( FlowCmdM
-  , getDataText
+  ( getDataText
   , flowDataText
   , flow
 

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

@@ -18,15 +18,18 @@ module Gargantext.Database.Action.Flow.List
     where
 
 import Control.Concurrent
-import Control.Lens (view, (^.), (+~), (%~), at)
+import Control.Lens (view, (^.), (+~), (%~), at, (.~), _Just)
 import Control.Monad.Reader
 import Data.Map (Map, toList)
 import Data.Maybe (catMaybes)
 import Data.Text (Text)
-import Gargantext.API.Ngrams.Types (HasRepoSaver(..), NgramsElement(..), NgramsPatch(..), NgramsRepoElement(..), NgramsTablePatch(..), NgramsTerm(..), RepoCmdM, ne_ngrams, ngramsElementToRepo, r_history, r_state, r_version, repoVar)
+import Gargantext.API.Ngrams (saveRepo)
+import Gargantext.API.Ngrams.Tools (getRepoVar)
+import Gargantext.API.Ngrams.Types
 import Gargantext.Core.Types (HasInvalidError(..), assertValid)
 import Gargantext.Core.Types.Main (ListType(CandidateTerm))
 import Gargantext.Core.Utils (something)
+import Gargantext.Core.NodeStory
 import Gargantext.Database.Action.Flow.Types
 import Gargantext.Database.Admin.Types.Node
 import Gargantext.Database.Query.Table.NodeNgrams (NodeNgramsPoly(..), NodeNgramsW, listInsertDb, getCgramsId)
@@ -143,7 +146,7 @@ listInsert lId ngs = mapM_ (\(typeList, ngElmts)
 -- This function is maintained for its usage in Database.Action.Flow.List.
 -- If the given list of ngrams elements contains ngrams already in
 -- the repo, they will be ignored.
-putListNgrams :: (HasInvalidError err, RepoCmdM env err m)
+putListNgrams :: (HasInvalidError err, HasNodeStory env err m)
               => NodeId
               -> TableNgrams.NgramsType
               -> [NgramsElement]
@@ -153,20 +156,18 @@ putListNgrams nodeId ngramsType nes = putListNgrams' nodeId ngramsType m
   where
     m = Map.fromList $ map (\n -> (n ^. ne_ngrams, ngramsElementToRepo n)) nes
 
-putListNgrams' :: (HasInvalidError err, RepoCmdM env err m)
+putListNgrams' :: (HasInvalidError err, HasNodeStory env err m)
                => NodeId
                -> TableNgrams.NgramsType
                -> Map NgramsTerm NgramsRepoElement
                -> m ()
-putListNgrams' nodeId ngramsType ns = do
+putListNgrams' listId ngramsType ns = do
   -- printDebug "[putListNgrams'] nodeId" nodeId
   -- printDebug "[putListNgrams'] ngramsType" ngramsType
   -- printDebug "[putListNgrams'] ns" ns
 
   let p1 = NgramsTablePatch . PM.fromMap $ NgramsReplace Nothing . Just <$> ns
-      (p0, p0_validity) = PM.singleton nodeId p1
-      (p, p_validity) = PM.singleton ngramsType p0
-  assertValid p0_validity
+      (p, p_validity) = PM.singleton ngramsType p1
   assertValid p_validity
   {-
   -- TODO
@@ -178,23 +179,11 @@ putListNgrams' nodeId ngramsType ns = do
   -- The modifyMVar_ would test the patch with applicable first.
   -- If valid the rest would be atomic and no merge is required.
   -}
-  var <- view repoVar
+  var <- getRepoVar listId
   liftBase $ modifyMVar_ var $ \r -> do
-    pure $ r & r_version +~ 1
-             & r_history %~ (p :)
-             & r_state . at ngramsType %~
-               (Just .
-                 (at nodeId %~
-                   ( Just
-                   . (<> ns)
-                   . something
-                   )
-                 )
-                 . something
-               )
+    pure $ r & unNodeStory . at listId . _Just . a_version +~ 1
+             & unNodeStory . at listId . _Just . a_history %~ (p :)
+             & unNodeStory . at listId . _Just . a_state . at ngramsType .~ Just ns
   saveRepo
 
 
-saveRepo :: ( MonadReader env m, MonadBase IO m, HasRepoSaver env )
-         => m ()
-saveRepo = liftBase =<< view repoSaver

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

@@ -16,7 +16,7 @@ module Gargantext.Database.Action.Flow.Pairing
   -- (pairing)
     where
 
-import Control.Lens (_Just, (^.))
+import Control.Lens (_Just, (^.), view)
 import Data.HashMap.Strict (HashMap)
 import qualified Data.HashMap.Strict as HM
 import Data.Maybe (catMaybes, fromMaybe)
@@ -179,8 +179,8 @@ getNgramsDocId :: CorpusId
                 -> NgramsType
                 -> GargNoServer (HashMap DocAuthor (Set NodeId))
 getNgramsDocId cId lId nt = do
-  repo <- getRepo
   lIds <- selectNodesWithUsername NodeList userMaster
+  repo <- getRepo' lIds
   let ngs = filterListWithRoot MapTerm $ mapTermListRoot [lId] nt repo
 
   groupNodesByNgrams ngs

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

@@ -25,6 +25,7 @@ import Gargantext.API.Ngrams.Types
 import Gargantext.Core.Types (HasInvalidError)
 import Gargantext.Core.Flow.Types
 import Gargantext.Core.Text
+import Gargantext.Core.NodeStory
 import Gargantext.Core.Text.Terms
 import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
 import Gargantext.Database.Prelude (CmdM)
@@ -33,10 +34,9 @@ import Gargantext.Database.Query.Tree.Error (HasTreeError)
 
 type FlowCmdM env err m =
   ( CmdM     env err m
-  , RepoCmdM env err m
+  , HasNodeStory env err m
   , HasNodeError err
   , HasInvalidError err
-  , HasRepoVar env
   , HasTreeError err
   )
 

src/Gargantext/Database/Action/Metrics.hs

@@ -15,10 +15,11 @@ module Gargantext.Database.Action.Metrics
 
 import Data.HashMap.Strict (HashMap)
 import Data.Vector (Vector)
-import Gargantext.API.Ngrams.Tools (filterListWithRoot, groupNodesByNgrams, Diagonal(..), getCoocByNgrams, mapTermListRoot, RootTerm, getRepo)
+import Gargantext.API.Ngrams.Tools (filterListWithRoot, groupNodesByNgrams, Diagonal(..), getCoocByNgrams, mapTermListRoot, RootTerm, getRepo')
 import Gargantext.API.Ngrams.Types (TabType(..), ngramsTypeFromTabType, NgramsTerm)
 import Gargantext.Core.Text.Metrics (scored, Scored(..), {-localMetrics, toScored-})
 import Gargantext.Core.Types (ListType(..), Limit, NodeType(..))
+import Gargantext.Core.NodeStory
 import Gargantext.Database.Action.Flow.Types (FlowCmdM)
 import Gargantext.Database.Action.Metrics.NgramsByNode (getNodesByNgramsOnlyUser{-, getTficfWith-})
 import Gargantext.Database.Admin.Config (userMaster)
@@ -61,7 +62,7 @@ getNgramsCooc cId maybeListId tabType maybeLimit = do
 
 
 
-getNgrams :: (FlowCmdM env err m)
+getNgrams :: (HasNodeStory env err m)
             => CorpusId -> Maybe ListId -> TabType
             -> m ( HashMap NgramsTerm (ListType, Maybe NgramsTerm)
                  , HashMap NgramsTerm (Maybe RootTerm)
@@ -72,8 +73,11 @@ getNgrams cId maybeListId tabType = do
     Nothing   -> defaultList cId
     Just lId' -> pure lId'
 
-  lists <- mapTermListRoot [lId] (ngramsTypeFromTabType tabType) <$> getRepo
+  lists <- mapTermListRoot [lId] (ngramsTypeFromTabType tabType) <$> getRepo' [lId]
   let maybeSyn = HM.unions $ map (\t -> filterListWithRoot t lists)
                              [MapTerm, StopTerm, CandidateTerm]
   pure (lists, maybeSyn)
 
+
+
+