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