[FIX] bug in FlowCont Semigroup instance (intersection for cont)

src/Gargantext/Core/Text/List.hs

@@ -16,7 +16,7 @@ module Gargantext.Core.Text.List
   where
 
 
-import Control.Lens ((^.), set, over)
+import Control.Lens ((^.), view, set, over)
 import Data.Map (Map)
 import Data.Maybe (catMaybes)
 import Data.Monoid (mempty)
@@ -87,32 +87,29 @@ buildNgramsOthersList ::( HasNodeError err
 buildNgramsOthersList user uCid groupIt (nt, MapListSize mapListSize) = do
   ngs'  :: Map Text (Set NodeId) <- getNodesByNgramsUser uCid nt
 
+  -- | PrivateFirst for first developments since Public NodeMode is not implemented yet
   socialLists' :: FlowCont Text FlowListScores
     <- flowSocialList' MySelfFirst user nt ( FlowCont Map.empty
                                                       $ Map.fromList
                                                       $ List.zip (Map.keys ngs') 
                                                                  (List.cycle [mempty])
                                            )
-    -- PrivateFirst for first developments since Public NodeMode is not implemented yet
 
 {-
   printDebug "flowSocialList'"
-               $ Map.filter (not . ((==) Map.empty) . view fls_parents)
+               $ Map.filter (not . ((==) Map.empty) . (view fls_parents))
                $ view flc_scores socialLists'
 -}
-
   let
     groupedWithList = toGroupedTreeText groupIt socialLists' ngs'
 
 {-
   printDebug "groupedWithList"
-               $ Map.map (\v -> (view gt_label v, view gt_children v))
-               $ Map.filter (\v -> (Set.size $ view gt_children v) > 0)
-               $ groupedWithList
+              $ view flc_scores groupedWithList
 -}
 
   let
-    (stopTerms, tailTerms) = Map.partition ((== Just StopTerm) . viewListType) groupedWithList
+    (stopTerms, tailTerms) = Map.partition ((== Just StopTerm) . viewListType) $ view flc_scores groupedWithList
     (mapTerms, tailTerms') = Map.partition ((== Just MapTerm)  . viewListType) tailTerms
 
     listSize = mapListSize - (List.length mapTerms)
@@ -178,6 +175,7 @@ buildNgramsTermsList user uCid mCid groupParams = do
 
   let
     -- Get Local Scores now for selected grouped ngrams
+    -- TODO HasTerms 
     selectedTerms = Set.toList $ List.foldl'
                       (\set' (GroupedText _ l' _ g _ _ _ ) -> Set.union set'
                                                             $ Set.insert l' g

src/Gargantext/Core/Text/List/Group.hs

@@ -39,10 +39,11 @@ import qualified Data.List as List
 toGroupedTreeText :: GroupParams
                   -> FlowCont Text FlowListScores
                   -> Map Text (Set NodeId)
-                  -> Map Text (GroupedTreeScores (Set NodeId))
-toGroupedTreeText groupParams flc scores = view flc_scores flow2
+                 -- -> Map Text (GroupedTreeScores (Set NodeId))
+                  -> FlowCont Text (GroupedTreeScores (Set NodeId))
+toGroupedTreeText groupParams flc scores = {-view flc_scores-} flow2
     where
-      flow1 = groupWithScores' flc scoring
+      flow1     = groupWithScores' flc scoring
       scoring t = fromMaybe Set.empty $ Map.lookup t scores
 
       flow2 = case (view flc_cont flow1) == Map.empty of

src/Gargantext/Core/Text/List/Group/Prelude.hs

@@ -38,7 +38,7 @@ import qualified Data.List as List
 data GroupedTreeScores score =
   GroupedTreeScores { _gts'_listType :: !(Maybe ListType)
                     , _gts'_children :: !(Map Text (GroupedTreeScores score))
-                    , _gts'_score    :: score
+                    , _gts'_score    :: !score
                     } deriving (Show, Ord, Eq)
 
 instance (Semigroup a, Ord a) => Semigroup (GroupedTreeScores a) where
@@ -68,6 +68,9 @@ class Ord b => ViewScore a b | a -> b where
 class ToNgramsElement a where
   toNgramsElement :: a -> [NgramsElement]
 
+class HasTerms a where
+  hasTerms :: a -> Set Text
+
 ------------------------------------------------------------------------
 -- | Instances declartion for (GroupedTreeScores a)
 instance ViewListType (GroupedTreeScores a) where
@@ -82,6 +85,10 @@ instance SetListType (Map Text (GroupedTreeScores a)) where
 instance ViewScore (GroupedTreeScores (Set NodeId)) Int where
   viewScore = Set.size . (view gts'_score)
 
+instance HasTerms (Map Text (GroupedTreeScores a)) where
+  hasTerms = undefined
+
+
 instance ToNgramsElement (Map Text (GroupedTreeScores a)) where
   toNgramsElement = List.concat . (map toNgramsElement) . Map.toList
 

src/Gargantext/Core/Text/List/Group/WithScores.hs

@@ -26,7 +26,6 @@ import Gargantext.Database.Admin.Types.Node (NodeId)
 import Gargantext.Core.Text.List.Social.Prelude
 import Gargantext.Core.Text.List.Group.Prelude
 import Gargantext.Prelude
-import qualified Data.List as List
 import qualified Data.Map  as Map
 import qualified Data.Set  as Set
 
@@ -44,11 +43,10 @@ groupWithScores' flc scores = FlowCont  groups orphans
             $ toMapMaybeParent scores
             $ view flc_scores flc
 
-    -- orphans have been filtered already
-    orphans =  toGroupedTree
+    -- orphans should be filtered already
+    orphans = toGroupedTree
             $ toMapMaybeParent scores
-            $ (view flc_cont flc)
-
+            $ view flc_cont flc
 ------------------------------------------------------------------------
 toMapMaybeParent :: (Text -> Set NodeId)
                  -> Map Text FlowListScores
@@ -92,6 +90,9 @@ toGroupedTree' m notEmpty
 
 
 
+
+
+
 --8<-- -8<-- -8<-- -8<-- -8<-- -8<-- -8<-- -8<-- -8<-- -8<-- -8<-- -8<--
 -- TODO TO BE REMOVED
 data GroupedTextScores score =

src/Gargantext/Core/Text/List/Group/WithStem.hs

@@ -20,6 +20,7 @@ module Gargantext.Core.Text.List.Group.WithStem
 import Control.Lens (makeLenses, view, over)
 import Data.Set (Set)
 import Data.Map (Map)
+import Data.Monoid (mempty)
 import Data.Text (Text)
 import Gargantext.Core (Lang(..))
 import Gargantext.Core.Text (size)
@@ -36,6 +37,7 @@ import qualified Data.Text as Text
 
 -- | Main Types
 data StopSize = StopSize {unStopSize :: !Int}
+  deriving (Eq)
 
 -- | TODO: group with 2 terms only can be
 -- discussed. Main purpose of this is offering
@@ -47,13 +49,18 @@ data GroupParams = GroupParams { unGroupParams_lang     :: !Lang
                                , unGroupParams_stopSize :: !StopSize
                                }
                  | GroupIdentity
-
+  deriving (Eq)
 
 ------------------------------------------------------------------------
 groupWithStem' :: GroupParams
                -> FlowCont Text (GroupedTreeScores (Set NodeId))
                -> FlowCont Text (GroupedTreeScores (Set NodeId))
-groupWithStem' = mergeWith . groupWith
+groupWithStem' g flc
+    | g == GroupIdentity = FlowCont ( (<>) 
+                                      (view flc_scores flc)
+                                      (view flc_cont   flc)
+                                    ) Map.empty
+    | otherwise = mergeWith (groupWith g) flc
 
 -- | MergeWith : with stem, we always have an answer
 -- if Maybe lems then we should add it to continuation
@@ -69,7 +76,7 @@ mergeWith fun flc = FlowCont scores Map.empty
         scores' = view flc_scores flc
         cont'   = Map.toList $ view flc_cont flc
 
-    -- TODO inserti at the right place in group hierarchy
+    -- TODO insert at the right place in group hierarchy
     -- adding as child of the parent for now
     alter :: Map Stem Text
           -> Map Text (GroupedTreeScores (Set NodeId))

src/Gargantext/Core/Text/List/Social.hs

@@ -65,7 +65,7 @@ flowSocialList' :: ( RepoCmdM env err m
                   -> FlowCont Text FlowListScores
                   -> m (FlowCont Text FlowListScores)
 flowSocialList' flowPriority user nt flc =
-  mconcat <$> mapM (flowSocialListByMode' user nt flc)
+  mconcat <$> mapM (flowSocialListByMode'   user nt flc)
                    (flowSocialListPriority flowPriority)
     where
 

src/Gargantext/Core/Text/List/Social/Prelude.hs

@@ -46,12 +46,12 @@ instance (Ord a, Eq b) => Monoid (FlowCont a b) where
 instance (Eq a, Ord a, Eq b) => Semigroup (FlowCont a b) where
   (<>) (FlowCont m1 s1)
        (FlowCont m2 s2)
-          | s1 == mempty = FlowCont m s2
-          | s2 == mempty = FlowCont m s1
-          | otherwise       = FlowCont m (Map.intersection s1 s2)
-            where
-              m = Map.union m1 m2
+      = FlowCont m s
+        where
+          m = Map.union        m1 m2
+          s = Map.intersection s1 s2
 
+makeLenses ''FlowCont
 
 -- | Datatype definition
 data FlowListScores =
@@ -62,9 +62,6 @@ data FlowListScores =
                  }
     deriving (Show, Generic, Eq)
 
-
-------------------------------------------------------------------------
-makeLenses ''FlowCont
 makeLenses ''FlowListScores
 
 -- | Rules to compose 2 datatype FlowListScores