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(..))
  26 import Gargantext.Database.Admin.Types.Node (NodeId)
  27 import Gargantext.Core.Text.List.Social.Prelude (FlowListScores(..))
  28 import Gargantext.Core.Text.List.Group.Prelude
  29 import Gargantext.Core.Text.List.Group.WithStem
  30 import Gargantext.Core.Text.List.Group.WithScores
  31 import Gargantext.Prelude
  32 import qualified Data.Set  as Set
  33 import qualified Data.Map  as Map
  34 import qualified Data.List as List
  35
  36 ------------------------------------------------------------------------
  37 toGroupedText :: GroupedTextParams a b
  38               -> Map Text FlowListScores
  39               -> Map Text (Set NodeId)
  40               -> Map Stem (GroupedText Int)
  41 toGroupedText groupParams scores =
  42   (groupWithStem groupParams) . (groupWithScores scores)
  43
  44 ------------------------------------------------------------------------
  45 ------------------------------------------------------------------------
  46 -- | TODO 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'