[Types] organization, using more Lenses

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

@@ -14,18 +14,14 @@ Portability : POSIX
 module Gargantext.Core.Text.List.Group.Prelude
   where
 
-import Control.Lens (makeLenses, view, set)
+import Control.Lens (makeLenses)
+import Data.Monoid
 import Data.Semigroup
 import Data.Set (Set)
-import Data.Map (Map)
-import Data.Maybe (catMaybes)
 import Data.Text (Text)
 import Gargantext.Core.Types (ListType(..))
-import Gargantext.Database.Admin.Types.Node (NodeId)
-import Gargantext.Core.Text.List.Social.Prelude
 import Gargantext.Prelude
-import qualified Data.Set  as Set
-import qualified Data.Map  as Map
+import qualified Data.Set as Set
 
 ------------------------------------------------------------------------
 -- | Group With Scores Main Types
@@ -33,8 +29,8 @@ import qualified Data.Map  as Map
 -- Target : type FlowCont Text GroupedTextScores'
 data GroupedTextScores' score =
   GroupedTextScores' { _gts'_listType :: !(Maybe ListType)
-                     , _gts'_score    :: score
                      , _gts'_children :: !(Set (GroupedTextScores' score))
+                     , _gts'_score    :: score
                      } deriving (Show, Ord, Eq)
 makeLenses 'GroupedTextScores'
 instance (Semigroup a, Ord a) => Semigroup (GroupedTextScores' a) where
@@ -45,8 +41,8 @@ instance (Semigroup a, Ord a) => Semigroup (GroupedTextScores' a) where
 
 -- | Intermediary Type
 data GroupedWithListScores =
-  GroupedWithListScores { _gwls_children :: !(Set Text)
-                        , _gwls_listType :: !(Maybe ListType)
+  GroupedWithListScores { _gwls_listType :: !(Maybe ListType)
+                        , _gwls_children :: !(Set Text)
                         } deriving (Show)
 makeLenses ''GroupedWithListScores
 instance Semigroup GroupedWithListScores where
@@ -55,5 +51,9 @@ instance Semigroup GroupedWithListScores where
         GroupedWithListScores (c1 <> c2)
                               (l1 <> l2)
 
+instance Monoid GroupedWithListScores where
+  mempty = GroupedWithListScores Nothing Set.empty
+
 ------------------------------------------------------------------------
 -- | Group With Stem Main Types
+

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

@@ -18,6 +18,7 @@ import Control.Lens (makeLenses, view, set)
 import Data.Semigroup
 import Data.Set (Set)
 import Data.Map (Map)
+import Data.Monoid (mempty)
 import Data.Maybe (catMaybes)
 import Data.Text (Text)
 import Gargantext.Core.Types (ListType(..))
@@ -29,22 +30,26 @@ import qualified Data.Set  as Set
 import qualified Data.Map  as Map
 
 
+------------------------------------------------------------------------
+------------------------------------------------------------------------
 ------------------------------------------------------------------------
 -- | Main function
 groupWithScores' :: FlowCont Text FlowListScores
                  -> (Text -> Set NodeId) -- Map Text (Set NodeId)
                  -> FlowCont Text (GroupedTextScores' (Set NodeId))
-groupWithScores' flc scores = FlowCont  groups orphans
+groupWithScores' flc _scores = FlowCont  groups orphans
   where
     groups  = toGroupedTextScores' $ view flc_scores flc
-    orphans = (view flc_cont flc)
+    -- parent/child relation is inherited from social lists
 
+    orphans = (view flc_cont flc)
+    -- orphans have been filtered already
 
+------------------------------------------------------------------------
+------------------------------------------------------------------------
 toGroupedTextScores' :: Map Text FlowListScores
                      -> Map Parent (GroupedTextScores' (Set NodeId))
 toGroupedTextScores' = toGroupedScores' . fromListScores'
-
-
 ------------------------------------------------------------------------
 fromListScores' :: Map Text FlowListScores
                 -> Map Parent GroupedWithListScores
@@ -52,18 +57,22 @@ fromListScores' = Map.fromListWith (<>) . (map fromScores') . Map.toList
   where
     fromScores' :: (Text, FlowListScores) -> (Text, GroupedWithListScores)
     fromScores' (t, fs) = case (keyWithMaxValue $ view fls_parents fs) of
-      Nothing     -> (t, GroupedWithListScores Set.empty (keyWithMaxValue $ view fls_listType fs))
+      Nothing     -> ( t
+                     , set gwls_listType (keyWithMaxValue $ view fls_listType fs) mempty
+                     )
           -- Parent case: taking its listType, for now children Set is empty
 
-      Just parent -> (parent, GroupedWithListScores (Set.singleton t) Nothing)
+      Just parent -> (parent, set gwls_children (Set.singleton t) mempty)
           -- We ignore the ListType of children for the parents' one
           -- added after and winner of semigroup actions
 
 
 toGroupedScores' :: Map Parent GroupedWithListScores
                  -> Map Parent (GroupedTextScores' (Set NodeId))
-toGroupedScores' = undefined -- Map.map (\(GroupedWithListScores c l) -> GroupedTextScores l Set.empty c)
+toGroupedScores' = undefined
+-- Map.map (\(GroupedWithListScores c l) -> GroupedTextScores l Set.empty c)
 
+-- toGroupedTree :: GroupedW
 
 
 
@@ -133,7 +142,7 @@ addIfNotExist mapSocialScores mapScores =
 ------------------------------------------------------------------------
 fromGroupedScores :: Map Parent GroupedWithListScores
                   -> Map Parent (GroupedTextScores (Set NodeId))
-fromGroupedScores = Map.map (\(GroupedWithListScores c l) -> GroupedTextScores l Set.empty c)
+fromGroupedScores = Map.map (\(GroupedWithListScores l c) -> GroupedTextScores l Set.empty c)
 
 ------------------------------------------------------------------------
 fromListScores :: Map Text FlowListScores -> Map Parent GroupedWithListScores
@@ -141,10 +150,10 @@ fromListScores = Map.fromListWith (<>) . (map fromScores') . Map.toList
   where
     fromScores' :: (Text, FlowListScores) -> (Text, GroupedWithListScores)
     fromScores' (t, fs) = case (keyWithMaxValue $ view fls_parents fs) of
-      Nothing     -> (t, GroupedWithListScores Set.empty (keyWithMaxValue $ view fls_listType fs))
+      Nothing     -> (t, set gwls_listType (keyWithMaxValue $ view fls_listType fs) mempty)
           -- Parent case: taking its listType, for now children Set is empty
  
-      Just parent -> (parent, GroupedWithListScores (Set.singleton t) Nothing)
+      Just parent -> (parent, set gwls_children (Set.singleton t) mempty)
           -- We ignore the ListType of children for the parents' one
           -- added after and winner of semigroup actions
 

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

@@ -37,8 +37,8 @@ type Parent = Text
 -- | DataType inspired by continuation Monad (but simpler)
 data FlowCont a b =
   FlowCont { _flc_scores :: Map a b
-               , _flc_cont   :: Set a
-               }
+           , _flc_cont   :: Set a
+           }
 
 instance Ord a => Monoid (FlowCont a b) where
   mempty = FlowCont Map.empty Set.empty
@@ -55,8 +55,8 @@ instance (Eq a, Ord a) => Semigroup (FlowCont a b) where
 
 -- | Datatype definition
 data FlowListScores =
-  FlowListScores { _fls_parents  :: Map Parent   Int
-                 , _fls_listType :: Map ListType Int
+  FlowListScores { _fls_listType :: Map ListType Int
+                 , _fls_parents  :: Map Parent   Int
                 -- You can add any score by incrementing this type
                 -- , _flc_score   :: Map Score Int
                  }
@@ -78,6 +78,8 @@ instance Semigroup FlowListScores where
         FlowListScores (p1 <> p2)
                        (l1 <> l2)
 
+instance Monoid FlowListScores where
+  mempty = FlowListScores Map.empty Map.empty
 
 ------------------------------------------------------------------------
 -- | Tools to inherit groupings

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

@@ -72,10 +72,10 @@ addList :: ListType
         -> Maybe FlowListScores
         -> Maybe FlowListScores
 addList l Nothing =
-  Just $ FlowListScores Map.empty (addListScore l Map.empty)
+  Just $ set fls_listType (addListScore l Map.empty) mempty
 
-addList l (Just (FlowListScores mapParent mapList)) =
-  Just $ FlowListScores mapParent (addListScore l mapList)
+addList l (Just fls) =
+  Just $ over fls_listType (addListScore l) fls
 
 -- * Unseful but nice comment:
 -- "the addList function looks like an ASCII bird"
@@ -101,14 +101,12 @@ addParent :: KeepAllParents -> NgramsRepoElement -> Set Text
           -> Maybe FlowListScores
 
 addParent k nre ss Nothing  =
-  Just $ FlowListScores mapParent Map.empty
+  Just $ FlowListScores Map.empty mapParent
     where
-      mapParent = addParentScore k (_nre_parent nre) ss Map.empty
+      mapParent = addParentScore k (view nre_parent nre) ss Map.empty
 
-addParent k nre ss (Just (FlowListScores mapParent mapList)) =
-  Just $ FlowListScores mapParent' mapList
-    where
-      mapParent' = addParentScore k (_nre_parent nre) ss mapParent
+addParent k nre ss (Just fls{-(FlowListScores mapList mapParent)-}) =
+  Just $ over fls_parents (addParentScore k (view nre_parent nre) ss) fls
 
 addParentScore :: Num a
            => KeepAllParents