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 -- findList imports
  15 import Gargantext.Core.Types.Individu
  16 import Gargantext.Database.Admin.Config
  17 import Gargantext.Database.Admin.Types.Node
  18 import Gargantext.Database.Prelude
  19 import Gargantext.Database.Query.Table.Node.Error
  20 import Gargantext.Database.Query.Tree
  21 import Gargantext.Database.Query.Tree.Root (getRootId)
  22 import Gargantext.Prelude
  23
  24 -- filterList imports
  25 import Data.Maybe (fromMaybe)
  26 import Data.Map (Map)
  27 import Data.Set (Set)
  28 import Data.Semigroup (Semigroup(..))
  29 import Data.Text (Text)
  30 import Gargantext.API.Ngrams.Tools -- (getListNgrams)
  31 import Gargantext.API.Ngrams.Types
  32 import Gargantext.Core.Types.Main
  33 import Gargantext.Database.Schema.Ngrams
  34 import Gargantext.Core.Text.List.Social.Find
  35 import Gargantext.Core.Text.List.Social.Group
  36 import Gargantext.Core.Text.List.Social.ListType
  37 import qualified Data.List  as List
  38 import qualified Data.Map   as Map
  39 import qualified Data.Set   as Set
  40
  41 ------------------------------------------------------------------------
  42 flowSocialList :: ( RepoCmdM env err m
  43                   , CmdM     env err m
  44                   , HasNodeError err
  45                   , HasTreeError err
  46                   )
  47                   => User -> NgramsType -> Set Text
  48                   -> m (Map ListType (Set Text))
  49 flowSocialList user nt ngrams' = do
  50   privateLists <- flowSocialListByMode Private user nt ngrams'
  51   -- printDebug "* privateLists *: \n" privateLists
  52   -- here preference to privateLists (discutable)
  53   sharedLists  <- flowSocialListByMode Shared  user nt (termsByList CandidateTerm privateLists)
  54   -- printDebug "* sharedLists *: \n" sharedLists
  55    -- TODO publicMapList
  56
  57   let result = unions [ Map.mapKeys (fromMaybe CandidateTerm) privateLists
  58                       , Map.mapKeys (fromMaybe CandidateTerm) sharedLists
  59                       ]
  60   -- printDebug "* socialLists *: results \n" result
  61   pure result
  62
  63 ------------------------------------------------------------------------
  64 unions :: (Ord a, Semigroup a, Semigroup b, Ord b)
  65       => [Map a (Set b)] -> Map a (Set b)
  66 unions = invertBack . Map.unionsWith (<>) . map invertForw
  67
  68 invertForw :: (Ord b, Semigroup a) => Map a (Set b) -> Map b a
  69 invertForw = Map.unionsWith (<>)
  70            . (map (\(k,sets) -> Map.fromSet (\_ -> k) sets))
  71            . Map.toList
  72
  73 invertBack :: (Ord a, Ord b) => Map b a -> Map a (Set b)
  74 invertBack = Map.fromListWith (<>)
  75            . (map (\(b,a) -> (a, Set.singleton b)))
  76            .  Map.toList
  77
  78 unions_test :: Map ListType (Set Text)
  79 unions_test = unions [m1, m2]
  80   where
  81     m1 = Map.fromList [ (StopTerm     , Set.singleton "Candidate")]
  82     m2 = Map.fromList [ (CandidateTerm, Set.singleton "Candidate")
  83                       , (MapTerm      , Set.singleton "Candidate")
  84                       ]
  85
  86 ------------------------------------------------------------------------
  87 flowSocialListByMode :: ( RepoCmdM env err m
  88                         , CmdM     env err m
  89                         , HasNodeError err
  90                         , HasTreeError err
  91                         )
  92                      => NodeMode -> User -> NgramsType -> Set Text
  93                      -> m (Map (Maybe ListType) (Set Text))
  94 flowSocialListByMode mode user nt ngrams' = do
  95   listIds <- findListsId mode user
  96   case listIds of
  97     [] -> pure $ Map.fromList [(Nothing, ngrams')]
  98     _  -> do
  99       counts  <- countFilterList ngrams' nt listIds Map.empty
 100       -- printDebug "flowSocialListByMode counts" counts
 101       let r = toSocialList counts ngrams'
 102       -- printDebug "flowSocialListByMode r" r
 103       pure r
 104
 105 ------------------------------------------------------------------------
 106 -- TODO: maybe use social groups too
 107 toSocialList :: Map Text (Map ListType Int)
 108              -> Set Text
 109              -> Map (Maybe ListType) (Set Text)
 110 toSocialList m = Map.fromListWith (<>)
 111                . Set.toList
 112                . Set.map (toSocialList1 m)
 113
 114 -- | TODO what if equality ?
 115 -- choice depends on Ord instance of ListType
 116 -- for now : data ListType  =  StopTerm | CandidateTerm | MapTerm
 117 -- means MapTerm > CandidateTerm > StopTerm in case of equality of counts
 118 -- (we minimize errors on MapTerms if doubt)
 119 toSocialList1 :: Map Text (Map ListType Int)
 120              -> Text
 121              -> (Maybe ListType, Set Text)
 122 toSocialList1 m t = case Map.lookup t m of
 123   Nothing -> (Nothing, Set.singleton t)
 124   Just  m' -> ( (fst . fst) <$> Map.maxViewWithKey m'
 125               , Set.singleton t
 126               )
 127
 128 toSocialList1_testIsTrue :: Bool
 129 toSocialList1_testIsTrue = result == (Just MapTerm, Set.singleton token)
 130   where
 131     result = toSocialList1 (Map.fromList [(token, m)]) token
 132     token  = "token"
 133     m = Map.fromList [ (CandidateTerm, 1)
 134                      , (MapTerm      , 2)
 135                      , (StopTerm     , 3)
 136                      ]
 137