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.Map (Map)
  15 import Data.Monoid (mconcat)
  16 import Data.Text (Text)
  17 import Gargantext.API.Ngrams.Tools
  18 import Gargantext.API.Ngrams.Types
  19 import Gargantext.Core.Text.List.Social.Find
  20 import Gargantext.Core.Text.List.Social.History
  21 import Gargantext.Core.Text.List.Social.Patch
  22 import Gargantext.Core.Text.List.Social.Prelude
  23 import Gargantext.Core.Text.List.Social.Scores
  24 import Gargantext.Core.Types.Individu
  25 import Gargantext.Database.Admin.Types.Node
  26 import Gargantext.Database.Prelude
  27 import Gargantext.Database.Query.Table.Node.Error
  28 import Gargantext.Database.Query.Tree
  29 import Gargantext.Database.Schema.Ngrams
  30 import Gargantext.Prelude
  31
  32 ------------------------------------------------------------------------
  33 ------------------------------------------------------------------------
  34 -- | Main parameters
  35
  36 -- | FlowSocialListPriority
  37 -- Sociological assumption: either private or others (public) first
  38 -- This parameter depends on the user choice
  39 data FlowSocialListPriority = MySelfFirst | OthersFirst
  40
  41 flowSocialListPriority :: FlowSocialListPriority -> [NodeMode]
  42 flowSocialListPriority MySelfFirst = [Private{-, Shared, Public -}]
  43 flowSocialListPriority OthersFirst = reverse $ flowSocialListPriority MySelfFirst
  44
  45
  46 -- | We keep the parents for all ngrams but terms
  47 keepAllParents :: NgramsType -> KeepAllParents
  48 keepAllParents NgramsTerms = KeepAllParents False
  49 keepAllParents _           = KeepAllParents True
  50
  51 ------------------------------------------------------------------------
  52 flowSocialList :: ( RepoCmdM env err m
  53                    , CmdM     env err m
  54                    , HasNodeError err
  55                    , HasTreeError err
  56                    )
  57                   => FlowSocialListPriority
  58                   -> User -> NgramsType
  59                   -> FlowCont Text FlowListScores
  60                   -> m (FlowCont Text FlowListScores)
  61 flowSocialList flowPriority user nt flc =
  62   mconcat <$> mapM (flowSocialListByMode'   user nt flc)
  63                    (flowSocialListPriority flowPriority)
  64     where
  65
  66       flowSocialListByMode' :: ( RepoCmdM env err m
  67                                , CmdM     env err m
  68                                , HasNodeError err
  69                                , HasTreeError err
  70                                )
  71                             => User -> NgramsType
  72                             -> FlowCont Text FlowListScores
  73                             -> NodeMode
  74                             -> m (FlowCont Text FlowListScores)
  75       flowSocialListByMode' user' nt' flc' mode =
  76             findListsId user' mode
  77         >>= flowSocialListByModeWith nt' flc'
  78
  79
  80       flowSocialListByModeWith :: ( RepoCmdM env err m
  81                                   , CmdM     env err m
  82                                   , HasNodeError err
  83                                   , HasTreeError err
  84                                   )
  85                                => NgramsType
  86                                -> FlowCont Text FlowListScores
  87                                -> [ListId]
  88                                -> m (FlowCont Text FlowListScores)
  89       flowSocialListByModeWith nt'' flc'' ns =
  90             mapM (\l -> getListNgrams [l] nt'') ns
  91         >>= pure
  92           . toFlowListScores (keepAllParents nt'') flc''
  93
  94 -----------------------------------------------------------------
  95
  96
  97 getHistory :: ( RepoCmdM env err m
  98               , CmdM     env err m
  99               , HasNodeError err
 100               , HasTreeError err
 101               )
 102            => History
 103            -> NgramsType
 104            -> [ListId]
 105            -> m (Map NgramsType (Map ListId [Map NgramsTerm NgramsPatch]))
 106 getHistory hist nt listes =
 107   history hist [nt] listes  <$> getRepo
 108
 109
 110 getHistoryScores :: ( RepoCmdM env err m
 111                     , CmdM     env err m
 112                     , HasNodeError err
 113                     , HasTreeError err
 114                     )
 115                  => History
 116                  -> NgramsType
 117                  -> FlowCont Text FlowListScores
 118                  -> [ListId]
 119                  -> m (FlowCont Text FlowListScores)
 120 getHistoryScores hist nt fl listes =
 121   addScorePatches nt listes fl <$> getHistory hist nt listes
 122
 123
 124