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.HashMap.Strict (HashMap)
  15 import Data.Map (Map)
  16 import Data.Monoid (mconcat)
  17 import Gargantext.API.Ngrams.Tools
  18 import Gargantext.API.Ngrams.Types
  19 import Gargantext.Core.NodeStory
  20 import Gargantext.Core.Text.List.Social.Find
  21 import Gargantext.Core.Text.List.Social.History
  22 import Gargantext.Core.Text.List.Social.Patch
  23 import Gargantext.Core.Text.List.Social.Prelude
  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
  40 data FlowSocialListWith = FlowSocialListWithPriority { fslw_priority :: FlowSocialListPriority }
  41                         | FlowSocialListWithLists    { fslw_lists :: [ListId] }
  42
  43
  44 data FlowSocialListPriority = MySelfFirst | OthersFirst
  45 flowSocialListPriority :: FlowSocialListPriority -> [NodeMode]
  46 flowSocialListPriority MySelfFirst = [Private{-, Shared, Public -}]
  47 flowSocialListPriority OthersFirst = reverse $ flowSocialListPriority MySelfFirst
  48
  49 {-
  50 -- | We keep the parents for all ngrams but terms
  51 keepAllParents :: NgramsType -> KeepAllParents
  52 keepAllParents NgramsTerms = KeepAllParents False
  53 keepAllParents _           = KeepAllParents True
  54 -}
  55
  56 ------------------------------------------------------------------------
  57 flowSocialList :: ( HasNodeStory env err m
  58                    , CmdM     env err m
  59                    , HasNodeError err
  60                    , HasTreeError err
  61                    )
  62                   => Maybe FlowSocialListWith
  63                   -> User
  64                   -> NgramsType
  65                   -> FlowCont NgramsTerm FlowListScores
  66                   -> m (FlowCont NgramsTerm FlowListScores)
  67 flowSocialList Nothing u = flowSocialList' MySelfFirst u
  68 flowSocialList (Just (FlowSocialListWithPriority p)) u = flowSocialList' p u
  69 flowSocialList (Just (FlowSocialListWithLists    ls)) _ = getHistoryScores ls History_User
  70
  71 flowSocialList' :: ( HasNodeStory env err m
  72                    , CmdM     env err m
  73                    , HasNodeError err
  74                    , HasTreeError err
  75                    )
  76                   => FlowSocialListPriority
  77                   -> User -> NgramsType
  78                   -> FlowCont NgramsTerm FlowListScores
  79                   -> m (FlowCont NgramsTerm FlowListScores)
  80 flowSocialList' flowPriority user nt flc =
  81   mconcat <$> mapM (flowSocialListByMode'   user nt flc)
  82                    (flowSocialListPriority flowPriority)
  83     where
  84
  85       flowSocialListByMode' :: ( HasNodeStory env err m
  86                                , CmdM     env err m
  87                                , HasNodeError err
  88                                , HasTreeError err
  89                                )
  90                             => User -> NgramsType
  91                             -> FlowCont NgramsTerm FlowListScores
  92                             -> NodeMode
  93                             -> m (FlowCont NgramsTerm FlowListScores)
  94       flowSocialListByMode' user' nt' flc' mode =
  95             findListsId user' mode
  96         >>= flowSocialListByModeWith nt' flc'
  97
  98
  99       flowSocialListByModeWith :: ( HasNodeStory env err m
 100                                   , CmdM     env err m
 101                                   , HasNodeError err
 102                                   , HasTreeError err
 103                                   )
 104                                => NgramsType
 105                                -> FlowCont NgramsTerm FlowListScores
 106                                -> [ListId]
 107                                -> m (FlowCont NgramsTerm FlowListScores)
 108       flowSocialListByModeWith nt'' flc'' listes =
 109         getHistoryScores listes History_User nt'' flc''
 110
 111
 112 -----------------------------------------------------------------
 113 getHistoryScores :: ( HasNodeStory env err m
 114                     , CmdM         env err m
 115                     , HasNodeError     err
 116                     , HasTreeError     err
 117                     )
 118                  => [ListId]
 119                  -> History
 120                  -> NgramsType
 121                  -> FlowCont NgramsTerm FlowListScores
 122                  -> m (FlowCont NgramsTerm FlowListScores)
 123 getHistoryScores lists hist nt fl =
 124   addScorePatches nt lists fl <$> getHistory hist nt lists
 125
 126 getHistory :: ( HasNodeStory env err m
 127               , CmdM     env err m
 128               , HasNodeError err
 129               , HasTreeError err
 130               )
 131            => History
 132            -> NgramsType
 133            -> [ListId]
 134            -> m (Map ListId (Map NgramsType [HashMap NgramsTerm NgramsPatch]))
 135 getHistory hist nt listes =
 136   history hist [nt] listes  <$> getRepo' listes
 137