[CLEAN] before adding Continuation FlowList type

src/Gargantext/Core/Text/List.hs

@@ -16,7 +16,7 @@ module Gargantext.Core.Text.List
   where
 
 
-import Control.Lens ((^.), set, view)
+import Control.Lens ((^.), set, view, over)
 import Data.Maybe (fromMaybe, catMaybes)
 import Data.Ord (Down(..))
 import Data.Map (Map)
@@ -31,8 +31,9 @@ import qualified Data.Text as Text
 -- import Gargantext.API.Ngrams.Tools (getCoocByNgrams', Diagonal(..))
 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
+import Gargantext.Core.Text.List.Social.Scores
+import Gargantext.Core.Text.List.Social.Prelude
 import Gargantext.Core.Text.List.Group
 import Gargantext.Core.Text.List.Group.WithStem
 import Gargantext.Core.Text.Metrics (scored', Scored(..), normalizeGlobal, normalizeLocal)
@@ -96,7 +97,10 @@ buildNgramsOthersList user uCid groupIt (nt, MapListSize mapListSize) = do
     groupParams     = GroupedTextParams groupIt (Set.size . snd) fst snd {-(size . fst)-}
     groupedWithList = toGroupedText groupParams socialLists' ngs'
 
-  printDebug "groupedWithList" (Map.map (\v -> (view gt_label v, view gt_children v)) $ Map.filter (\v -> (Set.size $ view gt_children v) > 0) 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
@@ -191,7 +195,7 @@ buildNgramsTermsList user uCid mCid groupParams = do
                                           Nothing -> mapGroups'
                                           Just g  -> case Map.lookup k mapTextDocIds of
                                             Nothing -> mapGroups'
-                                            Just ns -> Map.insert k' ( g { _gt_nodes = Set.union ns (_gt_nodes g)}) mapGroups'
+                                            Just ns -> Map.insert k' (over gt_nodes (Set.union ns) g) mapGroups'
                            )
                   mapGroups
                   $ Map.keys mapTextDocIds

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

@@ -134,12 +134,12 @@ keepAllParents NgramsTerms = KeepAllParents False
 keepAllParents _           = KeepAllParents True
 
 ------------------------------------------------------------------------
--- TODO: maybe use social groups too
--- | TODO what if equality ?
--- choice depends on Ord instance of ListType
+-- | Choice depends on Ord instance of ListType
 -- for now : data ListType  =  StopTerm | CandidateTerm | MapTerm
 -- means MapTerm > CandidateTerm > StopTerm in case of equality of counts
 -- (we minimize errors on MapTerms if doubt)
+--  * TODO what if equality ?
+--  * TODO maybe use social groups too
 toSocialList :: Map Text (Map ListType Int)
              -> Set Text
              -> Map (Maybe ListType) (Set Text)
@@ -166,35 +166,4 @@ toSocialList1_testIsTrue = result == (Just MapTerm, Set.singleton token)
                      , (StopTerm     , 3)
                      ]
 
-------------------------------------------------------------------------
--- | Tools
-------------------------------------------------------------------------
-termsByList :: ListType -> (Map (Maybe ListType) (Set Text)) -> Set Text
-termsByList CandidateTerm m = Set.unions
-                          $ map (\lt -> fromMaybe Set.empty $ Map.lookup lt m)
-                          [ Nothing, Just CandidateTerm ]
-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
-
-invertForw :: (Ord b, Semigroup a) => Map a (Set b) -> Map b a
-invertForw = Map.unionsWith (<>)
-           . (map (\(k,sets) -> Map.fromSet (\_ -> k) sets))
-           . Map.toList
-
-invertBack :: (Ord a, Ord b) => Map b a -> Map a (Set b)
-invertBack = Map.fromListWith (<>)
-           . (map (\(b,a) -> (a, Set.singleton b)))
-           .  Map.toList
-
-unions_test :: Map ListType (Set Text)
-unions_test = unions [m1, m2]
-  where
-    m1 = Map.fromList [ (StopTerm     , Set.singleton "Candidate")]
-    m2 = Map.fromList [ (CandidateTerm, Set.singleton "Candidate")
-                      , (MapTerm      , Set.singleton "Candidate")
-                      ]

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

@@ -18,10 +18,16 @@ Portability : POSIX
 module Gargantext.Core.Text.List.Social.Prelude
   where
 
+import Data.Semigroup (Semigroup(..))
 import Data.Map (Map)
+import Data.Maybe (fromMaybe)
+import Data.Set (Set)
 import Data.Text (Text)
+import Gargantext.Core.Types.Main
 import Gargantext.Prelude
 import qualified Data.Map   as Map
+import qualified Data.Set   as Set
+
 
 ------------------------------------------------------------------------
 -- | Tools to inherit groupings
@@ -56,3 +62,38 @@ hasParent t m = case Map.lookup t m of
 ------------------------------------------------------------------------
 keyWithMaxValue :: Map a b -> Maybe a
 keyWithMaxValue m = (fst . fst) <$> Map.maxViewWithKey m
+
+
+
+------------------------------------------------------------------------
+-- | Tools TODO clean it (some need to be removed)
+------------------------------------------------------------------------
+termsByList :: ListType -> (Map (Maybe ListType) (Set Text)) -> Set Text
+termsByList CandidateTerm m = Set.unions
+                          $ map (\lt -> fromMaybe Set.empty $ Map.lookup lt m)
+                          [ Nothing, Just CandidateTerm ]
+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
+
+invertForw :: (Ord b, Semigroup a) => Map a (Set b) -> Map b a
+invertForw = Map.unionsWith (<>)
+           . (map (\(k,sets) -> Map.fromSet (\_ -> k) sets))
+           . Map.toList
+
+invertBack :: (Ord a, Ord b) => Map b a -> Map a (Set b)
+invertBack = Map.fromListWith (<>)
+           . (map (\(b,a) -> (a, Set.singleton b)))
+           .  Map.toList
+
+unions_test :: Map ListType (Set Text)
+unions_test = unions [m1, m2]
+  where
+    m1 = Map.fromList [ (StopTerm     , Set.singleton "Candidate")]
+    m2 = Map.fromList [ (CandidateTerm, Set.singleton "Candidate")
+                      , (MapTerm      , Set.singleton "Candidate")
+                      ]

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

@@ -14,7 +14,6 @@ Portability : POSIX
 {-# LANGUAGE TypeOperators     #-}
 {-# LANGUAGE TypeFamilies      #-}
 
-
 module Gargantext.Core.Text.List.Social.Scores
   where
 
@@ -32,6 +31,12 @@ import qualified Data.Map   as Map
 import qualified Data.Set   as Set
 
 ------------------------------------------------------------------------
+-- | DataType inspired by continuation Monad (but simpler)
+data FlowListCont a =
+  FlowListCont { _flc_scores :: Map a FlowListScores
+               , _flc_cont   :: Set a
+               }
+
 -- | Datatype definition
 data FlowListScores =
   FlowListScores { _fls_parents  :: Map Parent   Int
@@ -41,10 +46,15 @@ data FlowListScores =
                  }
     deriving (Show, Generic)
 
+------------------------------------------------------------------------
+makeLenses ''FlowListCont
 makeLenses ''FlowListScores
 
 -- | Rules to compose 2 datatype FlowListScores
+-- About the shape of the Type fun:
 -- Triangle de Pascal, nombre d'or ou pi ?
+-- Question: how to add a score field and derive such definition
+-- without the need to fix it below ?
 instance Semigroup FlowListScores where
   (<>) (FlowListScores p1 l1)
        (FlowListScores p2 l2) =
@@ -147,3 +157,4 @@ addParent' (KeepAllParents k) (Just (NgramsTerm p')) ss mapParent =
         addCount (Just n) = Just $ n + 1
 
 ------------------------------------------------------------------------
+------------------------------------------------------------------------