src/Gargantext/Core/Text/List/Group.hs

   1 {-|
   2 Module      : Gargantext.Core.Text.List.Group
   3 Description :
   4 Copyright   : (c) CNRS, 2017-Present
   5 License     : AGPL + CECILL v3
   6 Maintainer  : team@gargantext.org
   7 Stability   : experimental
   8 Portability : POSIX
   9
  10 -}
  11
  12 {-# LANGUAGE TemplateHaskell        #-}
  13 {-# LANGUAGE ConstraintKinds        #-}
  14 {-# LANGUAGE TypeFamilies           #-}
  15 {-# LANGUAGE FunctionalDependencies #-}
  16
  17
  18 module Gargantext.Core.Text.List.Group
  19   where
  20
  21 import Data.Maybe (fromMaybe)
  22 import Control.Lens (makeLenses, set, (^.))
  23 import Data.Set (Set)
  24 import Data.Map (Map)
  25 import Data.Text (Text)
  26 import Data.Semigroup (Semigroup, (<>))
  27 import Gargantext.Core (Lang(..))
  28 import Gargantext.Core.Text (size)
  29 import Gargantext.Core.Types (ListType(..)) -- (MasterCorpusId, UserCorpusId)
  30 import Gargantext.Database.Admin.Types.Node (NodeId)
  31 -- import Gargantext.Core.Text.List.Learn (Model(..))
  32 import Gargantext.Core.Text.List.Social.Scores (FlowListScores(..), flc_lists, flc_parents, keyWithMaxValue)
  33 import Gargantext.Core.Text.List.Group.WithStem
  34 import Gargantext.Core.Text.List.Group.WithScores
  35 import Gargantext.Core.Text.Terms.Mono.Stem (stem)
  36 import Gargantext.Database.Schema.Ngrams (NgramsType(..))
  37 import Gargantext.Prelude
  38 import qualified Data.Set  as Set
  39 import qualified Data.Map  as Map
  40 import qualified Data.List as List
  41 import qualified Data.Text as Text
  42
  43 ------------------------------------------------------------------------
  44 toGroupedText :: GroupedTextParams a b
  45               -> Map Text FlowListScores
  46               -> Map Text (Set NodeId)
  47               -> Map Stem (GroupedText Int)
  48 toGroupedText groupParams scores =
  49   (groupWithStem groupParams) . (groupWithScores scores)
  50
  51
  52 ------------------------------------------------------------------------
  53 ------------------------------------------------------------------------
  54 -- | To be removed
  55 addListType :: Map Text ListType -> GroupedText a -> GroupedText a
  56 addListType m g = set gt_listType (hasListType m g) g
  57   where
  58     hasListType :: Map Text ListType -> GroupedText a -> Maybe ListType
  59     hasListType m' (GroupedText _ label _ g' _ _ _) =
  60         List.foldl' (<>) Nothing
  61       $ map (\t -> Map.lookup t m')
  62       $ Set.toList
  63       $ Set.insert label g'