[Clean] refact + toGroupedTree WIP

src/Gargantext/Core/Text/List.hs

@@ -25,6 +25,7 @@ import Data.Text (Text)
 import Gargantext.API.Ngrams.Types (NgramsElement, mkNgramsElement, NgramsTerm(..), RootParent(..), mSetFromList)
 import Gargantext.API.Ngrams.Types (RepoCmdM)
 import Gargantext.Core.Text.List.Group
+import Gargantext.Core.Text.List.Group.Prelude
 import Gargantext.Core.Text.List.Group.WithStem
 import Gargantext.Core.Text.List.Social
 import Gargantext.Core.Text.List.Social.Prelude

src/Gargantext/Core/Text/List/Group.hs

@@ -25,6 +25,7 @@ import Data.Text (Text)
 import Gargantext.Core.Types (ListType(..))
 import Gargantext.Database.Admin.Types.Node (NodeId)
 import Gargantext.Core.Text.List.Social.Prelude (FlowListScores(..))
+import Gargantext.Core.Text.List.Group.Prelude
 import Gargantext.Core.Text.List.Group.WithStem
 import Gargantext.Core.Text.List.Group.WithScores
 import Gargantext.Prelude

src/Gargantext/Core/Text/List/Group/Prelude.hs

@@ -20,6 +20,7 @@ import Data.Semigroup
 import Data.Set (Set)
 import Data.Text (Text)
 import Gargantext.Core.Types (ListType(..))
+import Gargantext.Database.Admin.Types.Node (NodeId)
 import Gargantext.Prelude
 import qualified Data.Set as Set
 
@@ -32,19 +33,26 @@ data GroupedTextScores' score =
                      , _gts'_children :: !(Set (GroupedTextScores' score))
                      , _gts'_score    :: score
                      } deriving (Show, Ord, Eq)
