Commit 4e134509 authored by Alexandre Delanoë's avatar Alexandre Delanoë

[NAMING] Repo -> NodeStory

parent f05e7b07
Pipeline #1750 passed with stage
in 31 minutes and 47 seconds
...@@ -43,7 +43,7 @@ import GHC.Generics (Generic) ...@@ -43,7 +43,7 @@ import GHC.Generics (Generic)
import Gargantext.API.Admin.Auth.Types (AuthContext) import Gargantext.API.Admin.Auth.Types (AuthContext)
import Gargantext.API.Admin.Settings (newEnv) import Gargantext.API.Admin.Settings (newEnv)
import Gargantext.API.Admin.Types (FireWall(..), PortNumber, cookieSettings, jwtSettings, settings) import Gargantext.API.Admin.Types (FireWall(..), PortNumber, cookieSettings, jwtSettings, settings)
import Gargantext.API.Ngrams (saveRepo) import Gargantext.API.Ngrams (saveNodeStory)
import Gargantext.API.Prelude import Gargantext.API.Prelude
import Gargantext.API.Routes import Gargantext.API.Routes
import Gargantext.API.Server (server) import Gargantext.API.Server (server)
...@@ -80,7 +80,7 @@ portRouteInfo port = do ...@@ -80,7 +80,7 @@ portRouteInfo port = do
stopGargantext :: HasNodeStorySaver env => env -> IO () stopGargantext :: HasNodeStorySaver env => env -> IO ()
stopGargantext env = do stopGargantext env = do
putStrLn "----- Stopping gargantext -----" putStrLn "----- Stopping gargantext -----"
runReaderT saveRepo env runReaderT saveNodeStory env
{- {-
startGargantextMock :: PortNumber -> IO () startGargantextMock :: PortNumber -> IO ()
......
...@@ -17,7 +17,7 @@ import Control.Monad (fail) ...@@ -17,7 +17,7 @@ import Control.Monad (fail)
import Control.Monad.Reader (runReaderT) import Control.Monad.Reader (runReaderT)
import Gargantext.API.Admin.EnvTypes import Gargantext.API.Admin.EnvTypes
import Gargantext.API.Admin.Settings import Gargantext.API.Admin.Settings
import Gargantext.API.Ngrams (saveRepo) import Gargantext.API.Ngrams (saveNodeStory)
import Gargantext.API.Prelude import Gargantext.API.Prelude
import Gargantext.Core.NodeStory import Gargantext.Core.NodeStory
import Gargantext.Database.Prelude import Gargantext.Database.Prelude
...@@ -64,7 +64,7 @@ runCmdDev :: (Show err) => DevEnv -> Cmd'' DevEnv err a -> IO a ...@@ -64,7 +64,7 @@ runCmdDev :: (Show err) => DevEnv -> Cmd'' DevEnv err a -> IO a
runCmdDev env f = runCmdDev env f =
(either (fail . show) pure =<< runCmd env f) (either (fail . show) pure =<< runCmd env f)
`finally` `finally`
runReaderT saveRepo env runReaderT saveNodeStory env
runCmdDevNoErr :: DevEnv -> Cmd' DevEnv () a -> IO a runCmdDevNoErr :: DevEnv -> Cmd' DevEnv () a -> IO a
runCmdDevNoErr = runCmdDev runCmdDevNoErr = runCmdDev
......
...@@ -54,7 +54,7 @@ module Gargantext.API.Ngrams ...@@ -54,7 +54,7 @@ module Gargantext.API.Ngrams
, r_history , r_history
, NgramsRepo , NgramsRepo
, NgramsRepoElement(..) , NgramsRepoElement(..)
, saveRepo , saveNodeStory
, initRepo , initRepo
, RepoEnv(..) , RepoEnv(..)
...@@ -178,9 +178,9 @@ mkChildrenGroups addOrRem nt patches = ...@@ -178,9 +178,9 @@ mkChildrenGroups addOrRem nt patches =
------------------------------------------------------------------------ ------------------------------------------------------------------------
saveRepo :: ( MonadReader env m, MonadBase IO m, HasNodeStorySaver env ) saveNodeStory :: ( MonadReader env m, MonadBase IO m, HasNodeStorySaver env )
=> m () => m ()
saveRepo = liftBase =<< view hasNodeStorySaver saveNodeStory = liftBase =<< view hasNodeStorySaver
listTypeConflictResolution :: ListType -> ListType -> ListType listTypeConflictResolution :: ListType -> ListType -> ListType
...@@ -217,7 +217,7 @@ copyListNgrams srcListId dstListId ngramsType = do ...@@ -217,7 +217,7 @@ copyListNgrams srcListId dstListId ngramsType = do
var <- view repoVar var <- view repoVar
liftBase $ modifyMVar_ var $ liftBase $ modifyMVar_ var $
pure . (r_state . at ngramsType %~ (Just . f . something)) pure . (r_state . at ngramsType %~ (Just . f . something))
saveRepo saveNodeStory
where where
f :: Map NodeId NgramsTableMap -> Map NodeId NgramsTableMap f :: Map NodeId NgramsTableMap -> Map NodeId NgramsTableMap
f m = m & at dstListId %~ insertNewOnly (m ^. at srcListId) f m = m & at dstListId %~ insertNewOnly (m ^. at srcListId)
...@@ -232,7 +232,7 @@ addListNgrams listId ngramsType nes = do ...@@ -232,7 +232,7 @@ addListNgrams listId ngramsType nes = do
var <- view repoVar var <- view repoVar
liftBase $ modifyMVar_ var $ liftBase $ modifyMVar_ var $
pure . (r_state . at ngramsType . _Just . at listId . _Just <>~ m) pure . (r_state . at ngramsType . _Just . at listId . _Just <>~ m)
saveRepo saveNodeStory
where where
m = Map.fromList $ (\n -> (n ^. ne_ngrams, n)) <$> nes m = Map.fromList $ (\n -> (n ^. ne_ngrams, n)) <$> nes
-} -}
...@@ -257,7 +257,7 @@ setListNgrams listId ngramsType ns = do ...@@ -257,7 +257,7 @@ setListNgrams listId ngramsType ns = do
. at ngramsType . at ngramsType
.~ Just ns .~ Just ns
) )
saveRepo saveNodeStory
currentVersion :: HasNodeStory env err m currentVersion :: HasNodeStory env err m
...@@ -286,7 +286,7 @@ commitStatePatch :: HasNodeStory env err m ...@@ -286,7 +286,7 @@ commitStatePatch :: HasNodeStory env err m
-> m (Versioned NgramsStatePatch') -> m (Versioned NgramsStatePatch')
commitStatePatch listId (Versioned p_version p) = do commitStatePatch listId (Versioned p_version p) = do
printDebug "[commitStatePatch]" listId printDebug "[commitStatePatch]" listId
var <- getRepoVar [listId] var <- getNodeStoryVar [listId]
vq' <- liftBase $ modifyMVar var $ \ns -> do vq' <- liftBase $ modifyMVar var $ \ns -> do
let let
a = ns ^. unNodeStory . at listId . _Just a = ns ^. unNodeStory . at listId . _Just
...@@ -312,7 +312,7 @@ commitStatePatch listId (Versioned p_version p) = do ...@@ -312,7 +312,7 @@ commitStatePatch listId (Versioned p_version p) = do
pure ( ns & unNodeStory . at listId .~ (Just a') pure ( ns & unNodeStory . at listId .~ (Just a')
, Versioned (a' ^. a_version) q' , Versioned (a' ^. a_version) q'
) )
saveRepo saveNodeStory
-- Save new ngrams -- Save new ngrams
_ <- insertNgrams (newNgramsFromNgramsStatePatch p) _ <- insertNgrams (newNgramsFromNgramsStatePatch p)
...@@ -328,7 +328,7 @@ tableNgramsPull :: HasNodeStory env err m ...@@ -328,7 +328,7 @@ tableNgramsPull :: HasNodeStory env err m
-> m (Versioned NgramsTablePatch) -> m (Versioned NgramsTablePatch)
tableNgramsPull listId ngramsType p_version = do tableNgramsPull listId ngramsType p_version = do
printDebug "[tableNgramsPull]" (listId, ngramsType) printDebug "[tableNgramsPull]" (listId, ngramsType)
var <- getRepoVar [listId] var <- getNodeStoryVar [listId]
r <- liftBase $ readMVar var r <- liftBase $ readMVar var
let let
...@@ -467,7 +467,7 @@ getNgramsTableMap :: HasNodeStory env err m ...@@ -467,7 +467,7 @@ getNgramsTableMap :: HasNodeStory env err m
-> TableNgrams.NgramsType -> TableNgrams.NgramsType
-> m (Versioned NgramsTableMap) -> m (Versioned NgramsTableMap)
getNgramsTableMap nodeId ngramsType = do getNgramsTableMap nodeId ngramsType = do
v <- getRepoVar [nodeId] v <- getNodeStoryVar [nodeId]
repo <- liftBase $ readMVar v repo <- liftBase $ readMVar v
pure $ Versioned (repo ^. unNodeStory . at nodeId . _Just . a_version) pure $ Versioned (repo ^. unNodeStory . at nodeId . _Just . a_version)
(repo ^. unNodeStory . at nodeId . _Just . a_state . at ngramsType . _Just) (repo ^. unNodeStory . at nodeId . _Just . a_state . at ngramsType . _Just)
......
...@@ -51,9 +51,9 @@ getRepo' listIds = do ...@@ -51,9 +51,9 @@ getRepo' listIds = do
pure $ v' pure $ v'
getRepoVar :: HasNodeStory env err m getNodeStoryVar :: HasNodeStory env err m
=> [ListId] -> m (MVar NodeListStory) => [ListId] -> m (MVar NodeListStory)
getRepoVar l = do getNodeStoryVar l = do
f <- getNodeListStory f <- getNodeListStory
v <- liftBase $ f l v <- liftBase $ f l
pure v pure v
......
...@@ -220,7 +220,7 @@ buildNgramsTermsList user uCid mCid groupParams (nt, _mapListSize)= do ...@@ -220,7 +220,7 @@ buildNgramsTermsList user uCid mCid groupParams (nt, _mapListSize)= do
$ setScoresWithMap mapTextDocIds (groupedMonoHead <> groupedMultHead) $ setScoresWithMap mapTextDocIds (groupedMonoHead <> groupedMultHead)
printDebug "groupedTreeScores_SetNodeId" groupedTreeScores_SetNodeId --printDebug "groupedTreeScores_SetNodeId" groupedTreeScores_SetNodeId
-- Coocurrences computation -- Coocurrences computation
--, t1 >= t2 -- permute byAxis diag -- since matrix symmetric --, t1 >= t2 -- permute byAxis diag -- since matrix symmetric
......
...@@ -23,8 +23,8 @@ import Control.Monad.Reader ...@@ -23,8 +23,8 @@ import Control.Monad.Reader
import Data.Map (Map, toList) import Data.Map (Map, toList)
import Data.Maybe (catMaybes) import Data.Maybe (catMaybes)
import Data.Text (Text) import Data.Text (Text)
import Gargantext.API.Ngrams (saveRepo) import Gargantext.API.Ngrams (saveNodeStory)
import Gargantext.API.Ngrams.Tools (getRepoVar) import Gargantext.API.Ngrams.Tools (getNodeStoryVar)
import Gargantext.API.Ngrams.Types import Gargantext.API.Ngrams.Types
import Gargantext.Core.Types (HasInvalidError(..), assertValid) import Gargantext.Core.Types (HasInvalidError(..), assertValid)
import Gargantext.Core.Types.Main (ListType(CandidateTerm)) import Gargantext.Core.Types.Main (ListType(CandidateTerm))
...@@ -138,8 +138,6 @@ listInsert lId ngs = mapM_ (\(typeList, ngElmts) ...@@ -138,8 +138,6 @@ listInsert lId ngs = mapM_ (\(typeList, ngElmts)
------------------------------------------------------------------------ ------------------------------------------------------------------------
------------------------------------------------------------------------ ------------------------------------------------------------------------
-- NOTE -- NOTE
-- This is no longer part of the API. -- This is no longer part of the API.
-- This function is maintained for its usage in Database.Action.Flow.List. -- This function is maintained for its usage in Database.Action.Flow.List.
...@@ -155,34 +153,33 @@ putListNgrams nodeId ngramsType nes = putListNgrams' nodeId ngramsType m ...@@ -155,34 +153,33 @@ putListNgrams nodeId ngramsType nes = putListNgrams' nodeId ngramsType m
where where
m = Map.fromList $ map (\n -> (n ^. ne_ngrams, ngramsElementToRepo n)) nes m = Map.fromList $ map (\n -> (n ^. ne_ngrams, ngramsElementToRepo n)) nes
putListNgrams' :: (HasInvalidError err, HasNodeStory env err m) putListNgrams' :: (HasInvalidError err, HasNodeStory env err m)
=> NodeId => NodeId
-> TableNgrams.NgramsType -> TableNgrams.NgramsType
-> Map NgramsTerm NgramsRepoElement -> Map NgramsTerm NgramsRepoElement
-> m () -> m ()
putListNgrams' listId ngramsType ns = do putListNgrams' listId ngramsType' ns = do
-- printDebug "[putListNgrams'] nodeId" nodeId -- printDebug "[putListNgrams'] nodeId" nodeId
-- printDebug "[putListNgrams'] ngramsType" ngramsType -- printDebug "[putListNgrams'] ngramsType" ngramsType
-- printDebug "[putListNgrams'] ns" ns -- printDebug "[putListNgrams'] ns" ns
let p1 = NgramsTablePatch . PM.fromMap $ NgramsReplace Nothing . Just <$> ns let p1 = NgramsTablePatch . PM.fromMap $ NgramsReplace Nothing . Just <$> ns
(p, p_validity) = PM.singleton ngramsType p1 (p, p_validity) = PM.singleton ngramsType' p1
assertValid p_validity assertValid p_validity
{- {-
-- TODO -- TODO
v <- currentVersion v <- currentVersion
q <- commitStatePatch (Versioned v p) q <- commitStatePatch (Versioned v p)
assert empty q assert empty q
-- What if another commit comes in between? -- What if another commit comes in between?
-- Shall we have a blindCommitStatePatch? It would not ask for a version but just a patch. -- Shall we have a blindCommitStatePatch? It would not ask for a version but just a patch.
-- The modifyMVar_ would test the patch with applicable first. -- The modifyMVar_ would test the patch with applicable first.
-- If valid the rest would be atomic and no merge is required. -- If valid the rest would be atomic and no merge is required.
-} -}
var <- getRepoVar [listId] var <- getNodeStoryVar [listId]
liftBase $ modifyMVar_ var $ \r -> do liftBase $ modifyMVar_ var $ \r -> do
pure $ r & unNodeStory . at listId . _Just . a_version +~ 1 pure $ r & unNodeStory . at listId . _Just . a_version +~ 1
& unNodeStory . at listId . _Just . a_history %~ (p :) & unNodeStory . at listId . _Just . a_history %~ (p :)
& unNodeStory . at listId . _Just . a_state . at ngramsType .~ Just ns & unNodeStory . at listId . _Just . a_state . at ngramsType' .~ Just ns
saveRepo saveNodeStory
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment