Commit 3e6c662a authored by Alexandre Delanoë's avatar Alexandre Delanoë

[FIX] SemiGroup instance of ListType

parent e86fc566
...@@ -44,9 +44,9 @@ flowSocialList :: ( RepoCmdM env err m ...@@ -44,9 +44,9 @@ flowSocialList :: ( RepoCmdM env err m
-> m (Map ListType (Set Text)) -> m (Map ListType (Set Text))
flowSocialList user nt ngrams' = do flowSocialList user nt ngrams' = do
privateLists <- flowSocialListByMode Private user nt ngrams' privateLists <- flowSocialListByMode Private user nt ngrams'
printDebug "* privateLists *: \n" privateLists -- printDebug "* privateLists *: \n" privateLists
sharedLists <- flowSocialListByMode Shared user nt (termsByList CandidateTerm privateLists) sharedLists <- flowSocialListByMode Shared user nt (termsByList CandidateTerm privateLists)
printDebug "* socialLists *: \n" sharedLists -- printDebug "* socialLists *: \n" sharedLists
-- TODO publicMapList -- TODO publicMapList
pure $ Map.fromList [ (MapTerm, termsByList MapTerm privateLists pure $ Map.fromList [ (MapTerm, termsByList MapTerm privateLists
...@@ -81,7 +81,7 @@ flowSocialListByMode mode user nt ngrams' = do ...@@ -81,7 +81,7 @@ flowSocialListByMode mode user nt ngrams' = do
[] -> pure $ Map.fromList [(Nothing, ngrams')] [] -> pure $ Map.fromList [(Nothing, ngrams')]
_ -> do _ -> do
counts <- countFilterList ngrams' nt listIds Map.empty counts <- countFilterList ngrams' nt listIds Map.empty
printDebug "flowSocialListByMode counts" counts -- printDebug "flowSocialListByMode counts" counts
pure $ toSocialList counts ngrams' pure $ toSocialList counts ngrams'
--------------------------------------------------------------------------- ---------------------------------------------------------------------------
...@@ -124,7 +124,7 @@ countFilterList' :: RepoCmdM env err m ...@@ -124,7 +124,7 @@ countFilterList' :: RepoCmdM env err m
-> m (Map Text (Map ListType Int)) -> m (Map Text (Map ListType Int))
countFilterList' st nt ls input = do countFilterList' st nt ls input = do
ml <- toMapTextListType <$> getListNgrams ls nt ml <- toMapTextListType <$> getListNgrams ls nt
printDebug "countFilterList'" ml -- printDebug "countFilterList'" ml
pure $ Set.foldl' (\m t -> countList t ml m) input st pure $ Set.foldl' (\m t -> countList t ml m) input st
--------------------------------------------------------------------------- ---------------------------------------------------------------------------
...@@ -135,13 +135,6 @@ toMapTextListType m = Map.fromListWith (<>) ...@@ -135,13 +135,6 @@ toMapTextListType m = Map.fromListWith (<>)
$ (map (toList m)) $ (map (toList m))
$ Map.toList m $ Map.toList m
listOf :: Map Text NgramsRepoElement -> NgramsRepoElement -> ListType
listOf m ng = case _nre_parent ng of
Nothing -> _nre_list ng
Just p -> case Map.lookup (unNgramsTerm p) m of
Nothing -> CandidateTerm -- Should Not happen
Just ng' -> listOf m ng'
toList :: Map Text NgramsRepoElement -> (Text, NgramsRepoElement) -> [(Text, ListType)] toList :: Map Text NgramsRepoElement -> (Text, NgramsRepoElement) -> [(Text, ListType)]
toList m (t, nre@(NgramsRepoElement _ _ _ _ (MSet children))) = toList m (t, nre@(NgramsRepoElement _ _ _ _ (MSet children))) =
List.zip terms (List.cycle [lt']) List.zip terms (List.cycle [lt'])
...@@ -152,6 +145,13 @@ toList m (t, nre@(NgramsRepoElement _ _ _ _ (MSet children))) = ...@@ -152,6 +145,13 @@ toList m (t, nre@(NgramsRepoElement _ _ _ _ (MSet children))) =
<> (map unNgramsTerm $ Map.keys children) <> (map unNgramsTerm $ Map.keys children)
lt' = listOf m nre lt' = listOf m nre
listOf :: Map Text NgramsRepoElement -> NgramsRepoElement -> ListType
listOf m ng = case _nre_parent ng of
Nothing -> _nre_list ng
Just p -> case Map.lookup (unNgramsTerm p) m of
Just ng' -> listOf m ng'
Nothing -> CandidateTerm -- Should Not happen
--------------------------------------------------------------------------- ---------------------------------------------------------------------------
countList :: Text countList :: Text
-> Map Text ListType -> Map Text ListType
...@@ -177,7 +177,7 @@ findListsId mode u = do ...@@ -177,7 +177,7 @@ findListsId mode u = do
r <- getRootId u r <- getRootId u
ns <- map _dt_nodeId <$> filter (\n -> _dt_typeId n == nodeTypeId NodeList) ns <- map _dt_nodeId <$> filter (\n -> _dt_typeId n == nodeTypeId NodeList)
<$> findNodes' mode r <$> findNodes' mode r
printDebug "findListsIds" ns -- printDebug "findListsIds" ns
pure ns pure ns
commonNodes:: [NodeType] commonNodes:: [NodeType]
......
...@@ -63,9 +63,9 @@ instance Semigroup ListType ...@@ -63,9 +63,9 @@ instance Semigroup ListType
where where
MapTerm <> _ = MapTerm MapTerm <> _ = MapTerm
_ <> MapTerm = MapTerm _ <> MapTerm = MapTerm
CandidateTerm <> _ = CandidateTerm StopTerm <> CandidateTerm = StopTerm
_ <> CandidateTerm = CandidateTerm CandidateTerm <> StopTerm = StopTerm
StopTerm <> StopTerm = StopTerm _ <> _ = CandidateTerm
instance FromHttpApiData ListType where instance FromHttpApiData ListType where
......
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