[Social Lists] flowSocialList by Mode to flowSocialList (WIP)

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

@@ -14,37 +14,63 @@ module Gargantext.Core.Text.List.Social
   where
 
 -- findList imports
+import Gargantext.Core.Types.Individu
+import Gargantext.Database.Admin.Config
+import Gargantext.Database.Admin.Types.Node
 import Gargantext.Database.Prelude
+import Gargantext.Database.Query.Table.Node.Error
 import Gargantext.Database.Query.Tree
 import Gargantext.Database.Query.Tree.Root (getRootId)
-import Gargantext.Core.Types.Individu
-import Gargantext.Database.Admin.Types.Node
 import Gargantext.Prelude
-import Gargantext.Database.Query.Table.Node.Error
-import Gargantext.Database.Admin.Config
 
 -- filterList imports
-import Data.Maybe (fromMaybe, catMaybes)
+import Data.Map (Map)
 import Data.Set (Set)
 import Data.Text (Text)
-import Data.Map (Map)
-import Data.Tuple (fst)
-import qualified Data.List as List
-import qualified Data.Set as Set
-import qualified Data.Map as Map
-import Gargantext.API.Ngrams.Types
-import Gargantext.API.Ngrams.Tools -- (getListNgrams)
 import Gargantext.API.Ngrams
+import Gargantext.API.Ngrams.Tools -- (getListNgrams)
+import Gargantext.API.Ngrams.Types
 import Gargantext.Core.Types.Main
 import Gargantext.Database.Schema.Ngrams
+import qualified Data.List as List
+import qualified Data.Map as Map
+import qualified Data.Set as Set
+
+
+{-
+flowSocialList :: ( RepoCmdM env err m
+                        , CmdM     env err m
+                        , HasNodeError err
+                        , HasTreeError err
+                        )
+                     => NodeMode -> User -> NgramsType -> Set Text
+                     -> m (Map (Maybe ListType) (Set Text))
+flowSocialList mode user nt ngrams' = do
+  privateMapList <- flowSocialListByMode Private user nt ngrams'
+  sharedMapList  <- flowSocialListByMode Shared  user nt (fromMaybe Set.empty $
+  -- TODO publicMapList
+-}
 
+flowSocialListByMode :: ( RepoCmdM env err m
+                        , CmdM     env err m
+                        , HasNodeError err
+                        , HasTreeError err
+                        )
+                     => NodeMode -> User -> NgramsType -> Set Text
+                     -> m (Map (Maybe ListType) (Set Text))
+flowSocialListByMode mode user nt ngrams' = do
+  listIds <- findListsId mode user
+  counts  <- countFilterList ngrams' nt listIds Map.empty
+  pure $ toSocialList counts ngrams'
 
 ---------------------------------------------------------------------------
 -- TODO: maybe use social groups too
 toSocialList :: Map Text (Map ListType Int)
              -> Set Text
-             -> Set (Text, Maybe ListType)
-toSocialList m = Set.map (toSocialList1 m)
+             -> Map (Maybe ListType) (Set Text)
+toSocialList m = Map.fromListWith (<>)
+               . Set.toList
+               . Set.map (toSocialList1 m)
 
 -- | TODO what if equality ?
 -- choice depends on Ord instance of ListType
@@ -53,10 +79,12 @@ toSocialList m = Set.map (toSocialList1 m)
 -- (we minimize errors on MapTerms if doubt)
 toSocialList1 :: Map Text (Map ListType Int)
              -> Text
-             -> (Text, Maybe ListType)
+             -> (Maybe ListType, Set Text)
 toSocialList1 m t = case Map.lookup t m of
-  Nothing -> (t, Nothing)
-  Just  m -> (t, (fst . fst) <$> Map.maxViewWithKey m)
+  Nothing -> (Nothing, Set.singleton t)
+  Just  m' -> ( (fst . fst) <$> Map.maxViewWithKey m'
+              , Set.singleton t
+              )
 
 ---------------------------------------------------------------------------
 -- | [ListId] does not merge the lists (it is for Master and User lists
@@ -65,7 +93,8 @@ countFilterList :: RepoCmdM env err m
         => Set Text -> NgramsType -> [ListId]
         -> Map Text (Map ListType Int)
         -> m (Map Text (Map ListType Int))
-countFilterList st nt ls input = foldM' (\m l -> countFilterList' st nt [l] m) input ls
+countFilterList st nt ls input =
+  foldM' (\m l -> countFilterList' st nt [l] m) input ls
 
 
 countFilterList' :: RepoCmdM env err m
