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 toGroupedText :: GroupedTextParams a b
  39               -> Map Text FlowListScores
  40               -> Map Text (Set NodeId)
  41               -> Map Stem (GroupedText Int)
  42 toGroupedText groupParams scores =
  43   (groupWithStem groupParams) . (groupWithScores scores)
  44
  45 -- | TODO add group with stemming
  46 toGroupedTreeText :: GroupedTextParams a b
  47               -> FlowCont Text FlowListScores
  48               -> Map Text (Set NodeId)
  49               -> Map Text (GroupedTreeScores (Set NodeId))
  50 toGroupedTreeText _groupParams flc scores = view flc_scores flow1
  51     where
  52       flow1 = groupWithScores' flc scoring
  53       scoring t = fromMaybe Set.empty $ Map.lookup t scores
  54
  55 {-
  56       flow2 = case flc_cont flow1 == Set.empty of
  57         True  -> view flc_scores flow1
  58         False -> groupWithStem' groupParams flow1
  59
  60
  61       groupWithStem' :: GroupedTextParams a b
  62                      -> FlowCont Text (GroupedTreeScores (Set NodeId))
  63                      -> FlowCont Text (GroupedTreeScores (Set NodeId))
  64       groupWithStem' _groupParams = identity
  65 -}
  66
  67 ------------------------------------------------------------------------
  68 ------------------------------------------------------------------------
  69 -- | TODO To be removed
  70 addListType :: Map Text ListType -> GroupedText a -> GroupedText a
  71 addListType m g = set gt_listType (hasListType m g) g
  72   where
  73     hasListType :: Map Text ListType -> GroupedText a -> Maybe ListType
  74     hasListType m' (GroupedText _ label _ g' _ _ _) =
  75         List.foldl' (<>) Nothing
  76       $ map (\t -> Map.lookup t m')
  77       $ Set.toList
  78       $ Set.insert label g'