Commit 501553c6 authored by Alexandre Delanoë's avatar Alexandre Delanoë

[BUG] Flow continuation <> bugs persists (cont should be empty)

parent 7173c1d5
...@@ -70,18 +70,18 @@ fromScores'' f' (t, fs) = ( maybeParent ...@@ -70,18 +70,18 @@ fromScores'' f' (t, fs) = ( maybeParent
toGroupedTree :: Map (Maybe Parent) (Map Text (GroupedTreeScores (Set NodeId))) toGroupedTree :: Map (Maybe Parent) (Map Text (GroupedTreeScores (Set NodeId)))
-> Map Parent (GroupedTreeScores (Set NodeId)) -> Map Parent (GroupedTreeScores (Set NodeId))
toGroupedTree m = case Map.lookup Nothing m of toGroupedTree m = case Map.lookup Nothing m of
Nothing -> Map.empty Nothing -> mempty
Just m' -> toGroupedTree' m m' Just m' -> toGroupedTree' m m'
toGroupedTree' :: Map (Maybe Parent) (Map Text (GroupedTreeScores (Set NodeId))) toGroupedTree' :: Map (Maybe Parent) (Map Text (GroupedTreeScores (Set NodeId)))
-> (Map Text (GroupedTreeScores (Set NodeId))) -> (Map Text (GroupedTreeScores (Set NodeId)))
-> Map Parent (GroupedTreeScores (Set NodeId)) -> Map Parent (GroupedTreeScores (Set NodeId))
toGroupedTree' m notEmpty toGroupedTree' m notEmpty
| notEmpty == Map.empty = Map.empty | notEmpty == mempty = mempty
| otherwise = Map.mapWithKey (addGroup m) notEmpty | otherwise = Map.mapWithKey (addGroup m) notEmpty
where where
addGroup m' k v = over gts'_children ( (toGroupedTree' m') addGroup m' k v = over gts'_children ( (toGroupedTree' m')
. (Map.union ( fromMaybe Map.empty . (Map.union ( fromMaybe mempty
$ Map.lookup (Just k) m' $ Map.lookup (Just k) m'
) )
) )
...@@ -136,21 +136,21 @@ addIfNotExist :: Map Text FlowListScores ...@@ -136,21 +136,21 @@ addIfNotExist :: Map Text FlowListScores
-> Map Text (Set NodeId) -> Map Text (Set NodeId)
-> Map Text (GroupedTextScores (Set NodeId)) -> Map Text (GroupedTextScores (Set NodeId))
addIfNotExist mapSocialScores mapScores = addIfNotExist mapSocialScores mapScores =
foldl' (addIfNotExist' mapSocialScores) Map.empty $ Map.toList mapScores foldl' (addIfNotExist' mapSocialScores) mempty $ Map.toList mapScores
where where
addIfNotExist' mss m (t,ns) = addIfNotExist' mss m (t,ns) =
case Map.lookup t mss of case Map.lookup t mss of
Nothing -> Map.alter (add ns) t m Nothing -> Map.alter (add ns) t m
_ -> m _ -> m
add ns' Nothing = Just $ GroupedTextScores Nothing ns' Set.empty add ns' Nothing = Just $ GroupedTextScores Nothing ns' mempty
add _ _ = Nothing -- should not be present add _ _ = Nothing -- should not be present
------------------------------------------------------------------------ ------------------------------------------------------------------------
------------------------------------------------------------------------ ------------------------------------------------------------------------
fromGroupedScores :: Map Parent GroupedWithListScores fromGroupedScores :: Map Parent GroupedWithListScores
-> Map Parent (GroupedTextScores (Set NodeId)) -> Map Parent (GroupedTextScores (Set NodeId))
fromGroupedScores = Map.map (\(GroupedWithListScores l c) -> GroupedTextScores l Set.empty c) fromGroupedScores = Map.map (\(GroupedWithListScores l c) -> GroupedTextScores l mempty c)
------------------------------------------------------------------------ ------------------------------------------------------------------------
fromListScores :: Map Text FlowListScores -> Map Parent GroupedWithListScores fromListScores :: Map Text FlowListScores -> Map Parent GroupedWithListScores
......
...@@ -59,7 +59,7 @@ groupWithStem' g flc ...@@ -59,7 +59,7 @@ groupWithStem' g flc
| g == GroupIdentity = FlowCont ( (<>) | g == GroupIdentity = FlowCont ( (<>)
(view flc_scores flc) (view flc_scores flc)
(view flc_cont flc) (view flc_cont flc)
) Map.empty ) mempty
| otherwise = mergeWith (groupWith g) flc | otherwise = mergeWith (groupWith g) flc
-- | MergeWith : with stem, we always have an answer -- | MergeWith : with stem, we always have an answer
...@@ -67,7 +67,7 @@ groupWithStem' g flc ...@@ -67,7 +67,7 @@ groupWithStem' g flc
mergeWith :: (Text -> Text) mergeWith :: (Text -> Text)
-> FlowCont Text (GroupedTreeScores (Set NodeId)) -> FlowCont Text (GroupedTreeScores (Set NodeId))
-> FlowCont Text (GroupedTreeScores (Set NodeId)) -> FlowCont Text (GroupedTreeScores (Set NodeId))
mergeWith fun flc = FlowCont scores Map.empty mergeWith fun flc = FlowCont scores mempty
where where
scores :: Map Text (GroupedTreeScores (Set NodeId)) scores :: Map Text (GroupedTreeScores (Set NodeId))
......
...@@ -49,7 +49,9 @@ instance (Eq a, Ord a, Eq b) => Semigroup (FlowCont a b) where ...@@ -49,7 +49,9 @@ instance (Eq a, Ord a, Eq b) => Semigroup (FlowCont a b) where
= FlowCont m s = FlowCont m s
where where
m = Map.union m1 m2 m = Map.union m1 m2
s = Map.intersection s1 s2 s | s1 == mempty = s2
| s2 == mempty = s1
| otherwise = Map.intersection s1 s2
makeLenses ''FlowCont makeLenses ''FlowCont
......
...@@ -72,7 +72,7 @@ addList :: ListType ...@@ -72,7 +72,7 @@ addList :: ListType
-> Maybe FlowListScores -> Maybe FlowListScores
-> Maybe FlowListScores -> Maybe FlowListScores
addList l Nothing = addList l Nothing =
Just $ set fls_listType (addListScore l Map.empty) mempty Just $ set fls_listType (addListScore l mempty) mempty
addList l (Just fls) = addList l (Just fls) =
Just $ over fls_listType (addListScore l) fls Just $ over fls_listType (addListScore l) fls
...@@ -101,9 +101,9 @@ addParent :: KeepAllParents -> NgramsRepoElement -> Set Text ...@@ -101,9 +101,9 @@ addParent :: KeepAllParents -> NgramsRepoElement -> Set Text
-> Maybe FlowListScores -> Maybe FlowListScores
addParent k nre ss Nothing = addParent k nre ss Nothing =
Just $ FlowListScores Map.empty mapParent Just $ FlowListScores mempty mapParent
where where
mapParent = addParentScore k (view nre_parent nre) ss Map.empty mapParent = addParentScore k (view nre_parent nre) ss mempty
addParent k nre ss (Just fls{-(FlowListScores mapList mapParent)-}) = addParent k nre ss (Just fls{-(FlowListScores mapList mapParent)-}) =
Just $ over fls_parents (addParentScore k (view nre_parent nre) ss) fls Just $ over fls_parents (addParentScore k (view nre_parent nre) ss) fls
......
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