]> Git — Sourcephile - gargantext.git/blob - src/Gargantext/Core/Text/List/Group.hs
[CLEAN] before adding Continuation FlowList type
[gargantext.git] / 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.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 -- | WIP, put this in test folder
45 toGroupedText_test :: Bool -- Map Stem (GroupedText Int)
46 toGroupedText_test =
47 -- fromGroupedScores $ fromListScores from
48 toGroupedText params from datas == result
49 where
50 params = GroupedTextParams identity (Set.size . snd) fst snd
51 from :: Map Text FlowListScores
52 from = Map.fromList [("A. Rahmani",FlowListScores {_fls_parents = Map.fromList [("T. Reposeur",1)]
53 ,_fls_listType = Map.fromList [(MapTerm,2)]})
54 ,("B. Tamain",FlowListScores {_fls_parents = Map.fromList [("T. Reposeur",1)]
55 , _fls_listType = Map.fromList [(MapTerm,2)]})
56 ]
57
58 datas :: Map Text (Set NodeId)
59 datas = Map.fromList [("A. Rahmani" , Set.fromList [1,2])
60 ,("T. Reposeur", Set.fromList [3,4])
61 ,("B. Tamain" , Set.fromList [5,6])
62 ]
63
64
65 result :: Map Stem (GroupedText Int)
66 result = Map.fromList [("A. Rahmani",GroupedText {_gt_listType = Nothing
67 ,_gt_label = "A. Rahmani"
68 ,_gt_score = 2
69 ,_gt_children = Set.empty
70 ,_gt_size = 2
71 ,_gt_stem = "A. Rahmani"
72 ,_gt_nodes = Set.fromList [1,2]
73 }
74 )
75 ,("B. Tamain",GroupedText {_gt_listType = Nothing
76 , _gt_label = "B. Tamain"
77 , _gt_score = 2
78 , _gt_children = Set.empty
79 , _gt_size = 2
80 , _gt_stem = "B. Tamain"
81 , _gt_nodes = Set.fromList [5,6]
82 }
83 )
84 ,("T. Reposeur",GroupedText {_gt_listType = Nothing
85 ,_gt_label = "T. Reposeur"
86 ,_gt_score = 2
87 ,_gt_children = Set.fromList ["A. Rahmani","B. Tamain"]
88 ,_gt_size = 2
89 ,_gt_stem = "T. Reposeur"
90 ,_gt_nodes = Set.fromList [1..6]
91 }
92 )
93 ]
94
95 ------------------------------------------------------------------------
96 -- | To be removed
97 addListType :: Map Text ListType -> GroupedText a -> GroupedText a
98 addListType m g = set gt_listType (hasListType m g) g
99 where
100 hasListType :: Map Text ListType -> GroupedText a -> Maybe ListType
101 hasListType m' (GroupedText _ label _ g' _ _ _) =
102 List.foldl' (<>) Nothing
103 $ map (\t -> Map.lookup t m')
104 $ Set.toList
105 $ Set.insert label g'