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 {-# LANGUAGE InstanceSigs           #-}
  17
  18 module Gargantext.Core.Text.List.Group
  19   where
  20
  21 import Control.Lens (set, view, over)
  22 import Data.Set (Set)
  23 import Data.Map (Map)
  24 import Data.Maybe (fromMaybe)
  25 import Data.Monoid (Monoid, mempty)
  26 import Data.Text (Text)
  27 import Gargantext.Core.Types (ListType(..))
  28 import Gargantext.Database.Admin.Types.Node (NodeId)
  29 import Gargantext.Core.Text.List.Social.Prelude
  30 import Gargantext.Core.Text.List.Group.Prelude
  31 import Gargantext.Core.Text.List.Group.WithStem
  32 import Gargantext.Core.Text.List.Group.WithScores
  33 import Gargantext.Prelude
  34 import qualified Data.Set  as Set
  35 import qualified Data.Map  as Map
  36 import qualified Data.List as List
  37
  38 ------------------------------------------------------------------------
  39 -- | TODO add group with stemming
  40 toGroupedTree :: (Ord a, Monoid a, GroupWithStem a)
  41               => GroupParams
  42               -> FlowCont Text FlowListScores
  43               -> Map Text a
  44              -- -> Map Text (GroupedTreeScores (Set NodeId))
  45               -> FlowCont Text (GroupedTreeScores a)
  46 toGroupedTree groupParams flc scores = {-view flc_scores-} flow2
  47     where
  48       flow1     = groupWithScores' flc scoring
  49       scoring t = fromMaybe mempty $ Map.lookup t scores
  50
  51       flow2 = case (view flc_cont flow1) == Map.empty of
  52         True  -> flow1
  53         False -> groupWithStem' groupParams flow1
  54
  55
  56 setScoresWith :: (Ord a, Ord b)
  57               =>  (Text -> (GroupedTreeScores a) -> (GroupedTreeScores b))
  58               -> Map Text (GroupedTreeScores a)
  59               -> Map Text (GroupedTreeScores b)
  60 setScoresWith = Map.mapWithKey
  61
  62 {-
  63 gts :: (Text -> b) -> Text -> GroupedTreeScores a -> GroupedTreeScores b
  64 gts f t g = over gts'_children set gts'_score (f t) g
  65 -}
  66
  67 {-
  68 Map.foldlWithKey (\k v ->
  69                                    {- over gts'_children (setScoresWith fun)
  70                                           $ over gts'_score    (fun k)
  71                                           -}
  72                                           set gts'_score Set.empty -- (fun k)
  73                                           v
  74                                    ) mempty m
  75 -}
  76
  77 ------------------------------------------------------------------------