[Social List] some fixes before integration

src/Gargantext/Core/Text/Group.hs

@@ -71,6 +71,12 @@ ngramsGroup (GroupParams l _m _n _) = Text.intercalate " "
                   . Text.splitOn " "
                   . Text.replace "-" " "
 
+------------------------------------------------------------------------
+mergeMapParent :: Map Text (GroupedText b)
+               -> Map Text (Map Text Int)
+               -> Map Text (GroupedText b)
+mergeMapParent = undefined
+
 ------------------------------------------------------------------------
 toGroupedText :: Ord b
               => (Text -> Text)
@@ -115,15 +121,15 @@ data GroupedText score =
   GroupedText { _gt_listType :: !(Maybe ListType)
               , _gt_label    :: !Label
               , _gt_score    :: !score
-              , _gt_group    :: !(Set Text)
+              , _gt_children :: !(Set Text)
               , _gt_size     :: !Int
               , _gt_stem     :: !Stem
               , _gt_nodes    :: !(Set NodeId)
-              } deriving Show
-{-
+              } {-deriving Show--}
+--{-
 instance Show score => Show (GroupedText score) where
   show (GroupedText lt l s _ _ _ _) = show l <> " : " <> show lt <> " : " <> show s
--}
+--}
 
 instance (Eq a) => Eq (GroupedText a) where
   (==) (GroupedText _ _ score1 _ _ _ _)

src/Gargantext/Core/Text/List.hs

@@ -88,7 +88,7 @@ buildNgramsOthersList user uCid groupIt (nt, MapListSize mapListSize) = do
   socialLists <- flowSocialList user nt (Set.fromList $ Map.keys ngs)
 
   let
-    groupedWithList = map (addListType (invertForw socialLists)) grouped
+    groupedWithList        = map (addListType (invertForw socialLists)) grouped
     (stopTerms, tailTerms) = Map.partition (\t -> t ^. gt_listType == Just StopTerm) groupedWithList
     (mapTerms, tailTerms') = Map.partition (\t -> t ^. gt_listType == Just MapTerm) tailTerms
 

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

@@ -76,13 +76,12 @@ invertBack = Map.fromListWith (<>)
 unions_test :: Map ListType (Set Text)
 unions_test = unions [m1, m2]
   where
-    m1 = Map.fromList [ (StopTerm, Set.singleton "Candidate")]
+    m1 = Map.fromList [ (StopTerm     , Set.singleton "Candidate")]
     m2 = Map.fromList [ (CandidateTerm, Set.singleton "Candidate")
-                      , (MapTerm, Set.singleton "Candidate")
+                      , (MapTerm      , Set.singleton "Candidate")
                       ]
 
 ------------------------------------------------------------------------
-
 termsByList :: ListType -> (Map (Maybe ListType) (Set Text)) -> Set Text
 termsByList CandidateTerm m = Set.unions
                           $ map (\lt -> fromMaybe Set.empty $ Map.lookup lt m)
@@ -170,9 +169,28 @@ toMapTextListType m = Map.fromListWith (<>)
                     $ map (toList m)
                     $ Map.toList m
 
+----------------------
+-- | Tools to inherit groupings
 ----------------------
 type Parent = Text
 
+parentUnionsMerge :: (Ord a, Ord b, Num c) 
+             => [Map a (Map b c)]
+             ->  Map a (Map b c)
+parentUnionsMerge = Map.unionsWith (Map.unionWith (+))
+
+-- This Parent union is specific
+-- [Private, Shared, Public]
+-- means the following preferences:
+-- Private > Shared > Public
+-- if data have not been tagged privately, then use others tags
+-- This unions behavior takes first key only and ignore others
+parentUnionsExcl :: Ord a
+                 => [Map a b]
+                 -> Map a b
+parentUnionsExcl = Map.unions
+
+
 hasParent :: Text
           -> Map Text (Map Parent Int)
           -> Maybe Parent
@@ -192,27 +210,31 @@ toMapTextParent ts = foldl' (toMapTextParent' ts)
                     -> Map Text (Map Parent Int)
                     -> Map Text NgramsRepoElement
                     -> Map Text (Map Parent Int)
-    toMapTextParent' ts' to from = Set.foldl' (toMapTextParent'' from) to ts'
+    toMapTextParent' ts' to from = Set.foldl' (toMapTextParent'' ts' from) to ts'
 
 
-    toMapTextParent'' :: Map Text NgramsRepoElement
+    toMapTextParent'' :: Set Text
+                      -> Map Text NgramsRepoElement
                       -> Map Text (Map Parent Int)
                       -> Text
                       -> Map Text (Map Parent Int)
-    toMapTextParent'' from to t = case Map.lookup t from of
+    toMapTextParent'' ss from to t = case Map.lookup t from of
       Nothing  -> to
       Just nre -> case _nre_parent nre of
-        Just (NgramsTerm p')  -> Map.alter (addParent p') t to
+        Just (NgramsTerm p')  -> if Set.member p' ss
+                                    then Map.alter (addParent p') t to
+                                    else to
           where
             addParent p'' Nothing   = Just $ addCountParent p'' Map.empty
             addParent p'' (Just ps) = Just $ addCountParent p'' ps
-        _ -> to
 
-addCountParent :: Parent -> Map Parent Int -> Map Parent Int
-addCountParent p m = Map.alter addCount p m
-  where
-    addCount Nothing  = Just 1
-    addCount (Just n) = Just $ n + 1
+            addCountParent :: Parent -> Map Parent Int -> Map Parent Int
+            addCountParent p m = Map.alter addCount p m
+              where
+                addCount Nothing  = Just 1
+                addCount (Just n) = Just $ n + 1
+
+        _ -> to
 
 
 ------------------------------------------------------------------------