[NGRAMS] Extract the listId parameter

src/Gargantext/API/Ngrams.hs

@@ -270,19 +270,18 @@ ngramError nne = throwError $ _NgramError # nne
 -- `GraphList` and that the patch is `Replace CandidateList StopList` then
 -- the list is going to be `StopList` while it should keep `GraphList`.
 -- However this should not happen in non conflicting situations.
-mkListsUpdate :: ListId -> NgramsType -> NgramsTablePatch -> [(ListId, NgramsTypeId, NgramsTerm, ListTypeId)]
-mkListsUpdate lId nt patches =
-  [ (lId, ngramsTypeId nt, ng, listTypeId lt)
+mkListsUpdate :: NgramsType -> NgramsTablePatch -> [(NgramsTypeId, NgramsTerm, ListTypeId)]
+mkListsUpdate nt patches =
+  [ (ngramsTypeId nt, ng, listTypeId lt)
   | (ng, patch) <- patches ^.. ntp_ngrams_patches . ifolded . withIndex
   , lt <- patch ^.. patch_list . new
   ]
 
-mkChildrenGroups :: ListId
-                 -> (PatchSet NgramsTerm -> Set NgramsTerm)
+mkChildrenGroups :: (PatchSet NgramsTerm -> Set NgramsTerm)
                  -> NgramsTablePatch
-                 -> [(ListId, NgramsParent, NgramsChild, Maybe Double)]
-mkChildrenGroups lId addOrRem patches =
-  [ (lId, parent, child, Just 1)
+                 -> [(NgramsParent, NgramsChild, Maybe Double)]
+mkChildrenGroups addOrRem patches =
+  [ (parent, child, Just 1)
   | (parent, patch) <- patches ^.. ntp_ngrams_patches . ifolded . withIndex
   , child <- patch ^.. patch_children . to addOrRem . folded
   ]
@@ -314,9 +313,10 @@ tableNgramsPatch corpusId maybeTabType maybeList (Versioned version patch) = do
   let ngramsType = ngramsTypeFromTabType maybeTabType
   listId <- maybe (defaultList corpusId) pure maybeList
   updateNodeNgrams $ NodeNgramsUpdate
-    { _nnu_lists_update = mkListsUpdate listId ngramsType patch
-    , _nnu_rem_children = mkChildrenGroups listId _rem patch
-    , _nnu_add_children = mkChildrenGroups listId _add patch
+    { _nnu_user_list_id = listId
+    , _nnu_lists_update = mkListsUpdate ngramsType patch
+    , _nnu_rem_children = mkChildrenGroups _rem patch
+    , _nnu_add_children = mkChildrenGroups _add patch
     }
   pure $ Versioned 1 emptyNgramsTablePatch
 

src/Gargantext/Database/Schema/NodeNgram.hs

@@ -46,7 +46,7 @@ import Gargantext.Database.Schema.NodeNgramsNgrams (NgramsChild, NgramsParent, n
 import Gargantext.Prelude
 import Gargantext.Database.Utils (formatPGSQuery)
 import Opaleye
-import qualified Database.PostgreSQL.Simple as PGS (Only(..), Query)
+import qualified Database.PostgreSQL.Simple as PGS (Query)
 
 -- | TODO : remove id
 data NodeNgramPoly node_id ngrams_id ngrams_type list_type weight
@@ -123,14 +123,14 @@ insertNodeNgramW nns =
 
 type NgramsText = Text
 
-updateNodeNgrams' :: [(ListId, NgramsTypeId, NgramsText, ListTypeId)] -> Cmd err ()
-updateNodeNgrams' [] = pure ()
-updateNodeNgrams' input = void $ execPGSQuery updateQuery (PGS.Only $ Values fields input)
+updateNodeNgrams' :: ListId -> [(NgramsTypeId, NgramsText, ListTypeId)] -> Cmd err ()
+updateNodeNgrams' _      []    = pure ()
+updateNodeNgrams' listId input = void $ execPGSQuery updateQuery (listId, Values fields input)
   where
     fields = map (\t-> QualifiedIdentifier Nothing t) ["int4","int4","text","int4"]
 
-updateNodeNgrams'' :: [(ListId, NgramsTypeId, NgramsText, ListTypeId)] -> Cmd err ByteString
-updateNodeNgrams'' input = formatPGSQuery updateQuery (PGS.Only $ Values fields input)
+updateNodeNgrams'_debug :: ListId -> [(NgramsTypeId, NgramsText, ListTypeId)] -> Cmd err ByteString
+updateNodeNgrams'_debug listId input = formatPGSQuery updateQuery (listId, Values fields input)
   where
     fields = map (\t-> QualifiedIdentifier Nothing t) ["int4","int4","text","int4"]
 
@@ -153,14 +153,17 @@ UPDATE SET list_type = excluded.list_type
 
 
 data NodeNgramsUpdate = NodeNgramsUpdate
-  { _nnu_lists_update :: [(ListId, NgramsTypeId, NgramsText, ListTypeId)]
-  , _nnu_add_children :: [(ListId, NgramsParent, NgramsChild, Maybe Double)]
-  , _nnu_rem_children :: [(ListId, NgramsParent, NgramsChild, Maybe Double)]
+  { _nnu_user_list_id :: ListId
+  , _nnu_lists_update :: [(NgramsTypeId, NgramsText, ListTypeId)]
+  , _nnu_add_children :: [(NgramsParent, NgramsChild, Maybe Double)]
+  , _nnu_rem_children :: [(NgramsParent, NgramsChild, Maybe Double)]
   }
 
 -- TODO wrap these updates in a transaction.
 updateNodeNgrams :: NodeNgramsUpdate -> Cmd err ()
 updateNodeNgrams nnu = do
-  updateNodeNgrams' $ _nnu_lists_update nnu
-  ngramsGroup Del   $ _nnu_rem_children nnu
-  ngramsGroup Add   $ _nnu_add_children nnu
+  updateNodeNgrams' userListId $ _nnu_lists_update nnu
+  ngramsGroup Del   userListId $ _nnu_rem_children nnu
+  ngramsGroup Add   userListId $ _nnu_add_children nnu
+  where
+    userListId = _nnu_user_list_id nnu

src/Gargantext/Database/Schema/NodeNgramsNgrams.hs

@@ -129,27 +129,27 @@ type NgramsParent = Text
 type NgramsChild  = Text
 
 
-ngramsGroup :: Action -> [(ListId, NgramsParent, NgramsChild, Maybe Double)]
+ngramsGroup :: Action -> ListId -> [(NgramsParent, NgramsChild, Maybe Double)]
              -> Cmd err ()
-ngramsGroup _ [] = pure ()
-ngramsGroup action ngs = trace (show ngs) $ runNodeNgramsNgrams q ngs
+ngramsGroup _ _ [] = pure ()
+ngramsGroup action listId ngs = trace (show ngs) $ runNodeNgramsNgrams q listId ngs
   where
     q = case action of
           Del -> queryDelNodeNgramsNgrams
           Add -> queryInsertNodeNgramsNgrams
 
 
-runNodeNgramsNgrams :: PGS.Query -> [(ListId, NgramsParent, NgramsChild, Maybe Double)] -> Cmd err ()
-runNodeNgramsNgrams q ngs = void $ execPGSQuery q (PGS.Only $ Values fields ngs')
+runNodeNgramsNgrams :: PGS.Query -> ListId -> [(NgramsParent, NgramsChild, Maybe Double)] -> Cmd err ()
+runNodeNgramsNgrams q listId ngs = void $ execPGSQuery q (listId, Values fields ngs')
   where
-    ngs'   = map (\(n,ng1,ng2,w) -> (n,ng1,ng2,maybe 0 identity w)) ngs
+    ngs'   = map (\(ng1,ng2,w) -> (ng1,ng2,maybe 0 identity w)) ngs
     fields = map (\t -> QualifiedIdentifier Nothing t)
                  ["int4","text","text","float8"]
 
-runNodeNgramsNgramsDebug :: PGS.Query -> [(ListId, NgramsParent, NgramsChild, Maybe Double)] -> Cmd err ByteString
-runNodeNgramsNgramsDebug q ngs = formatPGSQuery q (PGS.Only $ Values fields ngs')
+runNodeNgramsNgramsDebug :: PGS.Query -> ListId -> [(NgramsParent, NgramsChild, Maybe Double)] -> Cmd err ByteString
+runNodeNgramsNgramsDebug q listId ngs = formatPGSQuery q (listId, Values fields ngs')
   where
-    ngs'   = map (\(n,ng1,ng2,w) -> (n,ng1,ng2,maybe 0 identity w)) ngs
+    ngs'   = map (\(ng1,ng2,w) -> (ng1,ng2,maybe 0 identity w)) ngs
     fields = map (\t -> QualifiedIdentifier Nothing t)
                  ["int4","text","text","float8"]
 
@@ -158,7 +158,8 @@ runNodeNgramsNgramsDebug q ngs = formatPGSQuery q (PGS.Only $ Values fields ngs'
 -- TODO: on conflict update weight
 queryInsertNodeNgramsNgrams :: PGS.Query
 queryInsertNodeNgramsNgrams = [sql|
-    WITH input_rows(nId,ng1,ng2,w) AS (?)
+    WITH nId AS ?
+    WITH input_rows(ng1,ng2,w) AS (?)
     INSERT INTO nodes_ngrams_ngrams (node_id,ngram1_id,ngram2_id,weight)
     SELECT nId,ngrams1.id,ngrams2.id,w FROM input_rows
     JOIN ngrams ngrams1 ON ngrams1.terms = ng1
@@ -168,7 +169,8 @@ queryInsertNodeNgramsNgrams = [sql|
 
 queryDelNodeNgramsNgrams :: PGS.Query
 queryDelNodeNgramsNgrams = [sql|
-    WITH input(nId,ng1,ng2,w) AS (?)
+    WITH nId AS ?
+    WITH input(ng1,ng2,w) AS (?)
     DELETE FROM nodes_ngrams_ngrams AS nnn
     USING ngrams AS ngrams1,
           ngrams AS ngrams2,