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 Data.Text (Text)
  18 import Gargantext.API.Ngrams.Tools
  19 import Gargantext.API.Ngrams.Types
  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 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 ------------------------------------------------------------------------
  53 flowSocialList :: ( RepoCmdM env err m
  54                    , CmdM     env err m
  55                    , HasNodeError err
  56                    , HasTreeError err
  57                    )
  58                   => FlowSocialListPriority
  59                   -> User -> NgramsType
  60                   -> FlowCont NgramsTerm FlowListScores
  61                   -> m (FlowCont NgramsTerm FlowListScores)
  62 flowSocialList flowPriority user nt flc =
  63   mconcat <$> mapM (flowSocialListByMode'   user nt flc)
  64                    (flowSocialListPriority flowPriority)
  65     where
  66
  67       flowSocialListByMode' :: ( RepoCmdM env err m
  68                                , CmdM     env err m
  69                                , HasNodeError err
  70                                , HasTreeError err
  71                                )
  72                             => User -> NgramsType
  73                             -> FlowCont NgramsTerm FlowListScores
  74                             -> NodeMode
  75                             -> m (FlowCont NgramsTerm FlowListScores)
  76       flowSocialListByMode' user' nt' flc' mode =
  77             findListsId user' mode
  78         >>= flowSocialListByModeWith nt' flc'
  79
  80
  81       flowSocialListByModeWith :: ( RepoCmdM env err m
  82                                   , CmdM     env err m
  83                                   , HasNodeError err
  84                                   , HasTreeError err
  85                                   )
  86                                => NgramsType
  87                                -> FlowCont NgramsTerm FlowListScores
  88                                -> [ListId]
  89                                -> m (FlowCont NgramsTerm FlowListScores)
  90       flowSocialListByModeWith nt'' flc'' listes =
  91         getHistoryScores History_User nt'' flc'' listes
  92         {-
  93             mapM (\l -> getListNgrams [l] nt'') listes
  94         >>= pure
  95           . toFlowListScores (keepAllParents nt'') flc''
  96         -}
  97 -----------------------------------------------------------------
  98 getHistoryScores :: ( RepoCmdM env err m
  99                     , CmdM     env err m
 100                     , HasNodeError err
 101                     , HasTreeError err
 102                     )
 103                  => History
 104                  -> NgramsType
 105                  -> FlowCont NgramsTerm FlowListScores
 106                  -> [ListId]
 107                  -> m (FlowCont NgramsTerm FlowListScores)
 108 getHistoryScores hist nt fl listes =
 109   addScorePatches nt listes fl <$> getHistory hist nt listes
 110
 111 getHistory :: ( RepoCmdM env err m
 112               , CmdM     env err m
 113               , HasNodeError err
 114               , HasTreeError err
 115               )
 116            => History
 117            -> NgramsType
 118            -> [ListId]
 119            -> m (Map NgramsType (Map ListId [HashMap NgramsTerm NgramsPatch]))
 120 getHistory hist nt listes =
 121   history hist [nt] listes  <$> getRepo
 122