[Patch Scores] needs tests

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

@@ -27,9 +27,9 @@ cons a = [a]
 
 ------------------------------------------------------------------------
 -- | History control
-data History = User
-             | NotUser
-             | AllHistory
+data History = History_User
+             | History_NotUser
+             | History_All
 
 ------------------------------------------------------------------------
 -- | Main Function
@@ -38,16 +38,16 @@ history :: History
         -> [ListId]
         -> Repo s NgramsStatePatch
         -> Map NgramsType (Map ListId [Map NgramsTerm NgramsPatch])
-history User t l = clean . (history' t l)
+history History_User t l = clean . (history' t l)
   where
     clean = Map.map (Map.map List.init)
 
-history NotUser t l = clean . (history' t l)
+history History_NotUser t l = clean . (history' t l)
   where
     clean = Map.map (Map.map last)
     last = (maybe [] cons) . lastMay
 
-history AllHistory t l = history' t l
+history _ t l = history' t l
 
 ------------------------------------------------------------------------
 

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

@@ -53,6 +53,7 @@ addScorePatchesList nt repo fl lid = foldl' addScorePatch fl patches
 addScorePatch :: FlowCont Text FlowListScores
               -> (NgramsTerm , NgramsPatch)
               -> FlowCont Text FlowListScores
+
 {- | Case of changing listType only. Patches look like:
 
 This patch move "problem" from MapTerm to CandidateTerm
@@ -70,48 +71,47 @@ Children are not modified in this specific case.
 addScorePatch fl (NgramsTerm t, (NgramsPatch _children (Patch.Replace old_list new_list))) =
   fl & flc_scores . at t %~ (score fls_listType old_list (-1))
      & flc_scores . at t %~ (score fls_listType new_list ( 1))
-     
-{-
-[fromList [(NgramsTerm {unNgramsTerm = "approach"},NgramsPatch {_patch_children = PatchMSet (PatchMap (fromList [(NgramsTerm {unNgramsTerm = "order"},Replace {_old = Just (), _new = Nothing})])), _patch_list = Keep})]
-,fromList [(NgramsTerm {unNgramsTerm = "approach"},NgramsPatch {_patch_children = PatchMSet (PatchMap (fromList [(NgramsTerm {unNgramsTerm = "order"},Replace {_old = Nothing, _new = Just ()})])), _patch_list = Keep})]
 
 
-fromList [(NgramsTerm {unNgramsTerm = "Journals"}
-   ,NgramsReplace { _patch_old = Nothing
-                  , _patch_new = Just (NgramsRepoElement { _nre_size = 1
-                                                         , _nre_list = MapTerm
-                                                         , _nre_root = Nothing
-                                                         , _nre_parent = Nothing, _nre_children = MSet (fromList [(NgramsTerm {unNgramsTerm = "European Journal of Operational Research"},()),(NgramsTerm {unNgramsTerm = "Physical Review C"},())])})})]
+addScorePatch fl (NgramsTerm p, NgramsPatch children Patch.Keep) =
+  foldl' add fl $ toList children
+    where
+        add fl' (NgramsTerm t, Patch.Replace Nothing (Just _)) = doLink ( 1) p t fl'
+        add fl' (NgramsTerm t, Patch.Replace (Just _) Nothing) = doLink (-1) p t fl'
+        add _ _ = panic "addScorePatch: Error should not happen"
 
-,fromList [(NgramsTerm {unNgramsTerm = "NOT FOUND"},NgramsPatch {_patch_children = PatchMSet (PatchMap (fromList [])), _patch_list = Replace {_old = MapTerm, _new = StopTerm}})]])])]
+        toList :: Ord a => PatchMSet a -> [(a,AddRem)]
+        toList = Map.toList . unPatchMap . unPatchMSet
 
--}
-addScorePatch fl (NgramsTerm t, NgramsPatch children Patch.Keep) = foldl' add fl $ toList children
-  where
-      add fl' (NgramsTerm t, Patch.Replace Nothing (Just _)) = doLink ( 1) t fl'
-      add fl' (NgramsTerm t, Patch.Replace (Just _) Nothing) = doLink (-1) t fl'
-      add _ _ = panic "addScorePatch: Error should not happen"
 
-      toList :: Ord a => PatchMSet a -> [(a,AddRem)]
-      toList = Map.toList . unPatchMap . unPatchMSet
+-- | 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
 
-      doLink n child fl' = fl' & flc_scores . at child %~ (score fls_parents child n)
+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)
+    in case maybe_new_nre of
+      Nothing      -> fl'
+      Just new_nre -> addScorePatch fl' (NgramsTerm t, NgramsReplace Nothing (Just new_nre))
 
+-------------------------------------------------------------------------------
 
--- | TODO
-addScorePatch _ (NgramsTerm _, NgramsReplace _nre Nothing) =
-  panic "[G.C.T.L.S.P.addScorePatch] TODO needs nre"
-
-{- | Inserting a new Ngrams
-fromList [(NgramsTerm {unNgramsTerm = "journal"},NgramsReplace {_patch_old = Nothing, _patch_new = Just (NgramsRepoElement {_nre_size = 1, _nre_list = CandidateTerm, _nre_root = Nothing, _nre_parent = Nothing, _nre_children = MSet (fromList [])})})],f
--}
-addScorePatch fl (NgramsTerm t, NgramsReplace _ (Just nre)) =
-  fl & flc_scores . at t %~ (score fls_listType $ nre ^. nre_list) ( 1)
+childrenScore n parent children fl =
+  foldl' add fl $ unMSet children
+    where
+        add fl' (NgramsTerm t) = doLink n parent t fl'
 
 
+doLink n parent child fl' = fl' & flc_scores . at child %~ (score fls_parents parent n)
 -- score :: ListType -> Int -> Maybe FlowListScores -> Maybe FlowListScores
 score field list n m = (Just mempty <> m)
-               & _Just
-               . field
-               . at list
-               %~ (<> Just n)
+                     & _Just
+                     . field
+                     . at list
+                     %~ (<> Just n)
+
+unMSet :: MSet a -> [a]
+unMSet (MSet a) = Map.keys a
+