Commit 2dae3522 authored by Alexandre Delanoë's avatar Alexandre Delanoë

[FEAT] SocialList refactoring

parent 4a5e83c1
...@@ -29,7 +29,7 @@ import qualified Data.Text as Text ...@@ -29,7 +29,7 @@ import qualified Data.Text as Text
-- import Gargantext.API.Ngrams.Tools (getCoocByNgrams', Diagonal(..)) -- import Gargantext.API.Ngrams.Tools (getCoocByNgrams', Diagonal(..))
import Gargantext.API.Ngrams.Types (NgramsElement, mkNgramsElement, NgramsTerm(..), RootParent(..), mSetFromList) import Gargantext.API.Ngrams.Types (NgramsElement, mkNgramsElement, NgramsTerm(..), RootParent(..), mSetFromList)
import Gargantext.API.Ngrams.Types (RepoCmdM) import Gargantext.API.Ngrams.Types (RepoCmdM)
import Gargantext.Core.Text.List.Social (flowSocialList, invertForw) import Gargantext.Core.Text.List.Social (flowSocialList, flowSocialList', FlowSocialListPriority(..), invertForw)
import Gargantext.Core.Text.Metrics (scored', Scored(..), normalizeGlobal, normalizeLocal) import Gargantext.Core.Text.Metrics (scored', Scored(..), normalizeGlobal, normalizeLocal)
import Gargantext.Core.Text.Group import Gargantext.Core.Text.Group
import Gargantext.Core.Types (ListType(..), MasterCorpusId, UserCorpusId) import Gargantext.Core.Types (ListType(..), MasterCorpusId, UserCorpusId)
...@@ -88,6 +88,8 @@ buildNgramsOthersList user uCid groupIt (nt, MapListSize mapListSize) = do ...@@ -88,6 +88,8 @@ buildNgramsOthersList user uCid groupIt (nt, MapListSize mapListSize) = do
$ ngs $ ngs
socialLists <- flowSocialList user nt (Set.fromList $ Map.keys ngs) socialLists <- flowSocialList user nt (Set.fromList $ Map.keys ngs)
-- PrivateFirst for first development since Public is not implemented yet
socialLists' <- flowSocialList' PrivateFirst user nt (Set.fromList $ Map.keys ngs)
let let
groupedWithList = map (addListType (invertForw socialLists)) grouped groupedWithList = map (addListType (invertForw socialLists)) grouped
......
...@@ -63,6 +63,7 @@ flowSocialList user nt ngrams' = do ...@@ -63,6 +63,7 @@ flowSocialList user nt ngrams' = do
-- printDebug "* socialLists *: results \n" result -- printDebug "* socialLists *: results \n" result
pure result pure result
------------------------------------------------------------------------
------------------------------------------------------------------------ ------------------------------------------------------------------------
-- | FlowSocialListPriority -- | FlowSocialListPriority
-- Sociological assumption: either private or others (public) first -- Sociological assumption: either private or others (public) first
...@@ -73,6 +74,7 @@ flowSocialListPriority :: FlowSocialListPriority -> [NodeMode] ...@@ -73,6 +74,7 @@ flowSocialListPriority :: FlowSocialListPriority -> [NodeMode]
flowSocialListPriority PrivateFirst = [Private, Shared{-, Public -}] flowSocialListPriority PrivateFirst = [Private, Shared{-, Public -}]
flowSocialListPriority OthersFirst = reverse $ flowSocialListPriority PrivateFirst flowSocialListPriority OthersFirst = reverse $ flowSocialListPriority PrivateFirst
------------------------------------------------------------------------
flowSocialList' :: ( RepoCmdM env err m flowSocialList' :: ( RepoCmdM env err m
, CmdM env err m , CmdM env err m
, HasNodeError err , HasNodeError err
...@@ -82,7 +84,7 @@ flowSocialList' :: ( RepoCmdM env err m ...@@ -82,7 +84,7 @@ flowSocialList' :: ( RepoCmdM env err m
-> User -> NgramsType -> Set Text -> User -> NgramsType -> Set Text
-> m (Map Text FlowListScores) -> m (Map Text FlowListScores)
flowSocialList' flowPriority user nt ngrams' = flowSocialList' flowPriority user nt ngrams' =
parentUnionsExcl <$> mapM (\m -> flowSocialListByMode' user m nt ngrams') parentUnionsExcl <$> mapM (flowSocialListByMode' user nt ngrams')
(flowSocialListPriority flowPriority) (flowSocialListPriority flowPriority)
...@@ -106,11 +108,11 @@ flowSocialListByMode' :: ( RepoCmdM env err m ...@@ -106,11 +108,11 @@ flowSocialListByMode' :: ( RepoCmdM env err m
, HasNodeError err , HasNodeError err
, HasTreeError err , HasTreeError err
) )
=> User -> NodeMode -> NgramsType -> Set Text => User -> NgramsType -> Set Text -> NodeMode
-> m (Map Text FlowListScores) -> m (Map Text FlowListScores)
flowSocialListByMode' user mode nt st = do flowSocialListByMode' user nt st mode =
listIds <- findListsId user mode findListsId user mode
flowSocialListByModeWith listIds nt st >>= flowSocialListByModeWith nt st
flowSocialListByModeWith :: ( RepoCmdM env err m flowSocialListByModeWith :: ( RepoCmdM env err m
...@@ -118,11 +120,12 @@ flowSocialListByModeWith :: ( RepoCmdM env err m ...@@ -118,11 +120,12 @@ flowSocialListByModeWith :: ( RepoCmdM env err m
, HasNodeError err , HasNodeError err
, HasTreeError err , HasTreeError err
) )
=> [NodeId]-> NgramsType -> Set Text => NgramsType -> Set Text -> [NodeId]
-> m (Map Text FlowListScores) -> m (Map Text FlowListScores)
flowSocialListByModeWith ns nt st = do flowSocialListByModeWith nt st ns =
ngramsRepos <- mapM (\l -> getListNgrams [l] nt) ns mapM (\l -> getListNgrams [l] nt) ns
pure $ toFlowListScores (keepAllParents nt) st Map.empty ngramsRepos >>= pure
. toFlowListScores (keepAllParents nt) st Map.empty
-- | We keep the parents for all ngrams but terms -- | We keep the parents for all ngrams but terms
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment