[TYPE] FlowCont (Flow Continuation) basic type

src/Gargantext/Core/Text/List.hs

@@ -17,36 +17,34 @@ module Gargantext.Core.Text.List
 
 
 import Control.Lens ((^.), set, view, over)
+import Data.Map (Map)
 import Data.Maybe (fromMaybe, catMaybes)
 import Data.Ord (Down(..))
-import Data.Map (Map)
 import Data.Set (Set)
 import Data.Text (Text)
-import qualified Data.Char as Char
-import qualified Data.List as List
-import qualified Data.Map  as Map
-import qualified Data.Set  as Set
-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
-import Gargantext.Core.Text.List.Social.Prelude
 import Gargantext.Core.Text.List.Group
 import Gargantext.Core.Text.List.Group.WithStem
+import Gargantext.Core.Text.List.Social
+import Gargantext.Core.Text.List.Social.Prelude
 import Gargantext.Core.Text.Metrics (scored', Scored(..), normalizeGlobal, normalizeLocal)
 import Gargantext.Core.Types (ListType(..), MasterCorpusId, UserCorpusId)
 import Gargantext.Core.Types.Individu (User(..))
-import Gargantext.Database.Admin.Types.Node (NodeId)
 import Gargantext.Database.Action.Metrics.NgramsByNode (getNodesByNgramsUser, getNodesByNgramsOnlyUser)
 import Gargantext.Database.Action.Metrics.TFICF (getTficf)
+import Gargantext.Database.Admin.Types.Node (NodeId)
 import Gargantext.Database.Prelude (CmdM)
 import Gargantext.Database.Query.Table.Node (defaultList)
 import Gargantext.Database.Query.Table.Node.Error (HasNodeError())
 import Gargantext.Database.Query.Tree.Error (HasTreeError)
 import Gargantext.Database.Schema.Ngrams (NgramsType(..))
 import Gargantext.Prelude
+import qualified Data.Char as Char
+import qualified Data.List as List
+import qualified Data.Map  as Map
+import qualified Data.Set  as Set
+import qualified Data.Text as Text
 
 
 -- | TODO improve grouping functions of Authors, Sources, Institutes..
@@ -86,8 +84,8 @@ buildNgramsOthersList ::( HasNodeError err
 buildNgramsOthersList user uCid groupIt (nt, MapListSize mapListSize) = do
   ngs'  :: Map Text (Set NodeId) <- getNodesByNgramsUser uCid nt
 
-  socialLists' :: FlowListCont Text
-    <- flowSocialList' MySelfFirst user nt (FlowListCont Map.empty $ Set.fromList $ Map.keys ngs')
+  socialLists' :: FlowCont Text FlowListScores
+    <- flowSocialList' MySelfFirst user nt (FlowCont Map.empty $ Set.fromList $ Map.keys ngs')
     -- PrivateFirst for first developments since Public NodeMode is not implemented yet
 
   printDebug "flowSocialList'"

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

@@ -41,7 +41,7 @@ toGroupedText groupParams scores =
   (groupWithStem groupParams) . (groupWithScores scores)
 
 ------------------------------------------------------------------------
--- | WIP, put this in test folder
+-- | TODO put in test folder
 toGroupedText_test :: Bool -- Map Stem (GroupedText Int)
 toGroupedText_test =
   -- fromGroupedScores $ fromListScores from
@@ -93,7 +93,7 @@ toGroupedText_test =
                            ]
 
 ------------------------------------------------------------------------
--- | To be removed
+-- | TODO To be removed
 addListType :: Map Text ListType -> GroupedText a -> GroupedText a
 addListType m g = set gt_listType (hasListType m g) g
   where

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

@@ -80,6 +80,19 @@ groupWithScores scores ms = orphans <> groups
     orphans = addIfNotExist scores ms
 
 
+{-
+groupWithScores :: Map Text FlowListScores
+                -> Map Text (Set NodeId)
+                -> Map Text (GroupedTextScores (Set NodeId))
+groupWithScores scores ms = orphans <> groups
+  where
+    groups = addScore ms
+           $ fromGroupedScores
+           $ fromListScores scores
+    orphans = addIfNotExist scores ms
+-}
+
+
 ------------------------------------------------------------------------
 addScore :: Map Text (Set NodeId)
          -> Map Text (GroupedTextScores (Set NodeId))
@@ -108,12 +121,10 @@ addIfNotExist mapSocialScores mapScores =
       add _ _         = Nothing -- should not be present
 
 ------------------------------------------------------------------------
-{-
 toGroupedTextScores' :: Map Parent GroupedWithListScores
-                     -> Map Text (Set NodeId)
+                     -- -> Map Text (Set NodeId)
                      -> Map Parent (GroupedTextScores' (Set NodeId))
-toGroupedTextScores' par datas = undefined
--}
+toGroupedTextScores' par = undefined
 
 ------------------------------------------------------------------------
 fromGroupedScores :: Map Parent GroupedWithListScores

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

@@ -62,45 +62,44 @@ flowSocialList' :: ( RepoCmdM env err m
                    )
                   => FlowSocialListPriority
                   -> User -> NgramsType
