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