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, view)
  22 import Data.Set (Set)
  23 import Data.Map (Map)
  24 import Data.Maybe (fromMaybe)
  25 import Data.Text (Text)
  26 import Gargantext.Core.Types (ListType(..))
  27 import Gargantext.Database.Admin.Types.Node (NodeId)
  28 import Gargantext.Core.Text.List.Social.Prelude
  29 import Gargantext.Core.Text.List.Group.Prelude
  30 import Gargantext.Core.Text.List.Group.WithStem
  31 import Gargantext.Core.Text.List.Group.WithScores
  32 import Gargantext.Prelude
  33 import qualified Data.Set  as Set
  34 import qualified Data.Map  as Map
  35 import qualified Data.List as List
  36
  37 ------------------------------------------------------------------------
  38 -- | TODO add group with stemming
  39 toGroupedTreeText :: GroupParams
  40                   -> FlowCont Text FlowListScores
  41                   -> Map Text (Set NodeId)
  42                  -- -> Map Text (GroupedTreeScores (Set NodeId))
  43                   -> FlowCont Text (GroupedTreeScores (Set NodeId))
  44 toGroupedTreeText groupParams flc scores = {-view flc_scores-} flow2
  45     where
  46       flow1     = groupWithScores' flc scoring
  47       scoring t = fromMaybe Set.empty $ Map.lookup t scores
  48
  49       flow2 = case (view flc_cont flow1) == Map.empty of
  50         True  -> flow1
  51         False -> groupWithStem' groupParams flow1
  52
  53
  54 ------------------------------------------------------------------------
  55 ------------------------------------------------------------------------
  56 -- | TODO To be removed
  57 toGroupedText :: GroupedTextParams a b
  58               -> Map Text FlowListScores
  59               -> Map Text (Set NodeId)
  60               -> Map Stem (GroupedText Int)
  61 toGroupedText groupParams scores =
  62   (groupWithStem groupParams) . (groupWithScores scores)
  63
  64
  65 addListType :: Map Text ListType -> GroupedText a -> GroupedText a
  66 addListType m g = set gt_listType (hasListType m g) g
  67   where
  68     hasListType :: Map Text ListType -> GroupedText a -> Maybe ListType
  69     hasListType m' (GroupedText _ label _ g' _ _ _) =
  70         List.foldl' (<>) Nothing
  71       $ map (\t -> Map.lookup t m')
  72       $ Set.toList
  73       $ Set.insert label g'