[FEAT] SocialList refactor, Type ListType Ord fixed

src/Gargantext/Core/Text/List.hs

@@ -129,7 +129,7 @@ buildNgramsTermsList user uCid mCid groupParams = do
   printDebug "\n * socialLists * \n" socialLists
 
   let
-    socialStop  = fromMaybe Set.empty $ Map.lookup StopTerm      socialLists
+    _socialStop = fromMaybe Set.empty $ Map.lookup StopTerm      socialLists
     _socialMap  = fromMaybe Set.empty $ Map.lookup MapTerm       socialLists
     _socialCand = fromMaybe Set.empty $ Map.lookup CandidateTerm socialLists
     -- stopTerms ignored for now (need to be tagged already)

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

@@ -20,6 +20,7 @@ import Gargantext.API.Ngrams.Tools -- (getListNgrams)
 import Gargantext.API.Ngrams.Types
 import Gargantext.Core.Text.List.Social.Find
 import Gargantext.Core.Text.List.Social.ListType
+import Gargantext.Core.Text.List.Social.Group
 import Gargantext.Core.Types.Individu
 import Gargantext.Core.Types.Main
 import Gargantext.Database.Admin.Types.Node
@@ -54,10 +55,11 @@ flowSocialList user nt ngrams' = do
   -- publicListIds <- findListsId Public user
   -- publicLists   <- flowSocialListByMode' publicListIds nt (termsByList CandidateTerm privateLists)
 
-  let result = unions [ Map.mapKeys (fromMaybe CandidateTerm) privateLists
-                      , Map.mapKeys (fromMaybe CandidateTerm) sharedLists
-                      -- , Map.mapKeys (fromMaybe CandidateTerm) publicLists
-                      ]
+  let result = parentUnionsExcl
+             [ Map.mapKeys (fromMaybe CandidateTerm) privateLists
+             , Map.mapKeys (fromMaybe CandidateTerm) sharedLists
+             -- , Map.mapKeys (fromMaybe CandidateTerm) publicLists
+             ]
   -- printDebug "* socialLists *: results \n" result
   pure result
 
@@ -76,6 +78,17 @@ flowSocialListByMode listIds  nt ngrams' = do
     pure r
 
 
+flowSocialListByMode' :: ( RepoCmdM env err m
+                       , CmdM     env err m
+                       , HasNodeError err
+                       , HasTreeError err
+                       )
+                    => [NodeId]-> NgramsType -> Set Text
+                    -> m (Map Text FlowListScores)
+flowSocialListByMode' ns nt st = do
+  ngramsRepos <- mapM (\l -> getListNgrams [l] nt) ns
+  pure $ toFlowListScores st Map.empty ngramsRepos
+
 ------------------------------------------------------------------------
 -- TODO: maybe use social groups too
 -- | TODO what if equality ?
@@ -111,7 +124,6 @@ toSocialList1_testIsTrue = result == (Just MapTerm, Set.singleton token)
 
 ------------------------------------------------------------------------
 -- | Tools
-
 ------------------------------------------------------------------------
 termsByList :: ListType -> (Map (Maybe ListType) (Set Text)) -> Set Text
 termsByList CandidateTerm m = Set.unions
@@ -121,8 +133,6 @@ termsByList l m =
   fromMaybe Set.empty $ Map.lookup (Just l) m
 
 ------------------------------------------------------------------------
-
-
 unions :: (Ord a, Semigroup a, Semigroup b, Ord b)
       => [Map a (Set b)] -> Map a (Set b)
 unions = invertBack . Map.unionsWith (<>) . map invertForw

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

@@ -21,20 +21,6 @@ import Gargantext.Database.Query.Tree
 import Gargantext.Database.Query.Tree.Root (getRootId)
 import Gargantext.Prelude
 
--- filterList imports
-import Data.Maybe (fromMaybe)
-import Data.Map (Map)
-import Data.Set (Set)
-import Data.Semigroup (Semigroup(..))
-import Data.Text (Text)
-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
-
 ------------------------------------------------------------------------
 findListsId :: (HasNodeError err, HasTreeError err)
             => NodeMode -> User -> Cmd err [NodeId]

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

@@ -20,18 +20,12 @@ module Gargantext.Core.Text.List.Social.Group
 
 import Control.Lens
 import Data.Map (Map)
-import Data.Maybe (fromMaybe)
 import Data.Semigroup (Semigroup(..))
 import Data.Set (Set)
 import Data.Text (Text)
 import GHC.Generics (Generic)
 import Gargantext.API.Ngrams.Types
-import Gargantext.Core.Types.Individu
 import Gargantext.Core.Types.Main
-import Gargantext.Database.Admin.Config
-import Gargantext.Database.Admin.Types.Node
-import Gargantext.Database.Prelude
-import Gargantext.Database.Query.Table.Node.Error
 import Gargantext.Prelude
 import qualified Data.Map   as Map
 import qualified Data.Set   as Set
@@ -58,7 +52,6 @@ parentUnionsExcl :: Ord a
 parentUnionsExcl = Map.unions
 
 ------------------------------------------------------------------------
-
 type Parent = Text
 
 hasParent :: Text
@@ -68,8 +61,8 @@ hasParent t m = case Map.lookup t m of
   Nothing  -> Nothing
   Just  m' -> (fst . fst) <$> Map.maxViewWithKey m'
 
-------------------------------------------------------------------------
 
