[FIX] ListType working now with history patch

src/Gargantext/Core/Text/List.hs

@@ -101,9 +101,18 @@ buildNgramsOthersList user uCid groupParams (nt, MapListSize mapListSize) = do
                                                                  (List.cycle [mempty])
                                            )
 
+  if nt == Authors
+     then printDebug "flowSocialList" socialLists
+     else printDebug "flowSocialList" ""
+
   let
     groupedWithList = toGroupedTree groupParams socialLists allTerms
 
+  if nt == Authors
+     then printDebug "groupedWithList" groupedWithList
+     else printDebug "groupedWithList" ""
+
+
   let
     (stopTerms, tailTerms) = Map.partition ((== Just StopTerm) . viewListType)
                            $ view flc_scores groupedWithList

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

@@ -32,7 +32,7 @@ import qualified Data.Map  as Map
 groupWithScores' :: (Eq a, Ord a, Monoid a)
                 => FlowCont Text FlowListScores
                 -> (Text -> a) -- Map Text (a)
-                -> FlowCont Text (GroupedTreeScores (a))
+                -> FlowCont Text (GroupedTreeScores a)
 groupWithScores' flc scores = FlowCont  groups orphans
   where
     -- parent/child relation is inherited from social lists
@@ -44,11 +44,12 @@ groupWithScores' flc scores = FlowCont  groups orphans
     orphans = toGroupedTree
             $ toMapMaybeParent scores
             $ view flc_cont flc
+
 ------------------------------------------------------------------------
 toMapMaybeParent :: (Eq a, Ord a, Monoid a)
                  => (Text -> a)
                  -> Map Text FlowListScores
-                 -> Map (Maybe Parent) (Map Text (GroupedTreeScores (a)))
+                 -> Map (Maybe Parent) (Map Text (GroupedTreeScores a))
 toMapMaybeParent f =  Map.fromListWith (<>)
                    . (map (fromScores'' f))
                    .  Map.toList
@@ -56,7 +57,7 @@ toMapMaybeParent f =  Map.fromListWith (<>)
 fromScores'' :: (Eq a, Ord a, Monoid a)
              => (Text -> a)
              -> (Text, FlowListScores)
-             -> (Maybe Parent, Map Text (GroupedTreeScores (a)))
+             -> (Maybe Parent, Map Text (GroupedTreeScores a))
 fromScores'' f' (t, fs) = ( maybeParent
                           , Map.fromList [( t, set gts'_score (f' t)
                                              $ set gts'_listType maybeList mempty
@@ -66,17 +67,18 @@ fromScores'' f' (t, fs) = ( maybeParent
      maybeParent = keyWithMaxValue $ view fls_parents  fs
      maybeList   = keyWithMaxValue $ view fls_listType fs
 
+------------------------------------------------------------------------
 toGroupedTree :: Eq a
-              => Map (Maybe Parent) (Map Text (GroupedTreeScores (a)))
-              -> Map Parent (GroupedTreeScores (a))
+              => Map (Maybe Parent) (Map Text (GroupedTreeScores a))
+              -> Map Parent (GroupedTreeScores a)
 toGroupedTree m = case Map.lookup Nothing m of
   Nothing  -> mempty
   Just  m' -> toGroupedTree' m m'
 
 
-toGroupedTree' :: Eq a => Map (Maybe Parent) (Map Text (GroupedTreeScores (a)))
-               -> (Map Text (GroupedTreeScores (a)))
-               ->  Map Parent (GroupedTreeScores (a))
+toGroupedTree' :: Eq a => Map (Maybe Parent) (Map Text (GroupedTreeScores a))
+               -> (Map Text (GroupedTreeScores a))
+               ->  Map Parent (GroupedTreeScores a)
 toGroupedTree' m notEmpty
   | notEmpty == mempty = mempty
   | otherwise = Map.mapWithKey (addGroup m) notEmpty
@@ -89,9 +91,3 @@ toGroupedTree' m notEmpty
                                            )
                                            v
 
-
-
-
-
-
-

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

@@ -86,39 +86,39 @@ flowSocialList flowPriority user nt flc =
                                -> FlowCont Text FlowListScores
                                -> [ListId]
                                -> m (FlowCont Text FlowListScores)
-      flowSocialListByModeWith nt'' flc'' ns =
-            mapM (\l -> getListNgrams [l] nt'') ns
+      flowSocialListByModeWith nt'' flc'' listes =
+        getHistoryScores History_User nt'' flc'' listes
+        {-
+            mapM (\l -> getListNgrams [l] nt'') listes
         >>= pure
           . toFlowListScores (keepAllParents nt'') flc''
-
+        -}
 -----------------------------------------------------------------
