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)
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 (saveNodeStory)
import Gargantext.API.Prelude
import Gargantext.API.Routes
import Gargantext.API.Server (server)
......@@ -80,7 +80,7 @@ portRouteInfo port = do
stopGargantext :: HasNodeStorySaver env => env -> IO ()
stopGargantext env = do
putStrLn "----- Stopping gargantext -----"
runReaderT saveRepo env
runReaderT saveNodeStory env
{-
startGargantextMock :: PortNumber -> IO ()
......
......@@ -17,7 +17,7 @@ import Control.Monad (fail)
import Control.Monad.Reader (runReaderT)
import Gargantext.API.Admin.EnvTypes
import Gargantext.API.Admin.Settings
import Gargantext.API.Ngrams (saveRepo)
import Gargantext.API.Ngrams (saveNodeStory)
import Gargantext.API.Prelude
import Gargantext.Core.NodeStory
import Gargantext.Database.Prelude
......@@ -64,7 +64,7 @@ runCmdDev :: (Show err) => DevEnv -> Cmd'' DevEnv err a -> IO a
runCmdDev env f =
(either (fail . show) pure =<< runCmd env f)
`finally`
runReaderT saveRepo env
runReaderT saveNodeStory env
runCmdDevNoErr :: DevEnv -> Cmd' DevEnv () a -> IO a
runCmdDevNoErr = runCmdDev
......
......@@ -54,7 +54,7 @@ module Gargantext.API.Ngrams
, r_history
, NgramsRepo
, NgramsRepoElement(..)
, saveRepo
, saveNodeStory
, initRepo
, RepoEnv(..)
......@@ -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 ()
saveRepo = liftBase =<< view hasNodeStorySaver
saveNodeStory = liftBase =<< view hasNodeStorySaver
listTypeConflictResolution :: ListType -> ListType -> ListType
......@@ -217,7 +217,7 @@ copyListNgrams srcListId dstListId ngramsType = do
var <- view repoVar
liftBase $ modifyMVar_ var $
pure . (r_state . at ngramsType %~ (Just . f . something))
saveRepo
saveNodeStory
where
f :: Map NodeId NgramsTableMap -> Map NodeId NgramsTableMap
f m = m & at dstListId %~ insertNewOnly (m ^. at srcListId)
......@@ -232,7 +232,7 @@ addListNgrams listId ngramsType nes = do
var <- view repoVar
liftBase $ modifyMVar_ var $
pure . (r_state . at ngramsType . _Just . at listId . _Just <>~ m)
saveRepo
saveNodeStory
where
m = Map.fromList $ (\n -> (n ^. ne_ngrams, n)) <$> nes
-}
......@@ -257,7 +257,7 @@ setListNgrams listId ngramsType ns = do
. at ngramsType
.~ Just ns
)
saveRepo
saveNodeStory
currentVersion :: HasNodeStory env err m
......@@ -286,7 +286,7 @@ commitStatePatch :: HasNodeStory env err m
-> m (Versioned NgramsStatePatch')
commitStatePatch listId (Versioned p_version p) = do
printDebug "[commitStatePatch]" listId
var <- getRepoVar [listId]
var <- getNodeStoryVar [listId]
vq' <- liftBase $ modifyMVar var $ \ns -> do
let
a = ns ^. unNodeStory . at listId . _Just
......@@ -312,7 +312,7 @@ commitStatePatch listId (Versioned p_version p) = do
pure ( ns & unNodeStory . at listId .~ (Just a')
, Versioned (a' ^. a_version) q'
)
saveRepo
saveNodeStory
-- Save new ngrams
_ <- insertNgrams (newNgramsFromNgramsStatePatch p)
......@@ -328,7 +328,7 @@ tableNgramsPull :: HasNodeStory env err m
-> m (Versioned NgramsTablePatch)
tableNgramsPull listId ngramsType p_version = do
printDebug "[tableNgramsPull]" (listId, ngramsType)
var <- getRepoVar [listId]
var <- getNodeStoryVar [listId]
r <- liftBase $ readMVar var
let
......@@ -467,7 +467,7 @@ getNgramsTableMap :: HasNodeStory env err m
-> TableNgrams.NgramsType
-> m (Versioned NgramsTableMap)
getNgramsTableMap nodeId ngramsType = do
v <- getRepoVar [nodeId]
v <- getNodeStoryVar [nodeId]
repo <- liftBase $ readMVar v
pure $ Versioned (repo ^. unNodeStory . at nodeId . _Just . a_version)
(repo ^. unNodeStory . at nodeId . _Just . a_state . at ngramsType . _Just)
......
......@@ -51,9 +51,9 @@ getRepo' listIds = do
pure $ v'
getRepoVar :: HasNodeStory env err m
getNodeStoryVar :: HasNodeStory env err m
=> [ListId] -> m (MVar NodeListStory)
getRepoVar l = do
getNodeStoryVar l = do
f <- getNodeListStory
v <- liftBase $ f l
pure v
......
......@@ -220,7 +220,7 @@ buildNgramsTermsList user uCid mCid groupParams (nt, _mapListSize)= do
$ setScoresWithMap mapTextDocIds (groupedMonoHead <> groupedMultHead)
printDebug "groupedTreeScores_SetNodeId" groupedTreeScores_SetNodeId
--printDebug "groupedTreeScores_SetNodeId" groupedTreeScores_SetNodeId
-- Coocurrences computation
--, t1 >= t2 -- permute byAxis diag -- since matrix symmetric
......
......@@ -23,8 +23,8 @@ import Control.Monad.Reader
import Data.Map (Map, toList)
import Data.Maybe (catMaybes)
import Data.Text (Text)
import Gargantext.API.Ngrams (saveRepo)
import Gargantext.API.Ngrams.Tools (getRepoVar)
import Gargantext.API.Ngrams (saveNodeStory)
import Gargantext.API.Ngrams.Tools (getNodeStoryVar)
import Gargantext.API.Ngrams.Types
import Gargantext.Core.Types (HasInvalidError(..), assertValid)
import Gargantext.Core.Types.Main (ListType(CandidateTerm))
......@@ -138,8 +138,6 @@ listInsert lId ngs = mapM_ (\(typeList, ngElmts)
------------------------------------------------------------------------
------------------------------------------------------------------------
-- NOTE
-- This is no longer part of the API.
-- This function is maintained for its usage in Database.Action.Flow.List.
......@@ -155,34 +153,33 @@ putListNgrams nodeId ngramsType nes = putListNgrams' nodeId ngramsType m
where
m = Map.fromList $ map (\n -> (n ^. ne_ngrams, ngramsElementToRepo n)) nes
putListNgrams' :: (HasInvalidError err, HasNodeStory env err m)
=> NodeId
-> TableNgrams.NgramsType
-> Map NgramsTerm NgramsRepoElement
-> m ()
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
(p, p_validity) = PM.singleton ngramsType p1
assertValid p_validity
{-
-- TODO
v <- currentVersion
q <- commitStatePatch (Versioned v p)
assert empty q
-- What if another commit comes in between?
-- 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.
-- If valid the rest would be atomic and no merge is required.
-}
var <- getRepoVar [listId]
liftBase $ modifyMVar_ var $ \r -> do
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
putListNgrams' :: (HasInvalidError err, HasNodeStory env err m)
=> NodeId
-> TableNgrams.NgramsType
-> Map NgramsTerm NgramsRepoElement
-> m ()
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
(p, p_validity) = PM.singleton ngramsType' p1
assertValid p_validity
{-
-- TODO
v <- currentVersion
q <- commitStatePatch (Versioned v p)
assert empty q
-- What if another commit comes in between?
-- 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.
-- If valid the rest would be atomic and no merge is required.
-}
var <- getNodeStoryVar [listId]
liftBase $ modifyMVar_ var $ \r -> do
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
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