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

   1 {-|
   2 Module      : Gargantext.Core.Text.List.Social
   3 Description :
   4 Copyright   : (c) CNRS, 2018-Present
   5 License     : AGPL + CECILL v3
   6 Maintainer  : team@gargantext.org
   7 Stability   : experimental
   8 Portability : POSIX
   9 -}
  10
  11 module Gargantext.Core.Text.List.Social
  12   where
  13
  14 import Data.Monoid (mconcat)
  15 import Data.Text (Text)
  16 import Gargantext.API.Ngrams.Tools -- (getListNgrams)
  17 import Gargantext.API.Ngrams.Types
  18 import Gargantext.Core.Text.List.Social.Find
  19 import Gargantext.Core.Text.List.Social.Prelude
  20 import Gargantext.Core.Text.List.Social.Scores
  21 import Gargantext.Core.Types.Individu
  22 import Gargantext.Database.Admin.Types.Node
  23 import Gargantext.Database.Prelude
  24 import Gargantext.Database.Query.Table.Node.Error
  25 import Gargantext.Database.Query.Tree
  26 import Gargantext.Database.Schema.Ngrams
  27 import Gargantext.Prelude
  28
  29 ------------------------------------------------------------------------
  30 ------------------------------------------------------------------------
  31 ------------------------------------------------------------------------
  32 -- | Main parameters
  33
  34 -- | FlowSocialListPriority
  35 -- Sociological assumption: either private or others (public) first
  36 -- This parameter depends on the user choice
  37 data FlowSocialListPriority = MySelfFirst | OthersFirst
  38
  39 flowSocialListPriority :: FlowSocialListPriority -> [NodeMode]
  40 flowSocialListPriority MySelfFirst = [Private, Shared{-, Public -}]
  41 flowSocialListPriority OthersFirst = reverse $ flowSocialListPriority MySelfFirst
  42
  43
  44 -- | We keep the parents for all ngrams but terms
  45 keepAllParents :: NgramsType -> KeepAllParents
  46 keepAllParents NgramsTerms = KeepAllParents False
  47 keepAllParents _           = KeepAllParents True
  48
  49
  50 ------------------------------------------------------------------------
  51 flowSocialList' :: ( RepoCmdM env err m
  52                    , CmdM     env err m
  53                    , HasNodeError err
  54                    , HasTreeError err
  55                    )
  56                   => FlowSocialListPriority
  57                   -> User -> NgramsType
  58                   -> FlowCont Text FlowListScores
  59                   -> m (FlowCont Text FlowListScores)
  60 flowSocialList' flowPriority user nt flc =
  61   mconcat <$> mapM (flowSocialListByMode'   user nt flc)
  62                    (flowSocialListPriority flowPriority)
  63     where
  64
  65       flowSocialListByMode' :: ( RepoCmdM env err m
  66                                , CmdM     env err m
  67                                , HasNodeError err
  68                                , HasTreeError err
  69                                )
  70                             => User -> NgramsType
  71                             -> FlowCont Text FlowListScores
  72                             -> NodeMode
  73                             -> m (FlowCont Text FlowListScores)
  74       flowSocialListByMode' user' nt' flc' mode =
  75             findListsId user' mode
  76         >>= flowSocialListByModeWith nt' flc'
  77
  78
  79       flowSocialListByModeWith :: ( RepoCmdM env err m
  80                                   , CmdM     env err m
  81                                   , HasNodeError err
  82                                   , HasTreeError err
  83                                   )
  84                                => NgramsType
  85                                -> FlowCont Text FlowListScores
  86                                -> [NodeId]
  87                                -> m (FlowCont Text FlowListScores)
  88       flowSocialListByModeWith nt'' flc'' ns =
  89             mapM (\l -> getListNgrams [l] nt'') ns
  90         >>= pure
  91           . toFlowListScores (keepAllParents nt'') flc''
  92
  93