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 Control.Lens (set)
  22 import Data.Set (Set)
  23 import Data.Map (Map)
  24 import Data.Text (Text)
  25 import Gargantext.Core.Types (ListType(..)) -- (MasterCorpusId, UserCorpusId)
  26 import Gargantext.Database.Admin.Types.Node (NodeId)
  27 import Gargantext.Core.Text.List.Social.Scores (FlowListScores(..))
  28 import Gargantext.Core.Text.List.Group.WithStem
  29 import Gargantext.Core.Text.List.Group.WithScores
  30 import Gargantext.Prelude
  31 import qualified Data.Set  as Set
  32 import qualified Data.Map  as Map
  33 import qualified Data.List as List
  34
  35 ------------------------------------------------------------------------
  36 toGroupedText :: GroupedTextParams a b
  37               -> Map Text FlowListScores
  38               -> Map Text (Set NodeId)
  39               -> Map Stem (GroupedText Int)
  40 toGroupedText groupParams scores =
  41   (groupWithStem groupParams) . (groupWithScores scores)
  42
  43
  44 ------------------------------------------------------------------------
  45 ------------------------------------------------------------------------
  46 -- | To be removed
  47 addListType :: Map Text ListType -> GroupedText a -> GroupedText a
  48 addListType m g = set gt_listType (hasListType m g) g
  49   where
  50     hasListType :: Map Text ListType -> GroupedText a -> Maybe ListType
  51     hasListType m' (GroupedText _ label _ g' _ _ _) =
  52         List.foldl' (<>) Nothing
  53       $ map (\t -> Map.lookup t m')
  54       $ Set.toList
  55       $ Set.insert label g'