[DB] Node_NodeNgrams_NodeNgrams insertion in flowList (WIP).

devops/postgres/schema.sql

@@ -64,6 +64,7 @@ CREATE TABLE public.node_ngrams_ngrams (
     node_id integer NOT NULL,
     node_ngrams1_id integer NOT NULL,
     node_ngrams2_id integer NOT NULL,
+    weight double precision,
     FOREIGN KEY (node_id) REFERENCES public.nodes(id) ON DELETE CASCADE,
     FOREIGN KEY (node_ngrams1_id) REFERENCES public.node_ngrams(id) ON DELETE CASCADE,
     FOREIGN KEY (node_ngrams2_id) REFERENCES public.node_ngrams(id) ON DELETE CASCADE,

src/Gargantext/API/Ngrams.hs

@@ -252,7 +252,7 @@ data NgramsElement =
                    , _ne_occurrences :: Int
                    , _ne_root        :: Maybe NgramsTerm
                    , _ne_parent      :: Maybe NgramsTerm
-                   , _ne_children    :: MSet NgramsTerm
+                   , _ne_children    :: MSet  NgramsTerm
                    }
       deriving (Ord, Eq, Show, Generic)
 

src/Gargantext/Core/Flow.hs → src/Gargantext/Core/Flow/Types.hs

 {-|
-Module      : Gargantext.Core.Flow
+Module      : Gargantext.Core.Flow.Types
 Description : Core Flow main Types
 Copyright   : (c) CNRS, 2017-Present
 License     : AGPL + CECILL v3
@@ -13,7 +13,7 @@ Portability : POSIX
 {-# LANGUAGE RankNTypes        #-}
 {-# LANGUAGE ConstrainedClassMethods #-}
 
-module Gargantext.Core.Flow where
+module Gargantext.Core.Flow.Types where
 
 import Control.Lens (Lens')
 import Data.Map (Map)
@@ -40,7 +40,10 @@ class UniqId a
 
 class ExtractNgramsT h
   where
-    extractNgramsT :: HasText h => TermType Lang -> h -> Cmd err (Map Ngrams (Map NgramsType Int))
+    extractNgramsT :: HasText h
+                   => TermType Lang
+                   -> h
+                   -> Cmd err (Map Ngrams (Map NgramsType Int))
 
 class HasText h
   where
@@ -54,3 +57,6 @@ instance UniqId HyperdataContact
   where
     uniqId = hc_uniqId
 
+
+
+

src/Gargantext/Database/Flow.hs

@@ -50,7 +50,7 @@ import Data.Text (Text, splitOn, intercalate)
 import Gargantext.Core (Lang(..))
 import Gargantext.Core.Types (NodePoly(..), Terms(..))
 import Gargantext.Core.Types.Individu (Username)
-import Gargantext.Core.Flow
+import Gargantext.Core.Flow.Types
 import Gargantext.Core.Types.Main
 import Gargantext.Database.Config (userMaster, corpusMasterName)
 import Gargantext.Database.Flow.Utils (insertDocNgrams)
@@ -223,7 +223,7 @@ flowCorpusUser l userName corpusName ctype ids = do
   --{-
   (_masterUserId, _masterRootId, masterCorpusId) <- getOrMkRootWithCorpus userMaster (Left "") ctype
   ngs        <- buildNgramsLists l 2 3 (StopSize 3) userCorpusId masterCorpusId
-  _userListId <- flowList listId ngs
+  _userListId <- flowList masterCorpusId listId ngs
   --mastListId <- getOrMkList masterCorpusId masterUserId
   -- _ <- insertOccsUpdates userCorpusId mastListId
   -- printDebug "userListId" userListId

src/Gargantext/Database/Flow/List.hs

@@ -25,10 +25,11 @@ module Gargantext.Database.Flow.List
     where
 import Control.Monad (mapM_)
 import Data.Map (Map, toList)
-import Data.Maybe (Maybe(..))
+import Data.Maybe (Maybe(..), catMaybes)
 import Gargantext.API.Ngrams (NgramsElement(..), putListNgrams)
 import Gargantext.Database.Schema.Ngrams -- (insertNgrams, Ngrams(..), NgramsIndexed(..), indexNgrams,  NgramsType(..), text2ngrams, ngramsTypeId)
-import Gargantext.Database.Schema.NodeNgrams (NodeNgramsPoly(..), NodeNgramsW, listInsertDb)
+import Gargantext.Database.Schema.NodeNgrams (NodeNgramsPoly(..), NodeNgramsW, listInsertDb, getCgramsId)
+import Gargantext.Database.Schema.Node_NodeNgramsNodeNgrams -- (insert_Node_NodeNgrams_NodeNgrams, Node_NodeNgrams_NodeNgrams(..))
 import Gargantext.Database.Types.Node -- (HyperdataDocument(..), NodeType(..), NodeId, UserId, ListId, CorpusId, RootId, MasterCorpusId, MasterUserId)
 import Gargantext.Database.Flow.Types
 import Gargantext.Prelude
@@ -71,14 +72,20 @@ toNodeNgramsW l ngs = List.concat $ map (toNodeNgramsW' l) ngs
       ]
 
 flowList :: FlowCmdM env err m
-         => ListId
+         => CorpusId
+         -> ListId
          -> Map NgramsType [NgramsElement]
          -> m ListId
-flowList lId ngs = do
+flowList _cId lId ngs = do
   -- printDebug "listId flowList" lId
   -- TODO save in database
-  _r <- listInsertDb lId toNodeNgramsW (Map.toList ngs)
-  -- printDebug "result " r
+  mapCgramsId <- listInsertDb lId toNodeNgramsW (Map.toList ngs)
+  let toInsert = catMaybes [ (,) <$> (getCgramsId mapCgramsId ntype <$> parent)
+                                  <*>  getCgramsId mapCgramsId ntype ngram
+                  | (ntype, ngs') <- Map.toList ngs
+                  , NgramsElement ngram _ _ _ _ parent _ <- ngs'
+                  ]
+  _r <- insert_Node_NodeNgrams_NodeNgrams $ map (\(a,b) -> Node_NodeNgrams_NodeNgrams lId a b Nothing) toInsert
   listInsert lId ngs
   --trace (show $ List.filter (\n -> _ne_ngrams n == "versatile") $ List.concat $ Map.elems ngs) $ listInsert lId ngs
   pure lId

src/Gargantext/Database/Flow/Types.hs

@@ -26,7 +26,7 @@ module Gargantext.Database.Flow.Types
 
 import Data.Map (Map)
 import Gargantext.Prelude
-import Gargantext.Core.Flow
+import Gargantext.Core.Flow.Types
 import Gargantext.API.Ngrams (HasRepoVar, RepoCmdM)
 import Gargantext.Database.Schema.Ngrams (Ngrams(..), NgramsType(..))
 import Gargantext.Database.Types.Node (NodeId)

src/Gargantext/Database/Schema/NodeNgrams.hs

@@ -26,6 +26,9 @@ NodeNgrams register Context of Ngrams (named Cgrams then)
 
 module Gargantext.Database.Schema.NodeNgrams where
 
+import Data.Map (Map)
+import qualified Data.Map as Map
+import qualified Data.List as List
 import Data.Text (Text)
 import qualified Database.PostgreSQL.Simple as PGS (Query, Only(..))
 import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..))
@@ -37,7 +40,7 @@ import Database.PostgreSQL.Simple.SqlQQ (sql)
 import Data.Maybe (Maybe, fromMaybe)
 import Gargantext.Core.Types
 import Gargantext.Database.Utils
-import Gargantext.Database.Schema.Ngrams (NgramsType, ngramsTypeId)
+import Gargantext.Database.Schema.Ngrams (NgramsType, ngramsTypeId, fromNgramsTypeId)
 import Gargantext.Prelude
 
 data NodeNgramsPoly id
@@ -106,20 +109,32 @@ type NodeNgramsW =
                   NgramsType (Maybe NgramsField) (Maybe NgramsTag) (Maybe NgramsClass)
                   Double
 
-data Returning = Returning { re_terms :: Text 
+data Returning = Returning { re_type :: Maybe NgramsType
+                           , re_terms :: Text 
                            , re_ngrams_id :: Int
                            }
   deriving (Show)
 
 instance FromRow Returning where
-  fromRow = Returning <$> field <*> field
+  fromRow = Returning <$> (fromNgramsTypeId <$> field) <*> field <*> field
+
+getCgramsId :: Map NgramsType (Map Text Int) -> NgramsType -> Text -> Maybe Int
+getCgramsId mapId nt t = case Map.lookup nt mapId of
+  Nothing     -> Nothing
+  Just mapId' -> Map.lookup t mapId'
+
 
 -- insertDb :: ListId -> Map NgramsType [NgramsElemet] -> Cmd err [Result]
 listInsertDb :: Show a => ListId
              -> (ListId -> a -> [NodeNgramsW])
              -> a
-             -> Cmd err [Returning]
-listInsertDb l f ngs = insertNodeNgrams (f l ngs)
+             -- -> Cmd err [Returning]
+             -> Cmd err (Map NgramsType (Map Text Int))
+listInsertDb l f ngs = Map.map Map.fromList
+                    <$> Map.fromListWith (<>) 
+                    <$> List.map (\(Returning t tx id) -> (fromJust t, [(tx, id)]))
+                    <$> List.filter (\(Returning t _ _) -> isJust t)
+                    <$> insertNodeNgrams (f l ngs)
 
 -- TODO optimize with size of ngrams
 insertNodeNgrams :: [NodeNgramsW] -> Cmd err [Returning]
@@ -144,14 +159,14 @@ insertNodeNgrams nns = runPGSQuery query (PGS.Only $ Values fields nns')
     query :: PGS.Query
     query = [sql|
           WITH input(node_id, node_subtype, ngrams_terms, ngrams_type, ngrams_field, ngrams_tag, ngrams_class, weight) AS (?),
-          return(id, ngrams_id) AS (
+          return(id, ngrams_type, ngrams_id) AS (
             INSERT INTO node_ngrams (node_id, node_subtype, ngrams_id, ngrams_type, ngrams_field, ngrams_tag, ngrams_class, weight)
             SELECT i.node_id, i.node_subtype, ng.id, i.ngrams_type, i.ngrams_field, i.ngrams_tag, i.ngrams_class, i.weight FROM input as i
             INNER JOIN ngrams as ng ON ng.terms = i.ngrams_terms
             ON CONFLICT(node_id, node_subtype, ngrams_id)
             DO UPDATE SET node_subtype = excluded.node_subtype, ngrams_type = excluded.ngrams_type, ngrams_field = excluded.ngrams_field, ngrams_tag = excluded.ngrams_tag, ngrams_class = excluded.ngrams_class, weight = excluded.weight
-            RETURNING id, ngrams_id
+            RETURNING id, ngrams_type, ngrams_id
           )
-          SELECT ng.terms, return.id FROM return
+          SELECT return.ngrams_type, ng.terms, return.id FROM return
           INNER JOIN ngrams ng ON return.ngrams_id = ng.id;
   |]

src/Gargantext/Database/Schema/Node_NodeNgramsNodeNgrams.hs

@@ -54,7 +54,7 @@ data Node_NodeNgrams_NodeNgrams_Poly node_id nng1_id nng2_id weight =
 type Node_NodeNgrams_NodeNgrams_Write =
   Node_NodeNgrams_NodeNgrams_Poly
     (Column PGInt4          )
-    (Column PGInt4          )
+    (Maybe (Column PGInt4  ))
     (Column PGInt4          )
     (Maybe (Column PGFloat8))
 
@@ -68,7 +68,7 @@ type Node_NodeNgrams_NodeNgrams_Read  =
 type ListNgramsId = Int
 
 type Node_NodeNgrams_NodeNgrams =
-  Node_NodeNgrams_NodeNgrams_Poly CorpusId ListNgramsId ListNgramsId (Maybe Double)
+  Node_NodeNgrams_NodeNgrams_Poly CorpusId (Maybe ListNgramsId) ListNgramsId (Maybe Double)
 
 $(makeAdaptorAndInstance "pNode_NodeNgrams_NodeNgrams"
                          ''Node_NodeNgrams_NodeNgrams_Poly)
@@ -78,11 +78,11 @@ $(makeLensesWith abbreviatedFields
 
 node_NodeNgrams_NodeNgrams_Table :: Table Node_NodeNgrams_NodeNgrams_Write Node_NodeNgrams_NodeNgrams_Read
 node_NodeNgrams_NodeNgrams_Table =
-  Table "nodes_nodengrams_nodengrams"
+  Table "node_ngrams_ngrams"
        ( pNode_NodeNgrams_NodeNgrams Node_NodeNgrams_NodeNgrams
                        { _nnn_node_id = required "node_id"
-                       , _nnn_nng1_id = required "nng1_id"
-                       , _nnn_nng2_id = required "nng2_id"
+                       , _nnn_nng1_id = optional "node_ngrams1_id"
+                       , _nnn_nng2_id = required "node_ngrams2_id"
                        , _nnn_weight  = optional "weight"
                        }
        )
@@ -107,7 +107,7 @@ insert_Node_NodeNgrams_NodeNgrams :: [Node_NodeNgrams_NodeNgrams] -> Cmd err Int
 insert_Node_NodeNgrams_NodeNgrams = insert_Node_NodeNgrams_NodeNgrams_W
                  . map (\(Node_NodeNgrams_NodeNgrams n ng1 ng2 maybeWeight) ->
                           Node_NodeNgrams_NodeNgrams (pgNodeId n  )
-                                           (pgInt4 ng1)
+                                           (pgInt4 <$> ng1)
                                            (pgInt4 ng2)
                                            (pgDouble <$> maybeWeight)
                         )