[FEAT] Patches to scores (WIP)

package.yaml

@@ -188,6 +188,7 @@ library:
   - product-profunctors
   - profunctors
   - protolude
+  - pretty-simple
   - pureMD5
   - quickcheck-instances
   - rake

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

@@ -11,11 +11,14 @@ Portability : POSIX
 module Gargantext.Core.Text.List.Social
   where
 
+import Data.Map (Map)
 import Data.Monoid (mconcat)
 import Data.Text (Text)
 import Gargantext.API.Ngrams.Tools
 import Gargantext.API.Ngrams.Types
 import Gargantext.Core.Text.List.Social.Find
+import Gargantext.Core.Text.List.Social.History
+import Gargantext.Core.Text.List.Social.Patch
 import Gargantext.Core.Text.List.Social.Prelude
 import Gargantext.Core.Text.List.Social.Scores
 import Gargantext.Core.Types.Individu
@@ -81,9 +84,41 @@ flowSocialList flowPriority user nt flc =
                                   )
                                => NgramsType
                                -> FlowCont Text FlowListScores
-                               -> [NodeId]
+                               -> [ListId]
                                -> m (FlowCont Text FlowListScores)
       flowSocialListByModeWith nt'' flc'' ns =
             mapM (\l -> getListNgrams [l] nt'') ns
         >>= pure
           . toFlowListScores (keepAllParents nt'') flc''
+
+-----------------------------------------------------------------
+
+
+getHistory :: ( RepoCmdM env err m
+              , CmdM     env err m
+              , HasNodeError err
+              , HasTreeError err
+              )
+           => History
+           -> NgramsType
+           -> [ListId]
+           -> m (Map NgramsType (Map ListId [Map NgramsTerm NgramsPatch]))
+getHistory hist nt listes =
+  history hist [nt] listes  <$> getRepo
+
+
+getHistoryScores :: ( 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
+
+
+

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

@@ -21,13 +21,18 @@ import Gargantext.Prelude
 import qualified Data.List as List
 import qualified Data.Map.Strict as Map
 
+-- TODO put this in Prelude maybe
 cons :: a -> [a]
 cons a = [a]
 
+------------------------------------------------------------------------
+-- | History control
 data History = User
              | NotUser
              | AllHistory
 
+------------------------------------------------------------------------
+-- | Main Function
 history :: History
         -> [NgramsType]
         -> [ListId]
@@ -44,6 +49,7 @@ history NotUser t l = clean . (history' t l)
 
 history AllHistory t l = history' t l
 
+------------------------------------------------------------------------
 
 history' :: [NgramsType]
         -> [ListId]

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

@@ -26,23 +26,20 @@ import qualified Data.List as List
 import qualified Data.Map  as Map
 import qualified Data.Patch.Class as Patch (Replace(..))
 
-{-
-fromList [(NgramsTerms,fromList [(NodeId 189,
--}
 
-addScorePaches :: NgramsType -> [ListId]
-               -> Map NgramsType (Map ListId [Map NgramsTerm NgramsPatch])
+addScorePatches :: NgramsType -> [ListId]
                -> FlowCont Text FlowListScores
+               -> Map NgramsType (Map ListId [Map NgramsTerm NgramsPatch])
                -> FlowCont Text FlowListScores
-addScorePaches nt listes repo fl = foldl' (addScorePachesList nt repo) fl listes
+addScorePatches nt listes fl repo = foldl' (addScorePatchesList nt repo) fl listes
 
 
-addScorePachesList :: NgramsType
+addScorePatchesList :: NgramsType
                    -> Map NgramsType (Map ListId [Map NgramsTerm NgramsPatch])
                    -> FlowCont Text FlowListScores
                    -> ListId
                    -> FlowCont Text FlowListScores
-addScorePachesList nt repo fl lid = foldl' addScorePatch fl patches
+addScorePatchesList nt repo fl lid = foldl' addScorePatch fl patches
   where
     patches = maybe [] (List.concat . (map Map.toList)) patches'
 
@@ -77,6 +74,17 @@ addScorePatch fl (NgramsTerm t, (NgramsPatch _children (Patch.Replace old_list n
 {-
 [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"},())])})})]
+
+,fromList [(NgramsTerm {unNgramsTerm = "NOT FOUND"},NgramsPatch {_patch_children = PatchMSet (PatchMap (fromList [])), _patch_list = Replace {_old = MapTerm, _new = StopTerm}})]])])]
+
 -}
 addScorePatch fl (NgramsTerm t, NgramsPatch children Patch.Keep) = foldl' add fl $ toList children
   where
@@ -107,5 +115,3 @@ score field list n m = (Just mempty <> m)
                . field
                . at list
                %~ (<> Just n)
-
-