-                  -> FlowListCont Text
-                  -> m (FlowListCont Text)
+                  -> FlowCont Text FlowListScores
+                  -> m (FlowCont Text FlowListScores)
 flowSocialList' flowPriority user nt flc =
   mconcat <$> mapM (flowSocialListByMode' user nt flc)
                    (flowSocialListPriority flowPriority)
-
-------------------------------------------------------------------------
-
-flowSocialListByMode' :: ( RepoCmdM env err m
-                         , CmdM     env err m
-                         , HasNodeError err
-                         , HasTreeError err
-                         )
-                      => User -> NgramsType
-                      -> FlowListCont Text
-                      -> NodeMode
-                      -> m (FlowListCont Text)
-flowSocialListByMode' user nt flc mode =
-      findListsId user mode
-  >>= flowSocialListByModeWith nt flc
-
-
-flowSocialListByModeWith :: ( RepoCmdM env err m
-                            , CmdM     env err m
-                            , HasNodeError err
-                            , HasTreeError err
-                            )
-                         => NgramsType
-                         -> FlowListCont Text
-                         -> [NodeId]
-                         -> m (FlowListCont Text)
-flowSocialListByModeWith nt flc ns =
-      mapM (\l -> getListNgrams [l] nt) ns
-  >>= pure
-    . toFlowListScores (keepAllParents nt) flc
-
-
-
----8<-TODO-ALL BELOW--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<-
+    where
+
+      flowSocialListByMode' :: ( RepoCmdM env err m
+                               , CmdM     env err m
+                               , HasNodeError err
+                               , HasTreeError err
+                               )
+                            => User -> NgramsType
+                            -> FlowCont Text FlowListScores
+                            -> NodeMode
+                            -> m (FlowCont Text FlowListScores)
+      flowSocialListByMode' user' nt' flc' mode =
+            findListsId user' mode
+        >>= flowSocialListByModeWith nt' flc'
+
+
+      flowSocialListByModeWith :: ( RepoCmdM env err m
+                                  , CmdM     env err m
+                                  , HasNodeError err
+                                  , HasTreeError err
+                                  )
+                               => NgramsType
+                               -> FlowCont Text FlowListScores
+                               -> [NodeId]
+                               -> m (FlowCont Text FlowListScores)
+      flowSocialListByModeWith nt'' flc'' ns =
+            mapM (\l -> getListNgrams [l] nt'') ns
+        >>= pure
+          . toFlowListScores (keepAllParents nt'') flc''
+
+
+
+---8<-TODO-REMOVE ALL BELOW--8<--8<-- 8<-- 8<--8<--8<--
 
 -- | Choice depends on Ord instance of ListType
 -- for now : data ListType  =  StopTerm | CandidateTerm | MapTerm

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

@@ -35,20 +35,20 @@ import qualified Data.Set   as Set
 type Parent = Text
 ------------------------------------------------------------------------
 -- | DataType inspired by continuation Monad (but simpler)
-data FlowListCont a =
-  FlowListCont { _flc_scores :: Map a FlowListScores
+data FlowCont a b =
+  FlowCont { _flc_scores :: Map a b
                , _flc_cont   :: Set a
                }
 
-instance Ord a => Monoid (FlowListCont a) where
-  mempty = FlowListCont Map.empty Set.empty
+instance Ord a => Monoid (FlowCont a b) where
+  mempty = FlowCont Map.empty Set.empty
 
-instance (Eq a, Ord a) => Semigroup (FlowListCont a) where
-  (<>) (FlowListCont m1 s1)
-       (FlowListCont m2 s2)
-          | s1 == Set.empty = FlowListCont m s2
-          | s2 == Set.empty = FlowListCont m s1
-          | otherwise       = FlowListCont m (Set.intersection s1 s2)
+instance (Eq a, Ord a) => Semigroup (FlowCont a b) where
+  (<>) (FlowCont m1 s1)
+       (FlowCont m2 s2)
+          | s1 == Set.empty = FlowCont m s2
+          | s2 == Set.empty = FlowCont m s1
+          | otherwise       = FlowCont m (Set.intersection s1 s2)
             where
               m = Map.union m1 m2
 
@@ -64,7 +64,7 @@ data FlowListScores =
 
 
 ------------------------------------------------------------------------
-makeLenses ''FlowListCont
+makeLenses ''FlowCont
 makeLenses ''FlowListScores
 
 -- | Rules to compose 2 datatype FlowListScores

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

@@ -32,18 +32,18 @@ import qualified Data.Set   as Set
 ------------------------------------------------------------------------
 -- | Generates Score from list of Map Text NgramsRepoElement
 toFlowListScores :: KeepAllParents
-                 ->  FlowListCont Text
+                 ->  FlowCont Text FlowListScores
                  -> [Map Text NgramsRepoElement]
-                 ->  FlowListCont Text
+                 ->  FlowCont Text FlowListScores
 toFlowListScores k flc_origin = foldl' (toFlowListScores_Level1 k flc_origin) mempty
 
   where
 
     toFlowListScores_Level1 :: KeepAllParents
-                     -> FlowListCont Text
-                     -> FlowListCont Text
+                     -> FlowCont Text FlowListScores
+                     -> FlowCont Text FlowListScores
                      -> Map Text NgramsRepoElement
-                     -> FlowListCont Text
+                     -> FlowCont Text FlowListScores
     toFlowListScores_Level1 k' flc_origin' flc_dest ngramsRepo =
       Set.foldl' (toFlowListScores_Level2 k' ngramsRepo flc_origin')
                  flc_dest
@@ -52,10 +52,10 @@ toFlowListScores k flc_origin = foldl' (toFlowListScores_Level1 k flc_origin) me
 
     toFlowListScores_Level2 :: KeepAllParents
                        -> Map Text NgramsRepoElement
-                       -> FlowListCont Text
-                       -> FlowListCont Text
+                       -> FlowCont Text FlowListScores
+                       -> FlowCont Text FlowListScores
                        -> Text
-                       -> FlowListCont Text
+                       -> FlowCont Text FlowListScores
     toFlowListScores_Level2 k'' ngramsRepo flc_origin'' flc_dest' t =
       case Map.lookup t ngramsRepo of
         Nothing  -> over flc_cont (Set.insert t) flc_dest'