diff --git a/src/Gargantext/Core/Text/List.hs b/src/Gargantext/Core/Text/List.hs
index 3c1fad3a2f17e4c8f9c18e52a2180ad5e5d2fd77..3e82a10bfe1021d07b0269cb9675b17a5ae0941f 100644
--- a/src/Gargantext/Core/Text/List.hs
+++ b/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'"
diff --git a/src/Gargantext/Core/Text/List/Group.hs b/src/Gargantext/Core/Text/List/Group.hs
index ed29365558876377f968ed8a672fdf08d5fa8c84..195725703578f546f73c66de73b6214644b17286 100644
--- a/src/Gargantext/Core/Text/List/Group.hs
+++ b/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
diff --git a/src/Gargantext/Core/Text/List/Group/WithScores.hs b/src/Gargantext/Core/Text/List/Group/WithScores.hs
index 59567a2762f739ce5803b07a74f36a76c0655419..067f653afd34dc02aab299289d47aa393fc3a73d 100644
--- a/src/Gargantext/Core/Text/List/Group/WithScores.hs
+++ b/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
diff --git a/src/Gargantext/Core/Text/List/Social.hs b/src/Gargantext/Core/Text/List/Social.hs
index b6d315cf127d533afa23913744dbe398c042b380..2ef1db637a8d7df5a2886c43b495b211d20f65af 100644
--- a/src/Gargantext/Core/Text/List/Social.hs
+++ b/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
diff --git a/src/Gargantext/Core/Text/List/Social/Prelude.hs b/src/Gargantext/Core/Text/List/Social/Prelude.hs
index ca5b8198f6e15b7d91958cf9312dade26ae68390..eb01603a5dc3b1aa287acaa779dd706e0f99708a 100644
--- a/src/Gargantext/Core/Text/List/Social/Prelude.hs
+++ b/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
diff --git a/src/Gargantext/Core/Text/List/Social/Scores.hs b/src/Gargantext/Core/Text/List/Social/Scores.hs
index a5896007bc3576153c676303807cfc8d361e2dbc..85f7d16e2ae283023309a2c04d9eec1bbd5db5c5 100644
--- a/src/Gargantext/Core/Text/List/Social/Scores.hs
+++ b/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'