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
  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 -- | Main parameters
  32
  33 -- | FlowSocialListPriority
  34 -- Sociological assumption: either private or others (public) first
  35 -- This parameter depends on the user choice
  36 data FlowSocialListPriority = MySelfFirst | OthersFirst
  37
  38 flowSocialListPriority :: FlowSocialListPriority -> [NodeMode]
  39 flowSocialListPriority MySelfFirst = [Private, Shared{-, Public -}]
  40 flowSocialListPriority OthersFirst = reverse $ flowSocialListPriority MySelfFirst
  41
  42
  43 -- | We keep the parents for all ngrams but terms
  44 keepAllParents :: NgramsType -> KeepAllParents
  45 keepAllParents NgramsTerms = KeepAllParents False
  46 keepAllParents _           = KeepAllParents True
  47
  48 ------------------------------------------------------------------------
  49 flowSocialList' :: ( RepoCmdM env err m
  50                    , CmdM     env err m
  51                    , HasNodeError err
  52                    , HasTreeError err
  53                    )
  54                   => FlowSocialListPriority
  55                   -> User -> NgramsType
  56                   -> FlowCont Text FlowListScores
  57                   -> m (FlowCont Text FlowListScores)
  58 flowSocialList' flowPriority user nt flc =
  59   mconcat <$> mapM (flowSocialListByMode'   user nt flc)
  60                    (flowSocialListPriority flowPriority)
  61     where
  62
  63       flowSocialListByMode' :: ( RepoCmdM env err m
  64                                , CmdM     env err m
  65                                , HasNodeError err
  66                                , HasTreeError err
  67                                )
  68                             => User -> NgramsType
  69                             -> FlowCont Text FlowListScores
  70                             -> NodeMode
  71                             -> m (FlowCont Text FlowListScores)
  72       flowSocialListByMode' user' nt' flc' mode =
  73             findListsId user' mode
  74         >>= flowSocialListByModeWith nt' flc'
  75
  76
  77       flowSocialListByModeWith :: ( RepoCmdM env err m
  78                                   , CmdM     env err m
  79                                   , HasNodeError err
  80                                   , HasTreeError err
  81                                   )
  82                                => NgramsType
  83                                -> FlowCont Text FlowListScores
  84                                -> [NodeId]
  85                                -> m (FlowCont Text FlowListScores)
  86       flowSocialListByModeWith nt'' flc'' ns =
  87             mapM (\l -> getListNgrams [l] nt'') ns
  88         >>= pure
  89           . toFlowListScores (keepAllParents nt'') flc''