[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.hs

@@ -63,10 +63,6 @@ module Gargantext.API.Ngrams
 
   , TabType(..)
 
-  , HasRepoVar(..)
-  , HasRepoSaver(..)
-  , HasRepo(..)
-  , RepoCmdM
   , QueryParamR
   , TODO
 
@@ -183,34 +179,21 @@ mkChildrenGroups addOrRem nt patches =
 
 ------------------------------------------------------------------------
 
-saveRepo :: ( MonadReader env m, MonadBase IO m, HasRepoSaver env )
+saveRepo :: ( MonadReader env m, MonadBase IO m, HasNodeStorySaver env )
          => m ()
-saveRepo = liftBase =<< view repoSaver
-saveRepo' :: ( MonadReader env m, MonadBase IO m, HasNodeStorySaver env )
-         => m ()
-saveRepo' = liftBase =<< view hasNodeStorySaver
+saveRepo = liftBase =<< view hasNodeStorySaver
 
 
 
 listTypeConflictResolution :: ListType -> ListType -> ListType
 listTypeConflictResolution _ _ = undefined -- TODO Use Map User ListType
 
-ngramsStatePatchConflictResolution
-  :: TableNgrams.NgramsType
-  -> NodeId
-  -> NgramsTerm
-  -> ConflictResolutionNgramsPatch
-ngramsStatePatchConflictResolution _ngramsType _nodeId _ngramsTerm
-  = (ours, (const ours, ours), (False, False))
-                             -- (False, False) mean here that Mod has always priority.
-                             -- (True, False) <- would mean priority to the left (same as ours).
-  -- undefined {- TODO think this through -}, listTypeConflictResolution)
 
-ngramsStatePatchConflictResolution'
+ngramsStatePatchConflictResolution
   :: TableNgrams.NgramsType
   -> NgramsTerm
   -> ConflictResolutionNgramsPatch
-ngramsStatePatchConflictResolution' _ngramsType _ngramsTerm
+ngramsStatePatchConflictResolution _ngramsType _ngramsTerm
   = (ours, (const ours, ours), (False, False))
                              -- (False, False) mean here that Mod has always priority.
                              -- (True, False) <- would mean priority to the left (same as ours).
@@ -260,26 +243,12 @@ addListNgrams listId ngramsType nes = do
 -- && should use patch
 -- UNSAFE
 
-setListNgrams ::  RepoCmdM env err m
+setListNgrams ::  HasNodeStory env err m
               => NodeId
               -> TableNgrams.NgramsType
               -> Map NgramsTerm NgramsRepoElement
               -> m ()
 setListNgrams listId ngramsType ns = do
-  var <- view repoVar
-  liftBase $ modifyMVar_ var $
-    pure . ( r_state
-           . at ngramsType
-             %~ Just . (at listId .~ Just ns) . something
-           )
-  printDebug "List modified" NodeList
-  saveRepo
-setListNgrams' ::  HasNodeStory env err m
-              => NodeId
-              -> TableNgrams.NgramsType
-              -> Map NgramsTerm NgramsRepoElement
-              -> m ()
-setListNgrams' listId ngramsType ns = do
   getter <- view hasNodeStory
   var <- liftBase $ (getter ^. nse_getter) listId
   liftBase $ modifyMVar_ var $
@@ -289,32 +258,18 @@ setListNgrams' listId ngramsType ns = do
               . at ngramsType
               .~ Just ns
            )
-  saveRepo'
+  saveRepo
 
 
-currentVersion :: RepoCmdM env err m
-               => m Version
-currentVersion = do
-  var <- view repoVar
-  r   <- liftBase $ readMVar var
-  pure $ r ^. r_version
-currentVersion' :: HasNodeStory env err m
+currentVersion :: HasNodeStory env err m
                => ListId -> m Version
-currentVersion' listId = do
+currentVersion listId = do
   nls <- getRepo' [listId]
   pure $ nls ^. unNodeStory . at listId . _Just . a_version
 
 
-
-
-newNgramsFromNgramsStatePatch :: NgramsStatePatch -> [Ngrams]
+newNgramsFromNgramsStatePatch :: NgramsStatePatch' -> [Ngrams]
 newNgramsFromNgramsStatePatch p =
