Commit 573c8096 authored by Alexandre Delanoë's avatar Alexandre Delanoë

[TOOLS] repoSize and renaming

parent 13c85c2f
Pipeline #2827 failed with stage
in 24 minutes and 43 seconds
# Contributing # Contributing
## Main repo ## Code contribution
https://gitlab.iscpif.fr/gargantext/haskell-gargantext We use Git to share and merge our code.
## Style
## Stack by default We are using the common Haskell Style:
https://github.com/tibbe/haskell-style-guide/blob/master/haskell-style.md
stack install ## Code Of Conduct
## REPL
stack ghci at the root of the project (it will load right paths of
static resources).
Be constructive as sharing our code of conduct
...@@ -261,7 +261,7 @@ setListNgrams listId ngramsType ns = do ...@@ -261,7 +261,7 @@ setListNgrams listId ngramsType ns = do
currentVersion :: HasNodeStory env err m currentVersion :: HasNodeStory env err m
=> ListId -> m Version => ListId -> m Version
currentVersion listId = do currentVersion listId = do
nls <- getRepo' [listId] nls <- getRepo [listId]
pure $ nls ^. unNodeStory . at listId . _Just . a_version pure $ nls ^. unNodeStory . at listId . _Just . a_version
......
...@@ -35,22 +35,26 @@ mergeNgramsElement _neOld neNew = neNew ...@@ -35,22 +35,26 @@ mergeNgramsElement _neOld neNew = neNew
type RootTerm = NgramsTerm type RootTerm = NgramsTerm
{-
getRepo :: RepoCmdM env err m => m NgramsRepo
getRepo = do
v <- view repoVar
liftBase $ readMVar v
-}
getRepo' :: HasNodeStory env err m getRepo :: HasNodeStory env err m
=> [ListId] -> m NodeListStory => [ListId] -> m NodeListStory
getRepo' listIds = do getRepo listIds = do
f <- getNodeListStory f <- getNodeListStory
v <- liftBase $ f listIds v <- liftBase $ f listIds
v' <- liftBase $ readMVar v v' <- liftBase $ readMVar v
pure $ v' pure $ v'
repoSize :: Ord k1 => NodeStory (Map.Map k1 (Map.Map k2 a)) p
-> NodeId
-> Map.Map k1 Int
repoSize repo node_id = Map.map Map.size state
where
state = repo ^. unNodeStory
. at node_id . _Just
. a_state
getNodeStoryVar :: HasNodeStory env err m getNodeStoryVar :: HasNodeStory env err m
=> [ListId] -> m (MVar NodeListStory) => [ListId] -> m (MVar NodeListStory)
getNodeStoryVar l = do getNodeStoryVar l = do
...@@ -83,8 +87,6 @@ listNgramsFromRepo nodeIds ngramsType repo = ...@@ -83,8 +87,6 @@ listNgramsFromRepo nodeIds ngramsType repo =
| nodeId <- nodeIds | nodeId <- nodeIds
] ]
-- TODO-ACCESS: We want to do the security check before entering here. -- TODO-ACCESS: We want to do the security check before entering here.
-- Add a static capability parameter would be nice. -- Add a static capability parameter would be nice.
-- Ideally this is the access to `repoVar` which needs to -- Ideally this is the access to `repoVar` which needs to
...@@ -93,7 +95,7 @@ getListNgrams :: HasNodeStory env err m ...@@ -93,7 +95,7 @@ getListNgrams :: HasNodeStory env err m
=> [ListId] -> NgramsType => [ListId] -> NgramsType
-> m (HashMap NgramsTerm NgramsRepoElement) -> m (HashMap NgramsTerm NgramsRepoElement)
getListNgrams nodeIds ngramsType = listNgramsFromRepo nodeIds ngramsType getListNgrams nodeIds ngramsType = listNgramsFromRepo nodeIds ngramsType
<$> getRepo' nodeIds <$> getRepo nodeIds
getTermsWith :: (HasNodeStory env err m, Eq a, Hashable a) getTermsWith :: (HasNodeStory env err m, Eq a, Hashable a)
...@@ -105,7 +107,7 @@ getTermsWith f ls ngt lts = HM.fromListWith (<>) ...@@ -105,7 +107,7 @@ getTermsWith f ls ngt lts = HM.fromListWith (<>)
<$> HM.toList <$> HM.toList
<$> HM.filter (\f' -> Set.member (fst f') lts) <$> HM.filter (\f' -> Set.member (fst f') lts)
<$> mapTermListRoot ls ngt <$> mapTermListRoot ls ngt
<$> getRepo' ls <$> getRepo ls
where where
toTreeWith (t, (_lt, maybeRoot)) = case maybeRoot of toTreeWith (t, (_lt, maybeRoot)) = case maybeRoot of
Nothing -> (f t, []) Nothing -> (f t, [])
......
...@@ -28,7 +28,7 @@ import qualified Data.HashMap.Strict as HashMap ...@@ -28,7 +28,7 @@ import qualified Data.HashMap.Strict as HashMap
import Gargantext.API.Node.Corpus.Export.Types import Gargantext.API.Node.Corpus.Export.Types
import qualified Gargantext.API.Node.Document.Export.Types as DocumentExport import qualified Gargantext.API.Node.Document.Export.Types as DocumentExport
import Gargantext.API.Ngrams.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.API.Prelude (GargNoServer)
import Gargantext.Prelude.Crypto.Hash (hash) import Gargantext.Prelude.Crypto.Hash (hash)
import Gargantext.Core.Types import Gargantext.Core.Types
...@@ -66,7 +66,7 @@ getCorpus cId lId nt' = do ...@@ -66,7 +66,7 @@ getCorpus cId lId nt' = do
<$> map (\n -> (_context_id n, n)) <$> map (\n -> (_context_id n, n))
<$> selectDocNodes cId <$> selectDocNodes cId
repo <- getRepo' [listId] repo <- getRepo [listId]
ngs <- getContextNgrams cId listId MapTerm nt repo ngs <- getContextNgrams cId listId MapTerm nt repo
let -- uniqId is hash computed already for each document imported in database let -- uniqId is hash computed already for each document imported in database
r = Map.intersectionWith r = Map.intersectionWith
......
...@@ -168,5 +168,5 @@ getHistory :: ( HasNodeStory env err m ...@@ -168,5 +168,5 @@ getHistory :: ( HasNodeStory env err m
-> [ListId] -> [ListId]
-> m (Map ListId (Map NgramsType [HashMap NgramsTerm NgramsPatch])) -> m (Map ListId (Map NgramsType [HashMap NgramsTerm NgramsPatch]))
getHistory hist nt listes = getHistory hist nt listes =
history hist [nt] listes <$> getRepo' listes history hist [nt] listes <$> getRepo listes
...@@ -59,7 +59,7 @@ chartData :: FlowCmdM env err m ...@@ -59,7 +59,7 @@ chartData :: FlowCmdM env err m
chartData cId nt lt = do chartData cId nt lt = do
ls' <- selectNodesWithUsername NodeList userMaster ls' <- selectNodesWithUsername NodeList userMaster
ls <- map (_node_id) <$> getListsWithParentId cId ls <- map (_node_id) <$> getListsWithParentId cId
ts <- mapTermListRoot ls nt <$> getRepo' ls ts <- mapTermListRoot ls nt <$> getRepo ls
let let
dico = filterListWithRoot [lt] ts dico = filterListWithRoot [lt] ts
terms = catMaybes $ List.concat $ map (\(a,b) -> [Just a, b]) $ HashMap.toList dico terms = catMaybes $ List.concat $ map (\(a,b) -> [Just a, b]) $ HashMap.toList dico
...@@ -83,7 +83,7 @@ treeData :: FlowCmdM env err m ...@@ -83,7 +83,7 @@ treeData :: FlowCmdM env err m
treeData cId nt lt = do treeData cId nt lt = do
ls' <- selectNodesWithUsername NodeList userMaster ls' <- selectNodesWithUsername NodeList userMaster
ls <- map (_node_id) <$> getListsWithParentId cId ls <- map (_node_id) <$> getListsWithParentId cId
ts <- mapTermListRoot ls nt <$> getRepo' ls ts <- mapTermListRoot ls nt <$> getRepo ls
let let
dico = filterListWithRoot [lt] ts dico = filterListWithRoot [lt] ts
......
...@@ -96,7 +96,7 @@ getGraph _uId nId = do ...@@ -96,7 +96,7 @@ getGraph _uId nId = do
-- printDebug "[getGraph] getting list for cId" cId -- printDebug "[getGraph] getting list for cId" cId
listId <- defaultList cId listId <- defaultList cId
repo <- getRepo' [listId] repo <- getRepo [listId]
-- TODO Distance in Graph params -- TODO Distance in Graph params
case graph of case graph of
...@@ -142,7 +142,7 @@ recomputeGraph _uId nId method maybeDistance force = do ...@@ -142,7 +142,7 @@ recomputeGraph _uId nId method maybeDistance force = do
let cId = maybe (panic "[G.V.G.API] Node has no parent") identity mcId let cId = maybe (panic "[G.V.G.API] Node has no parent") identity mcId
listId <- defaultList cId listId <- defaultList cId
repo <- getRepo' [listId] repo <- getRepo [listId]
let v = repo ^. unNodeStory . at listId . _Just . a_version let v = repo ^. unNodeStory . at listId . _Just . a_version
let computeG mt = do let computeG mt = do
...@@ -286,7 +286,7 @@ graphVersions n nId = do ...@@ -286,7 +286,7 @@ graphVersions n nId = do
else panic "[G.V.G.API] list not found after iterations" else panic "[G.V.G.API] list not found after iterations"
Just listId -> do Just listId -> do
repo <- getRepo' [listId] repo <- getRepo [listId]
let v = repo ^. unNodeStory . at listId . _Just . a_version let v = repo ^. unNodeStory . at listId . _Just . a_version
-- printDebug "graphVersions" v -- printDebug "graphVersions" v
......
...@@ -21,7 +21,7 @@ import Data.Text (Text, pack) ...@@ -21,7 +21,7 @@ import Data.Text (Text, pack)
import Data.Time.Calendar (fromGregorian, diffGregorianDurationClip, cdMonths, diffDays, showGregorian) import Data.Time.Calendar (fromGregorian, diffGregorianDurationClip, cdMonths, diffDays, showGregorian)
import Data.Time.Clock.POSIX(posixSecondsToUTCTime) import Data.Time.Clock.POSIX(posixSecondsToUTCTime)
import Gargantext.API.Ngrams.Prelude (getTermList) import Gargantext.API.Ngrams.Prelude (getTermList)
import Gargantext.API.Ngrams.Tools (getRepo') import Gargantext.API.Ngrams.Tools (getRepo)
import Gargantext.API.Ngrams.Types (NgramsTerm(..)) import Gargantext.API.Ngrams.Types (NgramsTerm(..))
import Gargantext.API.Node.Corpus.Export (getContextNgrams) import Gargantext.API.Node.Corpus.Export (getContextNgrams)
import Gargantext.API.Prelude (GargNoServer) import Gargantext.API.Prelude (GargNoServer)
...@@ -96,7 +96,7 @@ corpusIdtoDocuments :: TimeUnit -> CorpusId -> GargNoServer (TermList, [Document ...@@ -96,7 +96,7 @@ corpusIdtoDocuments :: TimeUnit -> CorpusId -> GargNoServer (TermList, [Document
corpusIdtoDocuments timeUnit corpusId = do corpusIdtoDocuments timeUnit corpusId = do
docs <- selectDocNodes corpusId docs <- selectDocNodes corpusId
lId <- defaultList corpusId lId <- defaultList corpusId
repo <- getRepo' [lId] repo <- getRepo [lId]
ngs_terms <- getContextNgrams corpusId lId MapTerm NgramsTerms repo ngs_terms <- getContextNgrams corpusId lId MapTerm NgramsTerms repo
ngs_sources <- getContextNgrams corpusId lId MapTerm Sources repo ngs_sources <- getContextNgrams corpusId lId MapTerm Sources repo
......
...@@ -190,7 +190,7 @@ getNgramsDocId :: CorpusId ...@@ -190,7 +190,7 @@ getNgramsDocId :: CorpusId
-> GargNoServer (HashMap DocAuthor (Set NodeId)) -> GargNoServer (HashMap DocAuthor (Set NodeId))
getNgramsDocId cId lId nt = do getNgramsDocId cId lId nt = do
lIds <- selectNodesWithUsername NodeList userMaster lIds <- selectNodesWithUsername NodeList userMaster
repo <- getRepo' (lId:lIds) repo <- getRepo (lId:lIds)
let ngs = filterListWithRoot [MapTerm, CandidateTerm] $ mapTermListRoot (lId:lIds) nt repo let ngs = filterListWithRoot [MapTerm, CandidateTerm] $ mapTermListRoot (lId:lIds) nt repo
-- printDebug "getNgramsDocId" ngs -- printDebug "getNgramsDocId" ngs
......
...@@ -23,7 +23,7 @@ import Database.PostgreSQL.Simple (Query, Only(..)) ...@@ -23,7 +23,7 @@ import Database.PostgreSQL.Simple (Query, Only(..))
import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..)) import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..))
import Data.Vector (Vector) import Data.Vector (Vector)
import Gargantext.Core (HasDBid(toDBid)) import Gargantext.Core (HasDBid(toDBid))
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.Database.Prelude (runPGSQuery{-, formatPGSQuery-}) import Gargantext.Database.Prelude (runPGSQuery{-, formatPGSQuery-})
import Gargantext.API.Ngrams.Types (TabType(..), ngramsTypeFromTabType, NgramsTerm(..)) import Gargantext.API.Ngrams.Types (TabType(..), ngramsTypeFromTabType, NgramsTerm(..))
import Gargantext.Core.Mail.Types (HasMail) import Gargantext.Core.Mail.Types (HasMail)
...@@ -233,7 +233,7 @@ getNgrams :: (HasMail env, HasNodeStory env err m) ...@@ -233,7 +233,7 @@ getNgrams :: (HasMail env, HasNodeStory env err m)
) )
getNgrams lId tabType = do getNgrams lId tabType = do
lists <- mapTermListRoot [lId] (ngramsTypeFromTabType tabType) <$> getRepo' [lId] lists <- mapTermListRoot [lId] (ngramsTypeFromTabType tabType) <$> getRepo [lId]
-- TODO filterListWithRoot [MapTerm, StopTerm, CandidateTerm] lists -- TODO filterListWithRoot [MapTerm, StopTerm, CandidateTerm] lists
let maybeSyn = HM.unions $ map (\t -> filterListWithRoot t lists) let maybeSyn = HM.unions $ map (\t -> filterListWithRoot t lists)
[[MapTerm], [StopTerm], [CandidateTerm]] [[MapTerm], [StopTerm], [CandidateTerm]]
......
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