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.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.Types.Individu
  24 import Gargantext.Database.Admin.Types.Node
  25 import Gargantext.Database.Prelude
  26 import Gargantext.Database.Query.Table.Node.Error
  27 import Gargantext.Database.Query.Tree
  28 import Gargantext.Database.Schema.Ngrams
  29 import Gargantext.Prelude
  30
  31 ------------------------------------------------------------------------
  32 ------------------------------------------------------------------------
  33 -- | Main parameters
  34
  35 -- | FlowSocialListPriority
  36 -- Sociological assumption: either private or others (public) first
  37 -- This parameter depends on the user choice
  38 data FlowSocialListPriority = MySelfFirst | OthersFirst
  39
  40 flowSocialListPriority :: FlowSocialListPriority -> [NodeMode]
  41 flowSocialListPriority MySelfFirst = [Private{-, Shared, Public -}]
  42 flowSocialListPriority OthersFirst = reverse $ flowSocialListPriority MySelfFirst
  43
  44 {-
  45 -- | We keep the parents for all ngrams but terms
  46 keepAllParents :: NgramsType -> KeepAllParents
  47 keepAllParents NgramsTerms = KeepAllParents False
  48 keepAllParents _           = KeepAllParents True
  49 -}
  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 NgramsTerm FlowListScores
  60                   -> m (FlowCont NgramsTerm 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 NgramsTerm FlowListScores
  73                             -> NodeMode
  74                             -> m (FlowCont NgramsTerm 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 NgramsTerm FlowListScores
  87                                -> [ListId]
  88                                -> m (FlowCont NgramsTerm FlowListScores)
  89       flowSocialListByModeWith nt'' flc'' listes =
  90         getHistoryScores History_User nt'' flc'' listes
  91         {-
  92             mapM (\l -> getListNgrams [l] nt'') listes
  93         >>= pure
  94           . toFlowListScores (keepAllParents nt'') flc''
  95         -}
  96 -----------------------------------------------------------------
  97 getHistoryScores :: ( RepoCmdM env err m
  98                     , CmdM     env err m
  99                     , HasNodeError err
 100                     , HasTreeError err
 101                     )
 102                  => History
 103                  -> NgramsType
 104                  -> FlowCont NgramsTerm FlowListScores
 105                  -> [ListId]
 106                  -> m (FlowCont NgramsTerm FlowListScores)
 107 getHistoryScores hist nt fl listes =
 108   addScorePatches nt listes fl <$> getHistory hist nt listes
 109
 110 getHistory :: ( RepoCmdM env err m
 111               , CmdM     env err m
 112               , HasNodeError err
 113               , HasTreeError err
 114               )
 115            => History
 116            -> NgramsType
 117            -> [ListId]
 118            -> m (Map NgramsType (Map ListId [HashMap NgramsTerm NgramsPatch]))
 119 getHistory hist nt listes =
 120   history hist [nt] listes  <$> getRepo
 121