+------------------------------------------------------------------------
 data FlowListScores =
   FlowListScores { _flc_parents :: Map Parent   Int
                  , _flc_lists   :: Map ListType Int
@@ -80,13 +73,18 @@ data FlowListScores =
 
 makeLenses ''FlowListScores
 
+instance Semigroup FlowListScores where
+  (<>) (FlowListScores p1 l1) (FlowListScores p2 l2) =
+    FlowListScores (p1 <> p2) (l1 <> l2)
+
 ------------------------------------------------------------------------
--- | toFlowListScores which generate Score from list of Map Text NgramsRepoElement
+-- | toFlowListScores which generate Score from list of Map Text
+--   NgramsRepoElement
 
 toFlowListScores :: Set Text
-                -> Map Text FlowListScores
+                ->  Map Text FlowListScores
                 -> [Map Text NgramsRepoElement]
-                -> Map Text FlowListScores
+                ->  Map Text FlowListScores
 toFlowListScores ts = foldl' (toFlowListScores' ts)
   where
     toFlowListScores' :: Set Text
@@ -111,7 +109,7 @@ toFlowListScores ts = foldl' (toFlowListScores' ts)
 -- | Main addFunctions to FlowListScores
 ------------------------------------------------------------------------
 
--- | Very unseful but nice comment:
+-- | Unseful but nice comment:
 -- "this function looks like an ASCII bird"
 addList :: ListType
         -> Maybe FlowListScores

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

@@ -11,22 +11,11 @@ Portability : POSIX
 module Gargantext.Core.Text.List.Social.ListType
   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.Prelude
-
--- filterList imports
-import Data.Maybe (fromMaybe)
 import Data.Map (Map)
 import Data.Set (Set)
-import Data.Semigroup (Semigroup(..))
 import Data.Text (Text)
+import Gargantext.Prelude
 import Gargantext.API.Ngrams.Tools -- (getListNgrams)
 import Gargantext.API.Ngrams.Types
 import Gargantext.Core.Types.Main
@@ -49,9 +38,9 @@ countFilterList st nt ls input =
               => Set Text -> NgramsType -> [ListId]
               ->    Map Text (Map ListType Int)
               -> m (Map Text (Map ListType Int))
-      countFilterList' st nt ls input = do
-        ml <- toMapTextListType <$> getListNgrams ls nt
-        pure $ Set.foldl' (\m t -> countList t ml m) input st
+      countFilterList' st' nt' ls' input' = do
+        ml <- toMapTextListType <$> getListNgrams ls' nt'
+        pure $ Set.foldl' (\m t -> countList t ml m) input' st'
 
 ------------------------------------------------------------------------
 -- FIXME children have to herit the ListType of the parent
@@ -62,20 +51,20 @@ toMapTextListType m = Map.fromListWith (<>)
                     $ Map.toList m
   where
     toList :: Map Text NgramsRepoElement -> (Text, NgramsRepoElement) -> [(Text, ListType)]
-    toList m (t, nre@(NgramsRepoElement _ _ _ _ (MSet children))) =
+    toList m' (t, nre@(NgramsRepoElement _ _ _ _ (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)
-            lt'   = listOf m nre
+            lt'   = listOf m' nre
 
             listOf :: Map Text NgramsRepoElement -> NgramsRepoElement -> ListType
-            listOf m ng = case _nre_parent ng of
+            listOf m'' ng = case _nre_parent ng of
               Nothing -> _nre_list ng
-              Just  p -> case Map.lookup (unNgramsTerm p) m of
-                Just ng' -> listOf m ng'
+              Just  p -> case Map.lookup (unNgramsTerm p) m'' of
+                Just ng' -> listOf m'' ng'
                 Nothing  -> CandidateTerm
                 -- panic "[G.C.T.L.Social.listOf] Nothing: Should Not happen"
 
@@ -93,7 +82,7 @@ countList t m input = case Map.lookup t m of
       addList (Just lm) = Just $ addCountList l lm
 
       addCountList :: ListType -> Map ListType Int -> Map ListType Int
-      addCountList l m = Map.alter (plus l) l  m
+      addCountList l' m' = Map.alter (plus l') l'  m'
         where
           plus CandidateTerm Nothing  = Just 1
           plus CandidateTerm (Just x) = Just $ x + 1

src/Gargantext/Core/Types/Main.hs

@@ -50,7 +50,7 @@ instance ToSchema NodeTree where
 type TypeId     = Int
 -- TODO multiple ListType declaration, remove it
 -- data ListType  =  CandidateTerm | StopTerm | MapTerm
-data ListType  =  StopTerm | CandidateTerm | MapTerm
+data ListType  =  CandidateTerm | StopTerm | MapTerm
   deriving (Generic, Eq, Ord, Show, Read, Enum, Bounded)
 
 instance ToJSON   ListType
@@ -81,7 +81,11 @@ listTypeId CandidateTerm = 1
 listTypeId MapTerm       = 2
 
 fromListTypeId :: ListTypeId -> Maybe ListType
-fromListTypeId i = lookup i $ fromList [ (listTypeId l, l) | l <- [minBound..maxBound]]
+fromListTypeId i = lookup i
+                 $ fromList
+                 [ (listTypeId l, l)
+                 | l <- [StopTerm, CandidateTerm, MapTerm]
+                 ]
 
 -- data Metrics = Occurrences | Cooccurrences | Specclusion | Genclusion | Cvalue
 --              | TfidfCorpus | TfidfGlobal   | TirankLocal | TirankGlobal