[FEAT] SocialLists hiearchical inheritance (WIP)

src/Gargantext/Core/Text/List.hs

@@ -16,7 +16,7 @@ module Gargantext.Core.Text.List
   where
 
 
-import Control.Lens ((^.), set)
+import Control.Lens ((^.), set, view)
 import Data.Maybe (fromMaybe, catMaybes)
 import Data.Ord (Down(..))
 import Data.Map (Map)
@@ -32,7 +32,7 @@ import qualified Data.Text as Text
 import Gargantext.API.Ngrams.Types (NgramsElement, mkNgramsElement, NgramsTerm(..), RootParent(..), mSetFromList)
 import Gargantext.API.Ngrams.Types (RepoCmdM)
 import Gargantext.Core.Text.List.Social (flowSocialList, flowSocialList', FlowSocialListPriority(..), invertForw)
-import Gargantext.Core.Text.List.Social.Scores (FlowListScores)
+import Gargantext.Core.Text.List.Social.Scores -- (FlowListScores)
 import Gargantext.Core.Text.List.Group
 import Gargantext.Core.Text.List.Group.WithStem
 import Gargantext.Core.Text.Metrics (scored', Scored(..), normalizeGlobal, normalizeLocal)
@@ -90,13 +90,13 @@ buildNgramsOthersList user uCid groupIt (nt, MapListSize mapListSize) = do
     <- flowSocialList' MySelfFirst user nt (Set.fromList $ Map.keys ngs')
     -- PrivateFirst for first developments since Public NodeMode is not implemented yet
 
-  -- printDebug "flowSocialList'" socialLists'
+  printDebug "flowSocialList'" (Map.filter (not . ((==) Map.empty) . view fls_parents) socialLists')
 
   let
     groupParams     = GroupedTextParams groupIt (Set.size . snd) fst snd {-(size . fst)-}
     groupedWithList = toGroupedText groupParams socialLists' ngs'
 
-  printDebug "groupedWithList" groupedWithList
+  printDebug "groupedWithList" (Map.map (\v -> (view gt_label v, view gt_children v)) $ Map.filter (\v -> (Set.size $ view gt_children v) > 0) groupedWithList)
 
   let
     (stopTerms, tailTerms) = Map.partition (\t -> t ^. gt_listType == Just StopTerm) groupedWithList

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

@@ -14,7 +14,9 @@ Portability : POSIX
 module Gargantext.Core.Text.List.Group.WithScores
   where
 
+import Data.Maybe (fromMaybe)
 import Control.Lens (makeLenses, set, over, view)
+import Data.Semigroup
 import Data.Set (Set)
 import Data.Map (Map)
 import Data.Text (Text)
@@ -34,69 +36,65 @@ data GroupedWithListScores =
                         , _gwls_listType :: !(Maybe ListType)
                         }
 makeLenses ''GroupedWithListScores
+instance Semigroup GroupedWithListScores where
+  (<>) (GroupedWithListScores c1 l1)
+       (GroupedWithListScores c2 l2) = 
+        GroupedWithListScores (c1 <> c2) (l1 <> l2)
 
-
+------
 data GroupedTextScores score =
   GroupedTextScores { _gts_listType :: !(Maybe ListType)
                     , _gts_score    :: score
                     , _gts_children :: !(Set Text)
                     }
 makeLenses 'GroupedTextScores
+instance Semigroup a => Semigroup (GroupedTextScores a) where
+  (<>) (GroupedTextScores l1 s1 c1)
+       (GroupedTextScores l2 s2 c2)
+    = GroupedTextScores (l1 <> l2) (s1 <> s2) (c1 <> c2)
 
 ------------------------------------------------------------------------
 -- | Main function
 groupWithScores :: Map Text FlowListScores
                 -> Map Text (Set NodeId)
                 -> Map Text (GroupedTextScores (Set NodeId))
-groupWithScores scores =
-  Map.mapWithKey (\k a -> scoresToGroupedTextScores
-                         (Map.lookup k $ toGroupedWithListScores scores)
-                         k a
-                 )
-
-  where
-    scoresToGroupedTextScores :: Maybe GroupedWithListScores
-                              -> Text -> Set NodeId
-                              -> GroupedTextScores (Set NodeId)
-    scoresToGroupedTextScores Nothing  _ ns = GroupedTextScores Nothing ns Set.empty
-    scoresToGroupedTextScores (Just g) t ns = GroupedTextScores list ns (Set.singleton t)
-      where
-        list = view gwls_listType g
-------------------------------------------------------------------------
-toGroupedWithListScores :: Map Text FlowListScores -> Map Text GroupedWithListScores
-toGroupedWithListScores ms = foldl' (toGroup ms) Map.empty (Map.toList ms)
-  where
-    toGroup :: Map Text FlowListScores
-            -> Map Text GroupedWithListScores
-            -> (Text, FlowListScores)
-            -> Map Text GroupedWithListScores
-    toGroup _ result (t,fs) = case (keyWithMaxValue $ view flc_parents fs) of
-      Nothing     -> Map.alter (addGroupedParent (t,fs)) t  result
-      Just parent -> Map.alter (addGroupedChild  (t,fs)) parent result
+groupWithScores scores  = undefined
 
 
-    addGroupedParent :: (Text, FlowListScores)
-                     -> Maybe GroupedWithListScores
-                     -> Maybe GroupedWithListScores
-    addGroupedParent (_,fs) Nothing = Just $ GroupedWithListScores Set.empty list
-      where
-        list = keyWithMaxValue $ view flc_lists fs
+-- | Add scores depending on being either parent or child or orphan
+addScore :: Map Text FlowListScores
+         -> (Text, Set NodeId)
+         -> Map Text (GroupedTextScores (Set NodeId))
+         -> Map Text (GroupedTextScores (Set NodeId))
+addScore scores (t, ns) ms = Map.alter (isParent ns) t ms
+  where
+    isParent ns' Nothing = case Map.lookup t scores of
+      -- check isChild
+      Just fls -> case keyWithMaxValue $ view fls_parents fls of
+        Just parent -> undefined -- over gts_score (Set.insert ns') <$> Map.lookup parent ms
+        Nothing     -> panic "Should not happen"
 
-    addGroupedParent (t,fs) (Just g) = Just $ set  gwls_listType list
-                                            $ over gwls_children (Set.insert t) g
-      where
-        list     = keyWithMaxValue $ view flc_lists fs
+      -- is Orphan
+      Nothing -> undefined -- GroupedTextScores Nothing ns' Set.empty
 
+    isParent ns' (Just (GroupedTextScores l s c)) = let ns'' = ns' <> s in Just (GroupedTextScores l ns'' c)
+  
 
-    addGroupedChild :: (Text, FlowListScores)
-                    -> Maybe GroupedWithListScores
-                    -> Maybe GroupedWithListScores
-    addGroupedChild (t,fs) Nothing  = Just $ GroupedWithListScores (Set.singleton t) list
-      where
-        list     = keyWithMaxValue $ view flc_lists fs
+------------------------------------------------------------------------
+fromGroupedScores :: Map Parent GroupedWithListScores
+                  -> Map Parent (GroupedTextScores (Set NodeId))
+fromGroupedScores = Map.map (\(GroupedWithListScores c l) -> GroupedTextScores l Set.empty c)
 
-    addGroupedChild (t,fs) (Just g) = Just $ over gwls_listType (<> list)
-                                           $ over gwls_children (Set.insert t) g
-      where
-        list     = keyWithMaxValue $ view flc_lists fs
+------------------------------------------------------------------------
+fromListScores :: Map Text FlowListScores -> Map Parent GroupedWithListScores
+fromListScores = Map.fromListWith (<>) . (map fromScores') . Map.toList
+  where
+    fromScores' :: (Text, FlowListScores) -> (Text, GroupedWithListScores)
+    fromScores' (t, fs) = case (keyWithMaxValue $ view fls_parents fs) of
+      Nothing     -> (t, GroupedWithListScores Set.empty (keyWithMaxValue $ view fls_listType fs))
+          -- Parent case: taking its listType, for now children Set is empty
+ 
+      Just parent -> (parent, GroupedWithListScores (Set.singleton t) Nothing)
+          -- We ignore the ListType of children for the parents' one
+          -- added after and winner of semigroup actions
 

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

@@ -67,8 +67,8 @@ keyWithMaxValue m = (fst . fst) <$> Map.maxViewWithKey m
 
 ------------------------------------------------------------------------
 data FlowListScores =
-  FlowListScores { _flc_parents :: Map Parent   Int
-                 , _flc_lists   :: Map ListType Int
+  FlowListScores { _fls_parents   :: Map Parent   Int
+                 , _fls_listType :: Map ListType Int
                 -- You can add any score by incrementing this type
                 -- , _flc_score   :: Map Score Int
                  }