-
-
-getHistory :: ( RepoCmdM env err m
+getHistoryScores :: ( RepoCmdM env err m
                     , CmdM     env err m
                     , HasNodeError err
                     , HasTreeError err
                     )
                  => History
                  -> NgramsType
+                 -> FlowCont Text FlowListScores
                  -> [ListId]
-           -> m (Map NgramsType (Map ListId [Map NgramsTerm NgramsPatch]))
-getHistory hist nt listes =
-  history hist [nt] listes  <$> getRepo
-
+                 -> m (FlowCont Text FlowListScores)
+getHistoryScores hist nt fl listes = do
+  hist' <- addScorePatches nt listes fl <$> getHistory hist nt listes
+  -- printDebug "hist" hist'
+  pure hist'
 
-getHistoryScores :: ( RepoCmdM env err m
+getHistory :: ( RepoCmdM env err m
               , CmdM     env err m
               , HasNodeError err
               , HasTreeError err
               )
            => History
            -> NgramsType
-                 -> FlowCont Text FlowListScores
            -> [ListId]
-                 -> m (FlowCont Text FlowListScores)
-getHistoryScores hist nt fl listes =
-  addScorePatches nt listes fl <$> getHistory hist nt listes
-
+           -> m (Map NgramsType (Map ListId [Map NgramsTerm NgramsPatch]))
+getHistory hist nt listes =
+  history hist [nt] listes  <$> getRepo
 
 

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

@@ -65,7 +65,6 @@ Children are not modified in this specific case.
 -- | Old list get -1 score
 -- New list get +1 score
 -- Hence others lists lay around 0 score
--- TODO add children
 addScorePatch fl (NgramsTerm t, (NgramsPatch children' (Patch.Replace old_list new_list))) =
   -- | Adding New Children score
   addScorePatch fl' (NgramsTerm t, NgramsPatch children' Patch.Keep)
@@ -73,27 +72,30 @@ addScorePatch fl (NgramsTerm t, (NgramsPatch children' (Patch.Replace old_list n
       -- | Adding New ListType score
       fl' = fl & flc_scores . at t %~ (score fls_listType old_list (-1))
           & flc_scores . at t %~ (score fls_listType new_list ( 1))
+          & flc_cont   %~ (Map.delete t)
 
 -- | Patching existing Ngrams with children
 addScorePatch fl (NgramsTerm p, NgramsPatch children' Patch.Keep) =
-  foldl' add' fl $ patchMSet_toList children'
+  foldl' addChild fl $ patchMSet_toList children'
     where
       -- | Adding a child
-      add' fl' (NgramsTerm t, Patch.Replace Nothing (Just _)) = doLink ( 1) p t fl'
+      addChild fl' (NgramsTerm t, Patch.Replace Nothing (Just _)) = doLink ( 1) p t fl'
       -- | Removing a child
-      add' fl' (NgramsTerm t, Patch.Replace (Just _) Nothing) = doLink (-1) p t fl'
+      addChild fl' (NgramsTerm t, Patch.Replace (Just _) Nothing) = doLink (-1) p t fl'
 
       -- | This case should not happen: does Nothing
-      add' fl' _ = fl'
+      addChild fl' _ = fl'
 
 -- | Inserting a new Ngrams
 addScorePatch fl (NgramsTerm t, NgramsReplace Nothing (Just nre)) =
   childrenScore 1 t (nre ^. nre_children) 
   $ fl & flc_scores . at t %~ (score fls_listType $ nre ^. nre_list) 1
+       & flc_cont   %~ (Map.delete t)
 
 addScorePatch fl (NgramsTerm t, NgramsReplace (Just old_nre) maybe_new_nre) =
   let fl' = childrenScore (-1) t (old_nre ^. nre_children) 
             $ fl & flc_scores . at t %~ (score fls_listType $ old_nre ^. nre_list) (-1)
+                 & flc_cont   %~ (Map.delete t)
     in case maybe_new_nre of
       Nothing      -> fl'
       Just new_nre -> addScorePatch fl' (NgramsTerm t, NgramsReplace Nothing (Just new_nre))

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

@@ -25,6 +25,7 @@ import Data.Semigroup (Semigroup(..))
 import Data.Text (Text)
 import GHC.Generics (Generic)
 import Gargantext.API.Ngrams.Types
+import Gargantext.Core.Text.Metrics.Freq (getMaxFromMap)
 import Gargantext.Core.Types.Main
 import Gargantext.Prelude
 import qualified Data.Map   as Map
@@ -96,9 +97,7 @@ parentUnionsExcl :: Ord a
                  ->  Map a b
 parentUnionsExcl = Map.unions
 
-
 ------------------------------------------------------------------------
-
 hasParent :: Text
           -> Map Text (Map Parent Int)
           -> Maybe Parent
@@ -114,14 +113,21 @@ hasParent t m = case Map.lookup t m of
 -- Just 'z'
 -- >>> keyWithMaxValue $ DM.fromList $ zip (['a'..'z'] :: [Char]) ([-1,-2..]::[Int])
 -- Nothing
-keyWithMaxValue :: (Ord b, Num b) => Map a b -> Maybe a
+keyWithMaxValue :: (Ord a, Ord b, Num b) => Map a b -> Maybe a
 keyWithMaxValue m = do
-  (k,a) <- fst <$> Map.maxViewWithKey m
-  if a > 0
-    then Just k
+  k <- headMay $ getMaxFromMap m
+  maxValue <- Map.lookup k m
+  if maxValue > 0
+     then pure k
      else Nothing
 
 
+findMax :: (Ord b, Num b) => Map a b -> Maybe (a,b)
+findMax m = case Map.null m of
+  True  -> Nothing
+  False -> Just $ Map.findMax m
+
+
 ------------------------------------------------------------------------
 unPatchMap :: Ord a => PatchMap a b -> Map a b
 unPatchMap = Map.fromList . PatchMap.toList