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   -- Here preference to privateLists (discutable: let user choice)
  51   privateListIds <- findListsId Private user
  52   privateLists <- flowSocialListByMode privateListIds nt ngrams'
  53   -- printDebug "* privateLists *: \n" privateLists
  54
  55   sharedListIds <- findListsId Shared user
  56   sharedLists  <- flowSocialListByMode sharedListIds nt (termsByList CandidateTerm privateLists)
  57   -- printDebug "* sharedLists *: \n" sharedLists
  58
  59   -- TODO publicMapList:
  60   -- Note: if both produce 3 identic repetition => refactor mode
  61   -- publicListIds <- findListsId Public user
  62   -- publicLists   <- flowSocialListByMode' publicListIds nt (termsByList CandidateTerm privateLists)
  63
  64   let result = unions [ Map.mapKeys (fromMaybe CandidateTerm) privateLists
  65                       , Map.mapKeys (fromMaybe CandidateTerm) sharedLists
  66                       -- , Map.mapKeys (fromMaybe CandidateTerm) publicLists
  67                       ]
  68   -- printDebug "* socialLists *: results \n" result
  69   pure result
  70
  71 ------------------------------------------------------------------------
  72 flowSocialListByMode :: ( RepoCmdM env err m
  73                        , CmdM     env err m
  74                        , HasNodeError err
  75                        , HasTreeError err
  76                        )
  77                     => [NodeId]-> NgramsType -> Set Text
  78                     -> m (Map (Maybe ListType) (Set Text))
  79 flowSocialListByMode      [] nt ngrams' = pure $ Map.fromList [(Nothing, ngrams')]
  80 flowSocialListByMode listIds nt ngrams' = do
  81     counts  <- countFilterList ngrams' nt listIds Map.empty
  82     let r = toSocialList counts ngrams'
  83     pure r
  84
  85
  86 ------------------------------------------------------------------------
  87 -- TODO: maybe use social groups too
  88 -- | TODO what if equality ?
  89 -- choice depends on Ord instance of ListType
  90 -- for now : data ListType  =  StopTerm | CandidateTerm | MapTerm
  91 -- means MapTerm > CandidateTerm > StopTerm in case of equality of counts
  92 -- (we minimize errors on MapTerms if doubt)
  93 toSocialList :: Map Text (Map ListType Int)
  94              -> Set Text
  95              -> Map (Maybe ListType) (Set Text)
  96 toSocialList m = Map.fromListWith (<>)
  97                . Set.toList
  98                . Set.map (toSocialList1 m)
  99
 100 toSocialList1 :: Map Text (Map ListType Int)
 101              -> Text
 102              -> (Maybe ListType, Set Text)
 103 toSocialList1 m t = case Map.lookup t m of
 104   Nothing -> (Nothing, Set.singleton t)
 105   Just  m' -> ( (fst . fst) <$> Map.maxViewWithKey m'
 106               , Set.singleton t
 107               )
 108
 109 toSocialList1_testIsTrue :: Bool
 110 toSocialList1_testIsTrue = result == (Just MapTerm, Set.singleton token)
 111   where
 112     result = toSocialList1 (Map.fromList [(token, m)]) token
 113     token  = "token"
 114     m = Map.fromList [ (CandidateTerm, 1)
 115                      , (MapTerm      , 2)
 116                      , (StopTerm     , 3)
 117                      ]
 118
 119 ------------------------------------------------------------------------
 120 -- | Tools
 121
 122 ------------------------------------------------------------------------
 123 termsByList :: ListType -> (Map (Maybe ListType) (Set Text)) -> Set Text
 124 termsByList CandidateTerm m = Set.unions
 125                           $ map (\lt -> fromMaybe Set.empty $ Map.lookup lt m)
 126                           [ Nothing, Just CandidateTerm ]
 127 termsByList l m =
 128   fromMaybe Set.empty $ Map.lookup (Just l) m
 129
 130 ------------------------------------------------------------------------
 131
 132
 133 unions :: (Ord a, Semigroup a, Semigroup b, Ord b)
 134       => [Map a (Set b)] -> Map a (Set b)
 135 unions = invertBack . Map.unionsWith (<>) . map invertForw
 136
 137 invertForw :: (Ord b, Semigroup a) => Map a (Set b) -> Map b a
 138 invertForw = Map.unionsWith (<>)
 139            . (map (\(k,sets) -> Map.fromSet (\_ -> k) sets))
 140            . Map.toList
 141
 142 invertBack :: (Ord a, Ord b) => Map b a -> Map a (Set b)
 143 invertBack = Map.fromListWith (<>)
 144            . (map (\(b,a) -> (a, Set.singleton b)))
 145            .  Map.toList
 146
 147 unions_test :: Map ListType (Set Text)
 148 unions_test = unions [m1, m2]
 149   where
 150     m1 = Map.fromList [ (StopTerm     , Set.singleton "Candidate")]
 151     m2 = Map.fromList [ (CandidateTerm, Set.singleton "Candidate")
 152                       , (MapTerm      , Set.singleton "Candidate")
 153                       ]