-makeLenses 'GroupedTextScores'
+
 instance (Semigroup a, Ord a) => Semigroup (GroupedTextScores' a) where
-  (<>) (GroupedTextScores' l1 s1 c1)
-       (GroupedTextScores' l2 s2 c2)
-    = GroupedTextScores' (l1 <> l2) (s1 <> s2) (c1 <> c2)
+  (<>) (GroupedTextScores'  l1 s1 c1)
+       (GroupedTextScores'  l2 s2 c2)
+      = GroupedTextScores' (l1 <> l2)
+                           (s1 <> s2)
+                           (c1 <> c2)
 
+instance (Ord score, Monoid score)
+  => Monoid (GroupedTextScores' score) where
+    mempty = GroupedTextScores' Nothing Set.empty mempty
+
+makeLenses 'GroupedTextScores'
 
 -- | Intermediary Type
 data GroupedWithListScores =
   GroupedWithListScores { _gwls_listType :: !(Maybe ListType)
                         , _gwls_children :: !(Set Text)
                         } deriving (Show)
-makeLenses ''GroupedWithListScores
+
 instance Semigroup GroupedWithListScores where
   (<>) (GroupedWithListScores c1 l1)
        (GroupedWithListScores c2 l2) =
@@ -54,6 +62,46 @@ instance Semigroup GroupedWithListScores where
 instance Monoid GroupedWithListScores where
   mempty = GroupedWithListScores Nothing Set.empty
 
+makeLenses ''GroupedWithListScores
+
+------------------------------------------------------------------------
 ------------------------------------------------------------------------
 -- | Group With Stem Main Types
+type Stem  = Text
+data GroupedText score =
+  GroupedText { _gt_listType :: !(Maybe ListType)
+              , _gt_label    :: !Text
+              , _gt_score    :: !score
+              , _gt_children :: !(Set Text)
+              , _gt_size     :: !Int
+              , _gt_stem     :: !Stem -- needed ?
+              , _gt_nodes    :: !(Set NodeId)
+              }  deriving (Show, Eq) --}
+{-
+instance Show score => Show (GroupedText score) where
+  show (GroupedText lt l s _ _ _ _) = show l <> " : " <> show lt <> " : " <> show s
+--}
+
+{-
+instance (Eq a) => Eq (GroupedText a) where
+  (==) (GroupedText _ _ score1 _ _ _ _)
+       (GroupedText _ _ score2 _ _ _ _) = (==) score1 score2
+-}
+
+instance (Eq a, Ord a) => Ord (GroupedText a) where
+  compare (GroupedText _ _ score1 _ _ _ _)
+          (GroupedText _ _ score2 _ _ _ _) = compare score1 score2
+
+instance Ord a => Semigroup (GroupedText a) where
+  (<>) (GroupedText lt1 label1 score1 group1 s1 stem1 nodes1)
+        (GroupedText lt2 label2 score2 group2 s2 stem2 nodes2)
+          | score1 >= score2 = GroupedText lt label1 score1 (Set.insert label2 gr) s1 stem1 nodes
+          | otherwise        = GroupedText lt label2 score2 (Set.insert label1 gr) s2 stem2 nodes
+    where
+      lt = lt1 <> lt2
+      gr    = Set.union group1 group2
+      nodes = Set.union nodes1 nodes2
+
+-- | Lenses Instances
+makeLenses 'GroupedText
 

src/Gargantext/Core/Text/List/Group/WithScores.hs

@@ -29,7 +29,6 @@ import Gargantext.Prelude
 import qualified Data.Set  as Set
 import qualified Data.Map  as Map
 
-
 ------------------------------------------------------------------------
 ------------------------------------------------------------------------
 ------------------------------------------------------------------------
@@ -50,6 +49,8 @@ groupWithScores' flc _scores = FlowCont  groups orphans
 toGroupedTextScores' :: Map Text FlowListScores
                      -> Map Parent (GroupedTextScores' (Set NodeId))
 toGroupedTextScores' = toGroupedScores' . fromListScores'
+
+
 ------------------------------------------------------------------------
 fromListScores' :: Map Text FlowListScores
                 -> Map Parent GroupedWithListScores
@@ -66,6 +67,17 @@ fromListScores' = Map.fromListWith (<>) . (map fromScores') . Map.toList
           -- We ignore the ListType of children for the parents' one
           -- added after and winner of semigroup actions
 
+    -- | TODO add score here
+    fromScores'' :: (Text, FlowListScores) -> (Maybe Parent, [GroupedTextScores' (Set NodeId)])
+    fromScores'' (t, fs) = ( maybeParent
+                           , [ set gts'_listType maybeList mempty]
+                           )
+        where
+         maybeParent = keyWithMaxValue $ view fls_parents  fs
+         maybeList   = keyWithMaxValue $ view fls_listType fs
+
+    -- toTree :: [(Maybe Parent, [GroupedWithListScores])] -> Map Parent (
+
 
 toGroupedScores' :: Map Parent GroupedWithListScores
                  -> Map Parent (GroupedTextScores' (Set NodeId))
@@ -157,6 +169,6 @@ fromListScores = Map.fromListWith (<>) . (map fromScores') . Map.toList
           -- We ignore the ListType of children for the parents' one
           -- added after and winner of semigroup actions
 
-
 --8<-- -8<-- -8<-- -8<-- -8<-- -8<-- -8<-- -8<-- -8<-- -8<-- -8<-- -8<--
 
+

src/Gargantext/Core/Text/List/Group/WithStem.hs

@@ -21,12 +21,11 @@ import Control.Lens (makeLenses, view)
 import Data.Set (Set)
 import Data.Map (Map)
 import Data.Text (Text)
-import Data.Semigroup (Semigroup)
 import Gargantext.Core (Lang(..))
 import Gargantext.Core.Text (size)
-import Gargantext.Core.Types (ListType(..)) -- (MasterCorpusId, UserCorpusId)
 import Gargantext.Database.Admin.Types.Node (NodeId)
 import Gargantext.Core.Text.List.Group.WithScores
+import Gargantext.Core.Text.List.Group.Prelude
 import Gargantext.Core.Text.Terms.Mono.Stem (stem)
 import Gargantext.Prelude
 import qualified Data.Set  as Set
@@ -58,44 +57,6 @@ data GroupedTextParams a b =
                     }
 makeLenses 'GroupedTextParams
 
-type Stem  = Text
-data GroupedText score =
-  GroupedText { _gt_listType :: !(Maybe ListType)
-              , _gt_label    :: !Text
-              , _gt_score    :: !score
-              , _gt_children :: !(Set Text)
-              , _gt_size     :: !Int
-              , _gt_stem     :: !Stem -- needed ?
-              , _gt_nodes    :: !(Set NodeId)
-              }  deriving (Show, Eq) --}
-{-
-instance Show score => Show (GroupedText score) where
-  show (GroupedText lt l s _ _ _ _) = show l <> " : " <> show lt <> " : " <> show s
---}
-
-{-
-instance (Eq a) => Eq (GroupedText a) where
-  (==) (GroupedText _ _ score1 _ _ _ _)
-       (GroupedText _ _ score2 _ _ _ _) = (==) score1 score2
--}
-
-instance (Eq a, Ord a) => Ord (GroupedText a) where
-  compare (GroupedText _ _ score1 _ _ _ _)
-          (GroupedText _ _ score2 _ _ _ _) = compare score1 score2
-
-instance Ord a => Semigroup (GroupedText a) where
-  (<>) (GroupedText lt1 label1 score1 group1 s1 stem1 nodes1)
-        (GroupedText lt2 label2 score2 group2 s2 stem2 nodes2)
-          | score1 >= score2 = GroupedText lt label1 score1 (Set.insert label2 gr) s1 stem1 nodes
-          | otherwise        = GroupedText lt label2 score2 (Set.insert label1 gr) s2 stem2 nodes
-    where
-      lt = lt1 <> lt2
-      gr    = Set.union group1 group2
-      nodes = Set.union nodes1 nodes2
-
--- | Lenses Instances
-makeLenses 'GroupedText
-
 ------------------------------------------------------------------------
 groupWithStem :: {- ( HasNgrams a
                  , HasGroupWithScores a b

src/Gargantext/Core/Text/List/Social/Prelude.hs

@@ -116,7 +116,6 @@ keyWithMaxValue :: Map a b -> Maybe a
 keyWithMaxValue m = (fst . fst) <$> Map.maxViewWithKey m
 
 
-
 ------------------------------------------------------------------------
 -- | Tools TODO clean it (some need to be removed)
 ------------------------------------------------------------------------

src/Gargantext/Database/Query/Tree.hs

@@ -34,7 +34,7 @@ module Gargantext.Database.Query.Tree
   )
   where
 
-import Control.Lens ((^..), at, each, _Just, to, set, makeLenses)
+import Control.Lens ({-(^..)-} toListOf, at, each, _Just, to, set, makeLenses)
 import Control.Monad.Error.Class (MonadError())
 import Data.List (tail, concat, nub)
 import Data.Map (Map, fromListWith, lookup)
@@ -174,13 +174,14 @@ toTree m =
               -> Tree NodeTree
       toTree' m' n =
         TreeN (toNodeTree n) $
-          m' ^.. at (Just $ _dt_nodeId n) . _Just . each . to (toTree' m')
+          -- | Lines below are equal computationally but not semantically
+          -- m' ^.. at (Just $ _dt_nodeId n) . _Just . each . to (toTree' m')
+          toListOf (at (Just $ _dt_nodeId n) . _Just . each . to (toTree' m')) m'
 
       toNodeTree :: DbTreeNode
                  -> NodeTree
-      toNodeTree (DbTreeNode nId tId _ n) = NodeTree n nodeType nId
-        where
-          nodeType = fromNodeTypeId tId
+      toNodeTree (DbTreeNode nId tId _ n) = NodeTree n (fromNodeTypeId tId) nId
+
 ------------------------------------------------------------------------
 toTreeParent :: [DbTreeNode]
              -> Map (Maybe ParentId) [DbTreeNode]