@@ -73,46 +102,46 @@ countFilterList' :: RepoCmdM env err m
         -> Map Text (Map ListType Int)
         -> m (Map Text (Map ListType Int))
 countFilterList' st nt ls input = do
-  ml <- toMapListType <$> getListNgrams ls nt
+  ml <- toMapTextListType <$> getListNgrams ls nt
   pure $ Set.foldl' (\m t -> countList t ml m) input st
 
 ---------------------------------------------------------------------------
-toMapListType :: Map Text NgramsRepoElement -> Map Text ListType
-toMapListType = Map.fromListWith (<>)
+toMapTextListType :: Map Text NgramsRepoElement -> Map Text ListType
+toMapTextListType = Map.fromListWith (<>)
               . List.concat
               . (map toList)
               . Map.toList
 
 toList :: (Text, NgramsRepoElement) -> [(Text, ListType)]
-toList (t, NgramsRepoElement _ lt r parent (MSet children)) =
+toList (t, NgramsRepoElement _ lt root parent (MSet children)) =
      List.zip terms (List.cycle [lt])
       where
         terms =  [t]
+              <> maybe [] (\n -> [unNgramsTerm n]) root
               <> maybe [] (\n -> [unNgramsTerm n]) parent
               <> (map unNgramsTerm $ Map.keys children)
 
 ---------------------------------------------------------------------------
-
 countList :: Text
           -> Map Text ListType
           -> Map Text (Map ListType Int)
           -> Map Text (Map ListType Int)
 countList t m input = case Map.lookup t m of
   Nothing -> input
-  Just l  -> Map.alter add t input
+  Just l  -> Map.alter addList t input
     where
-      add Nothing   = Just $ addCount l Map.empty
-      add (Just lm) = Just $ addCount l lm
+      addList Nothing   = Just $ addCount l Map.empty
+      addList (Just lm) = Just $ addCount l lm
 
 addCount :: ListType -> Map ListType Int -> Map ListType Int
-addCount l m = Map.alter add l  m
+addCount l m = Map.alter plus l  m
   where
-    add Nothing  = Just 1
-    add (Just x) = Just $ x + 1
+    plus Nothing  = Just 1
+    plus (Just x) = Just $ x + 1
 
 ------------------------------------------------------------------------
-
-findListsId :: (HasNodeError err, HasTreeError err) => NodeMode -> User -> Cmd err [NodeId]
+findListsId :: (HasNodeError err, HasTreeError err)
+            => NodeMode -> User -> Cmd err [NodeId]
 findListsId mode u = do
   r <- getRootId u
   map _dt_nodeId <$> filter (\n -> _dt_typeId n == nodeTypeId NodeList)
@@ -122,5 +151,5 @@ findNodes' :: HasTreeError err
           => NodeMode -> RootId
           -> Cmd err [DbTreeNode]
 findNodes' Private r = findNodes Private r [NodeFolderPrivate, NodeCorpus, NodeList]
-findNodes' Shared  r = findNodes Shared  r [NodeFolderShared, NodeCorpus, NodeList]
-findNodes' Public  r = findNodes Public  r [NodeFolderPublic, NodeCorpus, NodeList]
+findNodes' Shared  r = findNodes Shared  r [NodeFolderShared , NodeCorpus, NodeList]
+findNodes' Public  r = findNodes Public  r [NodeFolderPublic , NodeCorpus, NodeList]