-  [ text2ngrams (unNgramsTerm n)
-  | (n,np) <- p ^.. _PatchMap . each . _PatchMap . each . _NgramsTablePatch . _PatchMap . ifolded . withIndex
-  , _ <- np ^.. patch_new . _Just
-  ]
-newNgramsFromNgramsStatePatch' :: NgramsStatePatch' -> [Ngrams]
-newNgramsFromNgramsStatePatch' p =
   [ text2ngrams (unNgramsTerm n)
   | (n,np) <- p ^.. _PatchMap
                 -- . each . _PatchMap
@@ -325,84 +280,38 @@ newNgramsFromNgramsStatePatch' p =
 
 
 -- tableNgramsPut :: (HasInvalidError err, RepoCmdM env err m)
-commitStatePatch :: RepoCmdM env err m
-                 =>    Versioned NgramsStatePatch
-                 -> m (Versioned NgramsStatePatch)
-commitStatePatch (Versioned p_version p) = do
-  var <- view repoVar
-  vq' <- liftBase $ modifyMVar var $ \r -> do
-    let
-      q = mconcat $ take (r ^. r_version - p_version) (r ^. r_history)
-      (p', q') = transformWith ngramsStatePatchConflictResolution p q
-      r' = r & r_version +~ 1
-             & r_state   %~ act p'
-             & r_history %~ (p' :)
-    {-
-    -- Ideally we would like to check these properties. However:
-    -- * They should be checked only to debug the code. The client data
-    --   should be able to trigger these.
-    -- * What kind of error should they throw (we are in IO here)?
-    -- * Should we keep modifyMVar?
-    -- * Should we throw the validation in an Exception, catch it around
-    --   modifyMVar and throw it back as an Error?
-    assertValid $ transformable p q
-    assertValid $ applicable p' (r ^. r_state)
-    -}
-    pure (r', Versioned (r' ^. r_version) q')
-
-  saveRepo
-
-  -- Save new ngrams
-  _ <- insertNgrams (newNgramsFromNgramsStatePatch p)
-
-  pure vq'
-
-commitStatePatch' :: HasNodeStory env err m
+commitStatePatch :: HasNodeStory env err m
                  => ListId
                  ->    Versioned NgramsStatePatch'
                  -> m (Versioned NgramsStatePatch')
-commitStatePatch' listId (Versioned p_version p) = do
+commitStatePatch listId (Versioned p_version p) = do
   var <- getRepoVar listId
   vq' <- liftBase $ modifyMVar var $ \ns -> do
     let
       a = ns ^. unNodeStory . at listId . _Just
       q = mconcat $ take (a ^. a_version - p_version) (a ^. a_history)
-      (p', q') = transformWith ngramsStatePatchConflictResolution' p q
+      (p', q') = transformWith ngramsStatePatchConflictResolution p q
       a' = a & a_version +~ 1
              & a_state   %~ act p'
              & a_history %~ (p' :)
     pure ( ns & unNodeStory . at listId .~ (Just a')
          , Versioned (a' ^. a_version) q'
          )
-  saveRepo'
+  saveRepo
   -- Save new ngrams
-  _ <- insertNgrams (newNgramsFromNgramsStatePatch' p)
+  _ <- insertNgrams (newNgramsFromNgramsStatePatch p)
 
   pure $ vq'
 
 
 
 -- This is a special case of tableNgramsPut where the input patch is empty.
-tableNgramsPull :: RepoCmdM env err m
+tableNgramsPull :: HasNodeStory env err m
                 => ListId
                 -> TableNgrams.NgramsType
                 -> Version
                 -> m (Versioned NgramsTablePatch)
 tableNgramsPull listId ngramsType p_version = do
-  var <- view repoVar
-  r <- liftBase $ readMVar var
-
-  let
-    q = mconcat $ take (r ^. r_version - p_version) (r ^. r_history)
-    q_table = q ^. _PatchMap . at ngramsType . _Just . _PatchMap . at listId . _Just
-
-  pure (Versioned (r ^. r_version) q_table)
-tableNgramsPull' :: HasNodeStory env err m
-                => ListId
-                -> TableNgrams.NgramsType
-                -> Version
-                -> m (Versioned NgramsTablePatch)
-tableNgramsPull' listId ngramsType p_version = do
   var <- getRepoVar listId
   r <- liftBase $ readMVar var
 
@@ -419,7 +328,8 @@ tableNgramsPull' listId ngramsType p_version = do
 -- Apply the given patch to the DB and returns the patch to be applied on the
 -- client.
 -- TODO-ACCESS check
-tableNgramsPut :: ( FlowCmdM env err m
+tableNgramsPut :: ( HasNodeStory env err m
+                   , HasInvalidError err
                   , HasSettings env
                   )
                  => TabType
@@ -431,45 +341,21 @@ tableNgramsPut tabType listId (Versioned p_version p_table)
       let ngramsType        = ngramsTypeFromTabType tabType
       tableNgramsPull listId ngramsType p_version
 
-  | otherwise         = do
-      let ngramsType        = ngramsTypeFromTabType tabType
-          (p0, p0_validity) = PM.singleton listId p_table
-          (p, p_validity)   = PM.singleton ngramsType p0
-
-      assertValid p0_validity
-      assertValid p_validity
-
-      ret <- commitStatePatch (Versioned p_version p)
-        <&> v_data %~ (view (_PatchMap . at ngramsType . _Just . _PatchMap . at listId . _Just))
-
-      pure ret
-tableNgramsPut' :: ( HasNodeStory env err m
-                   , HasInvalidError err
-                  , HasSettings env
-                  )
-                 => TabType
-                 -> ListId
-                 -> Versioned NgramsTablePatch
-                 -> m (Versioned NgramsTablePatch)
-tableNgramsPut' tabType listId (Versioned p_version p_table)
-  | p_table == mempty = do
-      let ngramsType        = ngramsTypeFromTabType tabType
-      tableNgramsPull' listId ngramsType p_version
-
   | otherwise         = do
       let ngramsType        = ngramsTypeFromTabType tabType
           (p, p_validity)   = PM.singleton ngramsType p_table
 
       assertValid p_validity
 
-      ret <- commitStatePatch' listId (Versioned p_version p)
+      ret <- commitStatePatch listId (Versioned p_version p)
         <&> v_data %~ (view (_PatchMap . at ngramsType . _Just))
 
       pure ret
 
 
 
-tableNgramsPostChartsAsync :: ( FlowCmdM env err m
+tableNgramsPostChartsAsync :: ( HasNodeStory env err m
+                              , FlowCmdM     env err m
                               , HasNodeError err
                               , HasSettings env
                               )
@@ -557,27 +443,18 @@ tableNgramsPostChartsAsync utn logStatus = do
   }
   -}
 
-getNgramsTableMap :: RepoCmdM env err m
+getNgramsTableMap :: HasNodeStory env err m
                   => NodeId
                   -> TableNgrams.NgramsType
                   -> m (Versioned NgramsTableMap)
 getNgramsTableMap nodeId ngramsType = do
-  v    <- view repoVar
-  repo <- liftBase $ readMVar v
-  pure $ Versioned (repo ^. r_version)
-                   (repo ^. r_state . at ngramsType . _Just . at nodeId . _Just)
-getNgramsTableMap' :: HasNodeStory env err m
-                  => NodeId
-                  -> TableNgrams.NgramsType
-                  -> m (Versioned NgramsTableMap)
-getNgramsTableMap' nodeId ngramsType = do
   v    <- getRepoVar nodeId
   repo <- liftBase $ readMVar v
   pure $ Versioned (repo ^. unNodeStory . at nodeId . _Just . a_version)
                    (repo ^. unNodeStory . at nodeId . _Just . a_state . at ngramsType . _Just)
 
 
-dumpJsonTableMap :: RepoCmdM env err m
+dumpJsonTableMap :: HasNodeStory env err m
                  => Text
                  -> NodeId
                  -> TableNgrams.NgramsType
@@ -586,16 +463,6 @@ dumpJsonTableMap fpath nodeId ngramsType = do
   m <- getNgramsTableMap nodeId ngramsType
   liftBase $ DTL.writeFile (unpack fpath) (DAT.encodeToLazyText m)
   pure ()
-dumpJsonTableMap' :: HasNodeStory env err m
-                 => Text
-                 -> NodeId
-                 -> TableNgrams.NgramsType
-                 -> m ()
-dumpJsonTableMap' fpath nodeId ngramsType = do
-  m <- getNgramsTableMap' nodeId ngramsType
-  liftBase $ DTL.writeFile (unpack fpath) (DAT.encodeToLazyText m)
-  pure ()
-
 
 
 type MinSize = Int
@@ -608,7 +475,7 @@ type MaxSize = Int
 
 
 getTableNgrams :: forall env err m.
-                  (RepoCmdM env err m, HasNodeError err, HasConnectionPool env, HasConfig env)
+                  (HasNodeStory env err m, HasNodeError err, HasConnectionPool env, HasConfig env)
                => NodeType -> NodeId -> TabType
                -> ListId -> Limit -> Maybe Offset
                -> Maybe ListType
@@ -727,131 +594,11 @@ getTableNgrams _nType nId tabType listId limit_ offset
                           % "\n"
             ) t0 t3 t0 t1 t1 t2 t2 t3
   pure $ toVersionedWithCount fltrCount tableMap3
-getTableNgrams' :: forall env err m.
-                  (HasNodeStory env err m, HasNodeError err, HasConnectionPool env, HasConfig env)
-               => NodeType -> NodeId -> TabType
-               -> ListId -> Limit -> Maybe Offset
-               -> Maybe ListType
-               -> Maybe MinSize -> Maybe MaxSize
-               -> Maybe OrderBy
-               -> (NgramsTerm -> Bool)
-               -> m (VersionedWithCount NgramsTable)
-getTableNgrams' _nType nId tabType listId limit_ offset
-               listType minSize maxSize orderBy searchQuery = do
-
-  t0 <- getTime
-  -- lIds <- selectNodesWithUsername NodeList userMaster
-  let
-    ngramsType = ngramsTypeFromTabType tabType
-    offset'  = maybe 0 identity offset
-    listType' = maybe (const True) (==) listType
-    minSize'  = maybe (const True) (<=) minSize
-    maxSize'  = maybe (const True) (>=) maxSize
-
-    selected_node n = minSize'     s
-                   && maxSize'     s
-                   && searchQuery  (n ^. ne_ngrams)
-                   && listType'    (n ^. ne_list)
-      where
-        s = n ^. ne_size
-
-    selected_inner roots n = maybe False (`Set.member` roots) (n ^. ne_root)
-
-    ---------------------------------------
-    sortOnOrder Nothing = identity
-    sortOnOrder (Just TermAsc)   = List.sortOn $ view ne_ngrams
-    sortOnOrder (Just TermDesc)  = List.sortOn $ Down . view ne_ngrams
-    sortOnOrder (Just ScoreAsc)  = List.sortOn $ view ne_occurrences
-    sortOnOrder (Just ScoreDesc) = List.sortOn $ Down . view ne_occurrences
-
-    ---------------------------------------
-
-    filteredNodes :: Map NgramsTerm NgramsElement -> [NgramsElement]
-    filteredNodes tableMap = rootOf <$> list & filter selected_node
-      where
-        rootOf ne = maybe ne (\r -> fromMaybe (panic "getTableNgrams: invalid root")
-                                              (tableMap ^. at r)
-                             )
-                             (ne ^. ne_root)
-        list = tableMap ^.. each
-
-    ---------------------------------------
-    selectAndPaginate :: Map NgramsTerm NgramsElement -> [NgramsElement]
-    selectAndPaginate tableMap = roots <> inners
-      where
-        list = tableMap ^.. each
-        rootOf ne = maybe ne (\r -> fromMaybe (panic "getTableNgrams: invalid root")
-                                              (tableMap ^. at r)
-                             )
-                             (ne ^. ne_root)
-        selected_nodes = list & take limit_
-                              . drop offset'
-                              . filter selected_node
-                              . sortOnOrder orderBy
-        roots = rootOf <$> selected_nodes
-        rootsSet = Set.fromList (_ne_ngrams <$> roots)
-        inners = list & filter (selected_inner rootsSet)
-
-    ---------------------------------------
-    setScores :: forall t. Each t t NgramsElement NgramsElement => Bool -> t -> m t
-    setScores False table = pure table
-    setScores True  table = do
-      let ngrams_terms = table ^.. each . ne_ngrams
-      t1 <- getTime
-      occurrences <- getOccByNgramsOnlyFast' nId
-                                             listId
-                                            ngramsType
-                                            ngrams_terms
-      t2 <- getTime
-      liftBase $ hprint stderr
-        ("getTableNgrams/setScores #ngrams=" % int % " time=" % hasTime % "\n")
-        (length ngrams_terms) t1 t2
-      {-
-      occurrences <- getOccByNgramsOnlySlow nType nId
-                                            (lIds <> [listId])
-                                            ngramsType
-                                            ngrams_terms
-      -}
-      let
-        setOcc ne = ne & ne_occurrences .~ sumOf (at (ne ^. ne_ngrams) . _Just) occurrences
-
-      pure $ table & each %~ setOcc
-    ---------------------------------------
-
-  -- lists <- catMaybes <$> listsWith userMaster
-  -- trace (show lists) $
-  -- getNgramsTableMap ({-lists <>-} listIds) ngramsType
-
-
-  let scoresNeeded = needsScores orderBy
-  tableMap1 <- getNgramsTableMap' listId ngramsType
-  t1 <- getTime
-  tableMap2 <- tableMap1 & v_data %%~ setScores scoresNeeded
-                                    . Map.mapWithKey ngramsElementFromRepo
-
-  fltr <- tableMap2 & v_data %%~ fmap NgramsTable . setScores (not scoresNeeded)
-                                                  . filteredNodes
-  let fltrCount = length $ fltr ^. v_data . _NgramsTable
-
-  t2 <- getTime
-  tableMap3 <- tableMap2 & v_data %%~ fmap NgramsTable
-                                    . setScores (not scoresNeeded)
-                                    . selectAndPaginate
-  t3 <- getTime
-  liftBase $ hprint stderr
-            ("getTableNgrams total=" % hasTime
-                          % " map1=" % hasTime
-                          % " map2=" % hasTime
-                          % " map3=" % hasTime
-                          % " sql="  % (if scoresNeeded then "map2" else "map3")
-                          % "\n"
-            ) t0 t3 t0 t1 t1 t2 t2 t3
-  pure $ toVersionedWithCount fltrCount tableMap3
 
 
 
 scoresRecomputeTableNgrams :: forall env err m.
-  (RepoCmdM env err m, HasNodeError err, HasConnectionPool env, HasConfig env)
+  (HasNodeStory env err m, HasNodeError err, HasConnectionPool env, HasConfig env)
   => NodeId -> TabType -> ListId -> m Int
 scoresRecomputeTableNgrams nId tabType listId = do
   tableMap <- getNgramsTableMap listId ngramsType
@@ -873,29 +620,6 @@ scoresRecomputeTableNgrams nId tabType listId = do
         setOcc ne = ne & ne_occurrences .~ sumOf (at (ne ^. ne_ngrams) . _Just) occurrences
 
       pure $ table & each %~ setOcc
-scoresRecomputeTableNgrams' :: forall env err m.
-  (HasNodeStory env err m, HasNodeError err, HasConnectionPool env, HasConfig env)
-  => NodeId -> TabType -> ListId -> m Int
-scoresRecomputeTableNgrams' nId tabType listId = do
-  tableMap <- getNgramsTableMap' listId ngramsType
-  _ <- tableMap & v_data %%~ setScores
-                           . Map.mapWithKey ngramsElementFromRepo
-
-  pure $ 1
-  where
-    ngramsType = ngramsTypeFromTabType tabType
-
-    setScores :: forall t. Each t t NgramsElement NgramsElement => t -> m t
-    setScores table = do
-      let ngrams_terms = table ^.. each . ne_ngrams
-      occurrences <- getOccByNgramsOnlyFast' nId
-                                             listId
-                                            ngramsType
-                                            ngrams_terms
-      let
-        setOcc ne = ne & ne_occurrences .~ sumOf (at (ne ^. ne_ngrams) . _Just) occurrences
-
-      pure $ table & each %~ setOcc
 
 
 
@@ -969,7 +693,7 @@ type TableNgramsAsyncApi = Summary "Table Ngrams Async API"
                            :> "update"
                            :> AsyncJobs JobLog '[JSON] UpdateTableNgramsCharts JobLog
 
-getTableNgramsCorpus :: (RepoCmdM env err m, HasNodeError err, HasConnectionPool env, HasConfig env)
+getTableNgramsCorpus :: (HasNodeStory env err m, HasNodeError err, HasConnectionPool env, HasConfig env)
                => NodeId
                -> TabType
                -> ListId
@@ -984,36 +708,15 @@ getTableNgramsCorpus nId tabType listId limit_ offset listType minSize maxSize o
   getTableNgrams NodeCorpus nId tabType listId limit_ offset listType minSize maxSize orderBy searchQuery
     where
       searchQuery (NgramsTerm nt) = maybe (const True) isInfixOf mt nt
-getTableNgramsCorpus' :: (HasNodeStory env err m, HasNodeError err, HasConnectionPool env, HasConfig env)
-               => NodeId
-               -> TabType
-               -> ListId
-               -> Limit
-               -> Maybe Offset
-               -> Maybe ListType
-               -> Maybe MinSize -> Maybe MaxSize
-               -> Maybe OrderBy
-               -> Maybe Text -- full text search
-               -> m (VersionedWithCount NgramsTable)
-getTableNgramsCorpus' nId tabType listId limit_ offset listType minSize maxSize orderBy mt =
-  getTableNgrams' NodeCorpus nId tabType listId limit_ offset listType minSize maxSize orderBy searchQuery
-    where
-      searchQuery (NgramsTerm nt) = maybe (const True) isInfixOf mt nt
 
 
 
-getTableNgramsVersion :: (RepoCmdM env err m, HasNodeError err, HasConnectionPool env, HasConfig env)
-               => NodeId
-               -> TabType
-               -> ListId
-               -> m Version
-getTableNgramsVersion _nId _tabType _listId = currentVersion
-getTableNgramsVersion' :: (HasNodeStory env err m, HasNodeError err, HasConnectionPool env, HasConfig env)
+getTableNgramsVersion :: (HasNodeStory env err m, HasNodeError err, HasConnectionPool env, HasConfig env)
                => NodeId
                -> TabType
                -> ListId
                -> m Version
-getTableNgramsVersion' _nId _tabType listId = currentVersion' listId
+getTableNgramsVersion _nId _tabType listId = currentVersion listId
 
 
 
@@ -1024,7 +727,7 @@ getTableNgramsVersion' _nId _tabType listId = currentVersion' listId
 
 
 -- | Text search is deactivated for now for ngrams by doc only
-getTableNgramsDoc :: (RepoCmdM env err m, HasNodeError err, HasConnectionPool env, HasConfig env)
+getTableNgramsDoc :: (HasNodeStory env err m, HasNodeError err, HasConnectionPool env, HasConfig env)
                => DocId -> TabType
                -> ListId -> Limit -> Maybe Offset
                -> Maybe ListType
@@ -1038,21 +741,6 @@ getTableNgramsDoc dId tabType listId limit_ offset listType minSize maxSize orde
   ngs <- selectNgramsByDoc (ns <> [listId]) dId ngramsType
   let searchQuery (NgramsTerm nt) = flip S.member (S.fromList ngs) nt
   getTableNgrams NodeDocument dId tabType listId limit_ offset listType minSize maxSize orderBy searchQuery
-getTableNgramsDoc' :: (HasNodeStory env err m, HasNodeError err, HasConnectionPool env, HasConfig env)
-               => DocId -> TabType
-               -> ListId -> Limit -> Maybe Offset
-               -> Maybe ListType
-               -> Maybe MinSize -> Maybe MaxSize
-               -> Maybe OrderBy
-               -> Maybe Text -- full text search
-               -> m (VersionedWithCount NgramsTable)
-getTableNgramsDoc' dId tabType listId limit_ offset listType minSize maxSize orderBy _mt = do
-  ns <- selectNodesWithUsername NodeList userMaster
-  let ngramsType = ngramsTypeFromTabType tabType
-  ngs <- selectNgramsByDoc (ns <> [listId]) dId ngramsType
-  let searchQuery (NgramsTerm nt) = flip S.member (S.fromList ngs) nt
-  getTableNgrams' NodeDocument dId tabType listId limit_ offset listType minSize maxSize orderBy searchQuery
-
 
 
 
@@ -1097,19 +785,12 @@ apiNgramsAsync _dId =
 -- * currentVersion: good computation, good bandwidth, bad precision.
 -- * listNgramsChangedSince: good precision, good bandwidth, bad computation.
 -- * tableNgramsPull: good precision, good bandwidth (if you use the received data!), bad computation.
-listNgramsChangedSince :: RepoCmdM env err m
+listNgramsChangedSince :: HasNodeStory env err m
                        => ListId -> TableNgrams.NgramsType -> Version -> m (Versioned Bool)
 listNgramsChangedSince listId ngramsType version
   | version < 0 =
-      Versioned <$> currentVersion <*> pure True
+      Versioned <$> currentVersion listId <*> pure True
   | otherwise   =
       tableNgramsPull listId ngramsType version & mapped . v_data %~ (== mempty)
-listNgramsChangedSince' :: HasNodeStory env err m
-                       => ListId -> TableNgrams.NgramsType -> Version -> m (Versioned Bool)
-listNgramsChangedSince' listId ngramsType version
-  | version < 0 =
-      Versioned <$> currentVersion' listId <*> pure True
-  | otherwise   =
-      tableNgramsPull' listId ngramsType version & mapped . v_data %~ (== mempty)
 
 

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)
 
+
+
+