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                   -> FlowListCont Text
  66                   -> m (FlowListCont Text)
  67 flowSocialList' flowPriority user nt flc =
  68   mconcat <$> mapM (flowSocialListByMode' user nt flc)
  69                    (flowSocialListPriority flowPriority)
  70
  71 ------------------------------------------------------------------------
  72
  73 flowSocialListByMode' :: ( RepoCmdM env err m
  74                          , CmdM     env err m
  75                          , HasNodeError err
  76                          , HasTreeError err
  77                          )
  78                       => User -> NgramsType
  79                       -> FlowListCont Text
  80                       -> NodeMode
  81                       -> m (FlowListCont Text)
  82 flowSocialListByMode' user nt flc mode =
  83       findListsId user mode
  84   >>= flowSocialListByModeWith nt flc
  85
  86
  87 flowSocialListByModeWith :: ( RepoCmdM env err m
  88                             , CmdM     env err m
  89                             , HasNodeError err
  90                             , HasTreeError err
  91                             )
  92                          => NgramsType
  93                          -> FlowListCont Text
  94                          -> [NodeId]
  95                          -> m (FlowListCont Text)
  96 flowSocialListByModeWith nt flc ns =
  97       mapM (\l -> getListNgrams [l] nt) ns
  98   >>= pure
  99     . toFlowListScores (keepAllParents nt) flc
 100
 101
 102
 103 ---8<-TODO-ALL BELOW--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<-
 104
 105 -- | Choice depends on Ord instance of ListType
 106 -- for now : data ListType  =  StopTerm | CandidateTerm | MapTerm
 107 -- means MapTerm > CandidateTerm > StopTerm in case of equality of counts
 108 -- (we minimize errors on MapTerms if doubt)
 109 --  * TODO what if equality ?
 110 --  * TODO maybe use social groups too
 111 toSocialList :: Map Text (Map ListType Int)
 112              -> Set Text
 113              -> Map (Maybe ListType) (Set Text)
 114 toSocialList m = Map.fromListWith (<>)
 115                . Set.toList
 116                . Set.map (toSocialList1 m)
 117
 118 toSocialList1 :: Map Text (Map ListType Int)
 119              -> Text
 120              -> (Maybe ListType, Set Text)
 121 toSocialList1 m t = case Map.lookup t m of
 122   Nothing -> (Nothing, Set.singleton t)
 123   Just  m' -> ( (fst . fst) <$> Map.maxViewWithKey m'
 124               , Set.singleton t
 125               )
 126
 127 toSocialList1_testIsTrue :: Bool
 128 toSocialList1_testIsTrue = result == (Just MapTerm, Set.singleton token)
 129   where
 130     result = toSocialList1 (Map.fromList [(token, m)]) token
 131     token  = "token"
 132     m = Map.fromList [ (CandidateTerm, 1)
 133                      , (MapTerm      , 2)
 134                      , (StopTerm     , 3)
 135                      ]
 136
 137
 138
 139 flowSocialList :: ( RepoCmdM env err m
 140                   , CmdM     env err m
 141                   , HasNodeError err
 142                   , HasTreeError err
 143                   )
 144                   => User -> NgramsType -> Set Text
 145                   -> m (Map ListType (Set Text))
 146 flowSocialList user nt ngrams' = do
 147   -- Here preference to privateLists (discutable: let user choice)
 148   privateListIds <- findListsId user Private
 149   privateLists <- flowSocialListByMode privateListIds nt ngrams'
 150   -- printDebug "* privateLists *: \n" privateLists
 151
 152   sharedListIds <- findListsId user Shared
 153   sharedLists  <- flowSocialListByMode sharedListIds nt (termsByList CandidateTerm privateLists)
 154   -- printDebug "* sharedLists *: \n" sharedLists
 155
 156   -- TODO publicMapList:
 157   -- Note: if both produce 3 identic repetition => refactor mode
 158   -- publicListIds <- findListsId Public user
 159   -- publicLists   <- flowSocialListByMode' publicListIds nt (termsByList CandidateTerm privateLists)
 160
 161   let result = parentUnionsExcl
 162              [ Map.mapKeys (fromMaybe CandidateTerm) privateLists
 163              , Map.mapKeys (fromMaybe CandidateTerm) sharedLists
 164              -- , Map.mapKeys (fromMaybe CandidateTerm) publicLists
 165              ]
 166   -- printDebug "* socialLists *: results \n" result
 167   pure result
 168
 169
 170 -- | TODO remove
 171 flowSocialListByMode :: ( RepoCmdM env err m
 172                         , CmdM     env err m
 173                         , HasNodeError err
 174                         , HasTreeError err
 175                         )
 176                      => [NodeId]-> NgramsType -> Set Text
 177                      -> m (Map (Maybe ListType) (Set Text))
 178 flowSocialListByMode      [] _nt ngrams' = pure $ Map.fromList [(Nothing, ngrams')]
 179 flowSocialListByMode listIds  nt ngrams' = do
 180     counts  <- countFilterList ngrams' nt listIds Map.empty
 181     let r = toSocialList counts ngrams'
 182     pure r