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