[FlowCont] improving Type (to prepare group terms)

src/Gargantext/Core/Text/List.hs

@@ -19,6 +19,7 @@ module Gargantext.Core.Text.List
 import Control.Lens ((^.), set, over)
 import Data.Map (Map)
 import Data.Maybe (catMaybes)
+import Data.Monoid (mempty)
 import Data.Ord (Down(..))
 import Data.Set (Set)
 import Data.Text (Text)
@@ -87,7 +88,11 @@ buildNgramsOthersList user uCid groupIt (nt, MapListSize mapListSize) = do
   ngs'  :: Map Text (Set NodeId) <- getNodesByNgramsUser uCid nt
 
   socialLists' :: FlowCont Text FlowListScores
-    <- flowSocialList' MySelfFirst user nt (FlowCont Map.empty $ Set.fromList $ Map.keys ngs')
+    <- 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
 
 {-

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

@@ -13,7 +13,6 @@ Portability : POSIX
 {-# LANGUAGE FunctionalDependencies #-}
 {-# LANGUAGE InstanceSigs           #-}
 
-
 module Gargantext.Core.Text.List.Group.Prelude
   where
 
@@ -33,9 +32,9 @@ import qualified Data.Map  as Map
 import qualified Data.List as List
 
 ------------------------------------------------------------------------
--- | Group With Scores Main Types
--- Tree of GroupedTextScores
--- Target : type FlowCont Text GroupedTextScores'
+-- | Main Types to group With Scores but preserving Tree dependencies
+-- Therefore there is a need of Tree of GroupedTextScores
+-- to target continuation type for the flow (FlowCont Text GroupedTreeScores)
 data GroupedTreeScores score =
   GroupedTreeScores { _gts'_listType :: !(Maybe ListType)
                     , _gts'_children :: !(Map Text (GroupedTreeScores score))
@@ -51,11 +50,12 @@ instance (Semigroup a, Ord a) => Semigroup (GroupedTreeScores a) where
 
 instance (Ord score, Monoid score)
   => Monoid (GroupedTreeScores score) where
-    mempty = GroupedTreeScores Nothing Map.empty mempty
+    mempty = GroupedTreeScores mempty mempty mempty
 
 makeLenses 'GroupedTreeScores
 
 ------------------------------------------------------------------------
+-- | Main Classes
 class ViewListType a where
   viewListType :: a -> Maybe ListType
 
@@ -69,6 +69,7 @@ class ToNgramsElement a where
   toNgramsElement :: a -> [NgramsElement]
 
 ------------------------------------------------------------------------
+-- | Instances declartion for (GroupedTreeScores a)
 instance ViewListType (GroupedTreeScores a) where
   viewListType = view gts'_listType
 
@@ -108,8 +109,6 @@ instance ToNgramsElement (Text, GroupedTreeScores a) where
                                                     $ Map.keys
                                                     $ view gts'_children gts'
                                       )
-
-
           children' = List.concat
                     $ map (childrenWith root (NgramsTerm t') )
                     $ Map.toList
@@ -122,7 +121,6 @@ instance ToNgramsElement (Text, GroupedTreeScores a) where
 
 
 
-
 -- 8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--
 -- TODO to remove below
 data GroupedWithListScores =

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

@@ -26,8 +26,9 @@ 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.Set  as Set
+import qualified Data.List as List
 import qualified Data.Map  as Map
+import qualified Data.Set  as Set
 
 ------------------------------------------------------------------------
 ------------------------------------------------------------------------
@@ -44,13 +45,17 @@ groupWithScores' flc scores = FlowCont  groups orphans
             $ view flc_scores flc
 
     -- orphans have been filtered already
-    orphans = (view flc_cont flc)
+    orphans =  toGroupedTree
+            $ toMapMaybeParent scores
+            $ (view flc_cont flc)
 
 ------------------------------------------------------------------------
 toMapMaybeParent :: (Text -> Set NodeId)
                  -> Map Text FlowListScores
                  -> Map (Maybe Parent) (Map Text (GroupedTreeScores (Set NodeId)))
-toMapMaybeParent f = Map.fromListWith (<>) . (map (fromScores'' f)) . Map.toList
+toMapMaybeParent f =  Map.fromListWith (<>)
+                   . (map (fromScores'' f))
+                   .  Map.toList
 
 fromScores'' :: (Text -> Set NodeId)
              -> (Text, FlowListScores)
@@ -78,11 +83,12 @@ toGroupedTree' m notEmpty
   | otherwise = Map.mapWithKey (addGroup m) notEmpty
     where
       addGroup m' k v = over gts'_children ( (toGroupedTree' m')
-                                           . (Map.union (fromMaybe Map.empty
-                                                                 $ Map.lookup (Just k) m'
+                                           . (Map.union ( fromMaybe Map.empty
+                                                        $ Map.lookup (Just k) m'
                                                         )
                                              )
-                                           ) v
+                                           )
+                                           v
 
 
 

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

@@ -40,9 +40,9 @@ data StopSize = StopSize {unStopSize :: !Int}
 -- discussed. Main purpose of this is offering
 -- a first grouping option to user and get some
 -- enriched data to better learn and improve that algo
-data GroupParams = GroupParams { unGroupParams_lang  :: !Lang
-                               , unGroupParams_len   :: !Int
-                               , unGroupParams_limit :: !Int
+data GroupParams = GroupParams { unGroupParams_lang     :: !Lang
+                               , unGroupParams_len      :: !Int
+                               , unGroupParams_limit    :: !Int
                                , unGroupParams_stopSize :: !StopSize
                                }
                  | GroupIdentity

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

@@ -37,18 +37,18 @@ type Parent = Text
 -- | DataType inspired by continuation Monad (but simpler)
 data FlowCont a b =
   FlowCont { _flc_scores :: Map a b
-           , _flc_cont   :: Set a
+           , _flc_cont   :: Map a b
            }
 
-instance Ord a => Monoid (FlowCont a b) where
-  mempty = FlowCont Map.empty Set.empty
+instance (Ord a, Eq b) => Monoid (FlowCont a b) where
+  mempty = FlowCont mempty mempty
 
-instance (Eq a, Ord a) => Semigroup (FlowCont a b) where
+instance (Eq a, Ord a, Eq b) => Semigroup (FlowCont a b) where
   (<>) (FlowCont m1 s1)
        (FlowCont m2 s2)
-          | s1 == Set.empty = FlowCont m s2
-          | s2 == Set.empty = FlowCont m s1
-          | otherwise       = FlowCont m (Set.intersection s1 s2)
+          | s1 == mempty = FlowCont m s2
+          | s2 == mempty = FlowCont m s1
+          | otherwise       = FlowCont m (Map.intersection s1 s2)
             where
               m = Map.union m1 m2
 
@@ -60,7 +60,7 @@ data FlowListScores =
                 -- You can add any score by incrementing this type
                 -- , _flc_score   :: Map Score Int
                  }
-    deriving (Show, Generic)
+    deriving (Show, Generic, Eq)
 
 
 ------------------------------------------------------------------------

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

@@ -47,7 +47,7 @@ toFlowListScores k flc_origin = foldl' (toFlowListScores_Level1 k flc_origin) me
     toFlowListScores_Level1 k' flc_origin' flc_dest ngramsRepo =
       Set.foldl' (toFlowListScores_Level2 k' ngramsRepo flc_origin')
                  flc_dest
-                 (view flc_cont flc_origin')
+                 (Set.fromList $ Map.keys $ view flc_cont flc_origin')
 
 
     toFlowListScores_Level2 :: KeepAllParents
@@ -58,9 +58,9 @@ toFlowListScores k flc_origin = foldl' (toFlowListScores_Level1 k flc_origin) me
                        -> FlowCont Text FlowListScores
     toFlowListScores_Level2 k'' ngramsRepo flc_origin'' flc_dest' t =
       case Map.lookup t ngramsRepo of
-        Nothing  -> over flc_cont (Set.insert t) flc_dest'
+        Nothing  -> over flc_cont (Map.insert t mempty) flc_dest'
         Just nre -> over flc_scores
-                  ( (Map.alter (addParent k'' nre (view flc_cont flc_origin'')) t)
+                  ( (Map.alter (addParent k'' nre (Set.fromList $ Map.keys $ view flc_cont flc_origin'')) t)
                   . (Map.alter (addList $ _nre_list nre) t)
                   ) flc_dest'