Commit bb2042f3 authored by Alexandre Delanoë's avatar Alexandre Delanoë

[FLOW] Clean / factor.

parent 173ac7db
...@@ -33,9 +33,10 @@ import qualified Data.Set as Set ...@@ -33,9 +33,10 @@ import qualified Data.Set as Set
type RootTerm = Text type RootTerm = Text
getListNgrams :: RepoCmdM env err m getListNgrams :: RepoCmdM env err m
=> [ListId] -> NgramsType => [ListId] -> NgramsType
-> m (Map Text (ListType, (Maybe Text))) -> m (Map Text NgramsRepoElement)
getListNgrams nodeIds ngramsType = do getListNgrams nodeIds ngramsType = do
v <- view repoVar v <- view repoVar
repo <- liftIO $ readMVar v repo <- liftIO $ readMVar v
...@@ -46,12 +47,16 @@ getListNgrams nodeIds ngramsType = do ...@@ -46,12 +47,16 @@ getListNgrams nodeIds ngramsType = do
ngrams = Map.unionsWith mergeNgramsElement ngrams = Map.unionsWith mergeNgramsElement
[ ngramsMap ^. at nodeId . _Just | nodeId <- nodeIds ] [ ngramsMap ^. at nodeId . _Just | nodeId <- nodeIds ]
mapTermListRoot = Map.fromList pure ngrams
[(t, (_nre_list nre, _nre_root nre))
| (t, nre) <- Map.toList ngrams
]
pure mapTermListRoot mapTermListRoot :: RepoCmdM env err m
=> [ListId] -> NgramsType
-> m (Map Text (ListType, (Maybe Text)))
mapTermListRoot nodeIds ngramsType = do
ngrams <- getListNgrams nodeIds ngramsType
pure $ Map.fromList [(t, (_nre_list nre, _nre_root nre))
| (t, nre) <- Map.toList ngrams
]
filterListWithRoot :: ListType -> Map Text (ListType, Maybe Text) filterListWithRoot :: ListType -> Map Text (ListType, Maybe Text)
......
...@@ -284,7 +284,7 @@ graphAPI nId = do ...@@ -284,7 +284,7 @@ graphAPI nId = do
let cId = maybe (panic "no parentId") identity $ _node_parentId nodeGraph let cId = maybe (panic "no parentId") identity $ _node_parentId nodeGraph
lId <- defaultList cId lId <- defaultList cId
ngs <- filterListWithRoot GraphTerm <$> getListNgrams [lId] NgramsTerms ngs <- filterListWithRoot GraphTerm <$> mapTermListRoot [lId] NgramsTerms
myCooc <- Map.filter (>1) <$> getCoocByNgrams myCooc <- Map.filter (>1) <$> getCoocByNgrams
<$> groupNodesByNgrams ngs <$> groupNodesByNgrams ngs
......
...@@ -299,11 +299,12 @@ mapNodeIdNgrams = DM.unionsWith (DM.unionWith (DM.unionWith (+))) . fmap f ...@@ -299,11 +299,12 @@ mapNodeIdNgrams = DM.unionsWith (DM.unionWith (DM.unionWith (+))) . fmap f
nId = documentId $ documentWithId d nId = documentId $ documentWithId d
------------------------------------------------------------------------ ------------------------------------------------------------------------
flowListBase :: FlowCmdM env err m listInsert :: FlowCmdM env err m
=> ListId -> Map NgramsType [NgramsElement] => ListId -> Map NgramsType [NgramsElement]
-> m () -> m ()
flowListBase lId ngs = do listInsert lId ngs = mapM_ (\(typeList, ngElmts)
mapM_ (\(typeList, ngElmts) -> putListNgrams lId typeList ngElmts) $ toList ngs -> putListNgrams lId typeList ngElmts
) $ toList ngs
flowList :: FlowCmdM env err m => UserId -> CorpusId flowList :: FlowCmdM env err m => UserId -> CorpusId
-> Map NgramsType [NgramsElement] -> Map NgramsType [NgramsElement]
...@@ -311,7 +312,7 @@ flowList :: FlowCmdM env err m => UserId -> CorpusId ...@@ -311,7 +312,7 @@ flowList :: FlowCmdM env err m => UserId -> CorpusId
flowList uId cId ngs = do flowList uId cId ngs = do
lId <- getOrMkList cId uId lId <- getOrMkList cId uId
printDebug "listId flowList" lId printDebug "listId flowList" lId
flowListBase lId ngs listInsert lId ngs
pure lId pure lId
......
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