[FEAT] Social Lists on History (WIP)

src/Gargantext/API/Ngrams/Tools.hs

@@ -47,6 +47,8 @@ listNgramsFromRepo nodeIds ngramsType repo = Map.mapKeys unNgramsTerm ngrams
     ngrams    = Map.unionsWith mergeNgramsElement
                 [ ngramsMap ^. at nodeId . _Just | nodeId <- nodeIds ]
 
+
+
 -- TODO-ACCESS: We want to do the security check before entering here.
 --              Add a static capability parameter would be nice.
 --              Ideally this is the access to `repoVar` which needs to

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

+{-|
+Module      : Gargantext.Core.Text.List.Merge
+Description :
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+-}
+
+{-# LANGUAGE TemplateHaskell        #-}
+{-# LANGUAGE ConstraintKinds        #-}
+{-# LANGUAGE TypeFamilies           #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE InstanceSigs           #-}
+
+module Gargantext.Core.Text.List.Merge
+  where
+
+import Control.Lens (view)
+import Data.Map (Map)
+import Data.Text (Text)
+import Gargantext.API.Ngrams
+import Gargantext.API.Ngrams.Types
+import Gargantext.Prelude
+import Data.Map.Strict.Patch hiding (PatchMap)
+
+type List = Map Text NgramsRepoElement
+type Patch = PatchMap Text (Replace (Maybe NgramsRepoElement))
+
+-- Question: which version of Patching increment is using the FrontEnd ?
+diffList :: Versioned List -> Versioned List -> Versioned Patch
+diffList l1 l2 = Versioned (1 + view v_version l1)
+                           (diff (view v_data l1) (view v_data l2))
+
+-- | TODO
+{-
+commit :: ListId -> NgramsType -> Versioned Patch -> List -> List
+commit = undefined
+-}

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

+{-|
+Module      : Gargantext.Core.Text.List.Social.History
+Description :
+Copyright   : (c) CNRS, 2018-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+-}
+
+module Gargantext.Core.Text.List.Social.History
+  where
+
+import Data.Maybe (catMaybes)
+import Data.Map (Map)
+import Control.Lens (view)
+import Gargantext.API.Ngrams.Types
+import Gargantext.Prelude
+import Gargantext.Core.Types (ListType(..), ListId, NodeId)
+import qualified Data.Map.Strict.Patch as PatchMap
+import qualified Data.Map.Strict as Map
+import qualified Data.List as List
+import Gargantext.Database.Schema.Ngrams (NgramsType(..))
+
+toMap :: Ord a => PatchMap a b -> Map a b
+toMap = Map.fromList . PatchMap.toList
+
+toMap' :: (Ord a, Ord b) => PatchMap a (PatchMap b c) -> Map a (Map b c)
+toMap' = (Map.map toMap) . toMap
+
+-- type NgramsRepo       = Repo NgramsState NgramsStatePatch
+-- type NgramsState      = Map      TableNgrams.NgramsType (Map NodeId NgramsTableMap)
+-- type NgramsStatePatch = PatchMap TableNgrams.NgramsType (PatchMap NodeId NgramsTablePatch)
+-- type NgramsTablePatch = Map NgramsTerm NgramsPatch
+
+
+toMap'' :: NgramsStatePatch
+        -> Map NgramsType
+           (Map ListId
+            (Map NgramsTerm NgramsPatch
+            )
+           )
+toMap'' = undefined
+
+
+history :: Foldable t
+        => NgramsType
+        -> t ListId
+        -> Repo s NgramsStatePatch
+        -> Map ListId [Map NgramsTerm NgramsPatch]
+history nt lists = Map.unionsWith (<>)
+                 . map (Map.map cons)
+                 . map (Map.filterWithKey (\k _ -> List.elem k lists))
+                 . catMaybes
+                 . map (Map.lookup nt)
+                 . map toMap''
+                 . view r_history
+  where
+    cons a = a : []

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

@@ -90,7 +90,6 @@ updateScores k t nre setText mtf =
 ------------------------------------------------------------------------
 -- | Main addFunctions to groupResolution the FlowListScores
 -- Use patch-map library here
--- diff, transformWith patches simplifies functions below
 addList :: ListType
         -> Maybe FlowListScores
         -> Maybe FlowListScores
@@ -110,11 +109,11 @@ addListScore l m = Map.alter (plus l) l  m
     plus CandidateTerm Nothing  = Just 1
     plus CandidateTerm (Just x) = Just $ x + 1
 
-    plus MapTerm Nothing        = Just 2
-    plus MapTerm (Just x)       = Just $ x + 2
+    plus MapTerm Nothing        = Just 1
+    plus MapTerm (Just x)       = Just $ x + 1
 
-    plus StopTerm Nothing       = Just 3
-    plus StopTerm (Just x)      = Just $ x + 3
+    plus StopTerm Nothing       = Just 1
+    plus StopTerm (Just x)      = Just $ x + 1
 
 ------------------------------------------------------------------------
 data KeepAllParents = KeepAllParents Bool