[DB][FIX] SQL NodeNgrams query.

devops/postgres/schema.sql

@@ -148,6 +148,7 @@ CREATE UNIQUE INDEX ON public.nodes USING btree (typename, parent_id, ((hyperdat
 
 CREATE UNIQUE INDEX ON public.ngrams (terms); -- TEST GIN
 CREATE        INDEX ON public.ngrams USING btree (id, terms);
+CREATE UNIQUE INDEX ON public.node_ngrams USING btree (node_id,node_subtype, ngrams_id);
 
 CREATE INDEX        ON public.nodes_nodes  USING btree (node1_id, node2_id, category);
 CREATE UNIQUE INDEX ON public.nodes_nodes  USING btree (node1_id, node2_id);

src/Gargantext/API/Node.hs

@@ -60,7 +60,7 @@ import Gargantext.Core.Types.Main (Tree, NodeTree, ListType)
 import Gargantext.Database.Config (nodeTypeId)
 import Gargantext.Database.Facet (FacetDoc, OrderBy(..))
 import Gargantext.Database.Node.Children (getChildren)
-import Gargantext.Database.Schema.Node ( getNodesWithParentId, getNode, getNode', deleteNode, deleteNodes, mkNodeWithParent, JSONB, HasNodeError(..))
+import Gargantext.Database.Schema.Node ( getNodesWithParentId, getNodeWith, getNode, deleteNode, deleteNodes, mkNodeWithParent, JSONB, HasNodeError(..))
 import Gargantext.Database.Schema.NodeNode (nodeNodesCategory)
 import Gargantext.Database.Tree (treeDB)
 import Gargantext.Database.Types.Node
@@ -169,7 +169,7 @@ nodeNodeAPI :: forall proxy a. (JSONB a, ToJSON a) => proxy a -> UserId -> Corpu
 nodeNodeAPI p uId cId nId = withAccess (Proxy :: Proxy (NodeNodeAPI a)) Proxy uId (PathNodeNode cId nId) nodeNodeAPI'
   where
     nodeNodeAPI' :: GargServer (NodeNodeAPI a)
-    nodeNodeAPI' = getNode nId p
+    nodeNodeAPI' = getNodeWith nId p
 
 
 
@@ -179,7 +179,7 @@ nodeAPI :: forall proxy a. (JSONB a, ToJSON a) => proxy a -> UserId -> NodeId ->
 nodeAPI p uId id = withAccess (Proxy :: Proxy (NodeAPI a)) Proxy uId (PathNode id) nodeAPI'
   where
     nodeAPI' :: GargServer (NodeAPI a)
-    nodeAPI' =  getNode       id p
+    nodeAPI' =  getNodeWith       id p
            :<|> rename        id
            :<|> postNode  uId id
            :<|> putNode       id
@@ -205,7 +205,7 @@ nodeAPI p uId id = withAccess (Proxy :: Proxy (NodeAPI a)) Proxy uId (PathNode i
            -- :<|> postUpload id
 
     deleteNodeApi id' = do
-      node <- getNode' id'
+      node <- getNode id'
       if _node_typename node == nodeTypeId NodeUser
          then panic "not allowed"  -- TODO add proper Right Management Type
          else deleteNode id'
@@ -337,7 +337,7 @@ rename nId (RenameNode name') = U.update (U.Rename nId name')
 
 postNode :: HasNodeError err => UserId -> NodeId -> PostNode -> Cmd err [NodeId]
 postNode uId pId (PostNode nodeName nt) = do
-  nodeUser <- getNode (NodeId uId) HyperdataUser
+  nodeUser <- getNodeWith (NodeId uId) HyperdataUser
   let uId' = nodeUser ^. node_userId
   mkNodeWithParent nt (Just pId) uId' nodeName
 

src/Gargantext/Database/Config.hs

@@ -57,14 +57,15 @@ nodeTypeId n =
 
 ----  Lists
     NodeList      -> 5
-    NodeListModel -> 10
+    NodeListCooc  -> 50
+    NodeListModel -> 52
 
 ----  Scores
 --    NodeOccurrences -> 10
     NodeGraph       -> 9
     NodePhylo       -> 90
-    NodeDashboard   -> 7
-    NodeChart       -> 51
+    NodeChart       -> 7
+    NodeDashboard   -> 71
     NodeNoteBook    -> 88
 
 --  Cooccurrences -> 9

src/Gargantext/Database/Flow.hs

@@ -221,20 +221,21 @@ flowCorpusUser l userName corpusName ctype ids = do
   -- User Flow
   (userId, _rootId, userCorpusId) <- getOrMkRootWithCorpus userName corpusName ctype
   listId <- getOrMkList userCorpusId userId
+  _cooc  <- mkNode NodeListCooc listId userId
   -- TODO: check if present already, ignore
   _ <- Doc.add userCorpusId ids
-  tId <- mkNode NodeTexts userCorpusId userId
 
-  printDebug "Node Text Id" tId
+  _tId <- mkNode NodeTexts userCorpusId userId
+  -- printDebug "Node Text Id" tId
 
   -- User List Flow
   --{-
   (_masterUserId, _masterRootId, masterCorpusId) <- getOrMkRootWithCorpus userMaster (Left "") ctype
   ngs        <- buildNgramsLists l 2 3 (StopSize 3) userCorpusId masterCorpusId
-  userListId <- flowList listId ngs
+  _userListId <- flowList listId ngs
   --mastListId <- getOrMkList masterCorpusId masterUserId
   -- _ <- insertOccsUpdates userCorpusId mastListId
-  printDebug "userListId" userListId
+  -- printDebug "userListId" userListId
   -- User Graph Flow
   _ <- mkDashboard userCorpusId userId
   _ <- mkGraph  userCorpusId userId
@@ -284,6 +285,7 @@ insertMasterDocs c lang hs  =  do
   let indexedNgrams = Map.mapKeys (indexNgrams terms2id) maps
 
   lId <- getOrMkList masterCorpusId masterUserId
+  _cooc <- mkNode NodeListCooc lId masterUserId
   _   <- insertDocNgrams lId indexedNgrams
 
   pure $ map reId ids
@@ -494,7 +496,8 @@ flowList :: FlowCmdM env err m
 flowList lId ngs = do
   printDebug "listId flowList" lId
   -- TODO save in database
-  _ <- listInsertDb lId toNodeNgramsW (Map.toList ngs)
+  r <- listInsertDb lId toNodeNgramsW (Map.toList ngs)
+  printDebug "result " r
   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/Schema/Node.hs

@@ -281,6 +281,7 @@ nodeTableSearch = Table "nodes" (pNodeSearch NodeSearch { _ns_id         = optio
                                       }
                             )
 
+
 queryNodeSearchTable :: Query NodeSearchRead
 queryNodeSearchTable = queryTable nodeTableSearch
 
@@ -371,8 +372,13 @@ selectNodesWithType type_id = proc () -> do
 
 type JSONB = QueryRunnerColumnDefault PGJsonb
 
-getNode :: JSONB a => NodeId -> proxy a -> Cmd err (Node a)
-getNode nId _ = do
+
+getNode :: NodeId -> Cmd err (Node Value)
+getNode nId = fromMaybe (error $ "Node does not exist: " <> show nId) . headMay
+             <$> runOpaQuery (limit 1 $ selectNode (pgNodeId nId))
+
+getNodeWith :: JSONB a => NodeId -> proxy a -> Cmd err (Node a)
+getNodeWith nId _ = do
     fromMaybe (error $ "Node does not exist: " <> show nId) . headMay
              <$> runOpaQuery (limit 1 $ selectNode (pgNodeId nId))
 
@@ -382,11 +388,6 @@ getNodePhylo nId = do
              <$> runOpaQuery (limit 1 $ selectNode (pgNodeId nId))
 
 
-getNode' :: NodeId -> Cmd err (Node Value)
-getNode' nId = fromMaybe (error $ "Node does not exist: " <> show nId) . headMay
-             <$> runOpaQuery (limit 1 $ selectNode (pgNodeId nId))
-
-
 getNodesWithType :: Column PGInt4 -> Cmd err [Node HyperdataDocument]
 getNodesWithType = runOpaQuery . selectNodesWithType
 
@@ -464,12 +465,14 @@ instance HasDefault NodeType where
   hasDefaultData nt = case nt of
       NodeTexts -> HyperdataTexts (Just "Preferences")
       NodeList  -> HyperdataList' (Just "Preferences")
+      NodeListCooc -> HyperdataList' (Just "Preferences")
       _         -> undefined
       --NodeAnnuaire -> HyperdataAnnuaire (Just "Title") (Just "Description")
 
   hasDefaultName nt = case nt of
       NodeTexts -> "Texts"
       NodeList  -> "Lists"
+      NodeListCooc -> "Cooc"
       _         -> undefined
 
 ------------------------------------------------------------------------
@@ -717,3 +720,4 @@ pgNodeId = pgInt4 . id2int
 
 getListsWithParentId :: NodeId -> Cmd err [Node HyperdataList]
 getListsWithParentId n = runOpaQuery $ selectNodesWith' n (Just NodeList)
+

src/Gargantext/Database/Schema/NodeNgrams.hs

@@ -30,13 +30,14 @@ import Data.Text (Text)
 import qualified Database.PostgreSQL.Simple as PGS (Query, Only(..))
 import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..))
 import Database.PostgreSQL.Simple.FromRow (fromRow, field)
+import Database.PostgreSQL.Simple.ToField (toField)
 import Database.PostgreSQL.Simple (FromRow)
 import Database.PostgreSQL.Simple.SqlQQ (sql)
 -- import Control.Lens.TH (makeLenses)
 import Data.Maybe (Maybe, fromMaybe)
 import Gargantext.Core.Types
 import Gargantext.Database.Utils
-import Gargantext.Database.Schema.Ngrams (NgramsType, NgramsTypeId, ngramsTypeId)
+import Gargantext.Database.Schema.Ngrams (NgramsType, ngramsTypeId)
 import Gargantext.Prelude
 
 data NodeNgramsPoly id
@@ -114,7 +115,7 @@ instance FromRow Returning where
   fromRow = Returning <$> field <*> field
 
 -- insertDb :: ListId -> Map NgramsType [NgramsElemet] -> Cmd err [Result]
-listInsertDb :: ListId
+listInsertDb :: Show a => ListId
              -> (ListId -> a -> [NodeNgramsW])
              -> a
              -> Cmd err [Returning]
@@ -127,26 +128,30 @@ insertNodeNgrams nns = runPGSQuery query (PGS.Only $ Values fields nns')
     fields = map (\t-> QualifiedIdentifier Nothing t) [ "int4","int4","text","int4"
                                                       ,"int4","int4","int4","int4"
                                                       ,"float8"]
-    nns' :: [(Int, ListTypeId, NgramsText, NgramsTypeId ,NgramsField, NgramsTag, NgramsClass, Double)]
+    -- nns' :: [(Int, ListTypeId, NgramsText, NgramsTypeId ,NgramsField, NgramsTag, NgramsClass, Double)]
     nns' = map (\(NodeNgrams _id (NodeId node_id'') node_subtype ngrams_terms ngrams_type ngrams_field ngrams_tag ngrams_class weight)
-                              -> ( node_id''
-                                 , listTypeId node_subtype
-                                 , ngrams_terms
-                                 , ngramsTypeId ngrams_type
-                                 , fromMaybe 0 ngrams_field
-                                 , fromMaybe 0 ngrams_tag
-                                 , fromMaybe 0 ngrams_class
-                                 , weight
-                                 )
+                              -> [ toField node_id''
+                                 , toField $ listTypeId node_subtype
+                                 , toField $ ngrams_terms
+                                 , toField $ ngramsTypeId ngrams_type
+                                 , toField $ fromMaybe 0 ngrams_field
+                                 , toField $ fromMaybe 0 ngrams_tag
+                                 , toField $ fromMaybe 0 ngrams_class
+                                 , toField weight
+                                 ]
                   ) nns
 
     query :: PGS.Query
     query = [sql|
-          INSERT INTO node_ngrams_ngrams nnn VALUES (node_id, node_type, ngrams_id, ngrams_type, ngrams_field, ngrams_tag, ngrams_class, weight)
-          SELECT n.node_id, n.node_type, ng.ngrams_id, n.ngrams_type, n.ngrams_field, n.ngrams_tag, n.ngrams_class, n.weight FROM (?)
-              AS n(node_id, node_type, ngrams_terms, ngrams_type, ngrams_field, ngrams_tag, ngrams_class, weight)
-          INNER JOIN ngrams as ng ON ng.terms = n.ngrams_terms
-          ON CONFLICT(node_id, ngrams_id)
-          DO UPDATE SET node_type = excluded.node_type, ngrams_type = excluded.ngrams_type, ngrams_field = excluded.ngrams_field, ngrams_tag = excluded.ngrams_tag, ngrams_class = excluded.ngrams_class, weight = excluded.weight
-          RETURNING nnn.id, n.ngrams_terms
+          WITH input(node_id, node_subtype, ngrams_terms, ngrams_type, ngrams_field, ngrams_tag, ngrams_class, weight) AS (?),
+          return(id, 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
+          )
+          SELECT ng.terms, return.id FROM return
+          INNER JOIN ngrams ng ON return.ngrams_id = ng.id;
   |]

src/Gargantext/Database/Schema/Node_NodeNgrams_NodeNgrams.hs

@@ -119,4 +119,3 @@ insert_Node_NodeNgrams_NodeNgrams_W ns =
                                     , iReturning = rCount
                                     , iOnConflict = (Just DoNothing)
                                     }
-

src/Gargantext/Database/Types/Node.hs

@@ -444,6 +444,7 @@ data NodeType = NodeUser
               | NodeGraph      | NodePhylo
               | NodeDashboard  | NodeChart    | NodeNoteBook
               | NodeList       | NodeListModel
+              | NodeListCooc
   deriving (Show, Read, Eq, Generic, Bounded, Enum)
 
 

src/Gargantext/Viz/Graph/API.hs

@@ -36,7 +36,7 @@ import Gargantext.Database.Config
 import Gargantext.Database.Metrics.NgramsByNode (getNodesByNgramsOnlyUser)
 import Gargantext.Database.Schema.Ngrams
 import Gargantext.Database.Node.Select
-import Gargantext.Database.Schema.Node (getNode, defaultList, insertGraph)
+import Gargantext.Database.Schema.Node (getNodeWith, defaultList, insertGraph)
 import Gargantext.Database.Types.Node hiding (node_id) -- (GraphId, ListId, CorpusId, NodeId)
 import Gargantext.Database.Node.UpdateOpaleye (updateHyperdata)
 import Gargantext.Prelude
@@ -63,7 +63,7 @@ graphAPI u n =  getGraph  u n
 
 getGraph :: UserId -> NodeId -> GargServer (Get '[JSON] Graph)
 getGraph uId nId = do
-  nodeGraph <- getNode nId HyperdataGraph
+  nodeGraph <- getNodeWith nId HyperdataGraph
   let graph = nodeGraph ^. node_hyperdata . hyperdataGraph
   let graphVersion = graph ^? _Just
                             . graph_metadata
@@ -71,7 +71,7 @@ getGraph uId nId = do
                             . gm_version
 
   v <- currentVersion
-  nodeUser <- getNode (NodeId uId) HyperdataUser
+  nodeUser <- getNodeWith (NodeId uId) HyperdataUser
 
   let uId' = nodeUser ^. node_userId