[Community] specs + database schema adapted to link doc/contact

devops/postgres/schema.sql

@@ -72,6 +72,8 @@ CREATE TABLE public.node_nodengrams_nodengrams (
 );
 ALTER TABLE public.node_nodengrams_nodengrams OWNER TO gargantua;
 
+
+
 --------------------------------------------------------------
 --------------------------------------------------------------
 --
@@ -88,14 +90,23 @@ ALTER TABLE public.node_nodengrams_nodengrams OWNER TO gargantua;
 ---------------------------------------------------------------
 -- TODO nodes_nodes(node1_id int, node2_id int, edge_type int , weight real)
 CREATE TABLE public.nodes_nodes (
+    id INTEGER NOT NULL,
     node1_id INTEGER NOT NULL REFERENCES public.nodes(id) ON DELETE CASCADE,
     node2_id INTEGER NOT NULL REFERENCES public.nodes(id) ON DELETE CASCADE,
     score REAL,
     category INTEGER,
-    PRIMARY KEY (node1_id,node2_id)
+    PRIMARY KEY (id)
 );
 ALTER TABLE public.nodes_nodes OWNER TO gargantua;
 
+CREATE TABLE public.nodesnodes_nodesnodes (
+    nn1_id INTEGER NOT NULL REFERENCES public.nodes_nodes(id) ON DELETE CASCADE,
+    nn2_id INTEGER NOT NULL REFERENCES public.nodes_nodes(id) ON DELETE CASCADE,
+    weight double precision,
+    PRIMARY KEY (nn1_id,nn2_id)
+);
+ALTER TABLE public.nodesnodes_nodesnodes OWNER TO gargantua;
+
 ---------------------------------------------------------------
 CREATE TABLE public.node_node_ngrams (
 node1_id   INTEGER NOT NULL REFERENCES public.nodes  (id) ON DELETE CASCADE,
@@ -107,7 +118,6 @@ PRIMARY KEY (node1_id, node2_id, ngrams_id, ngrams_type)
 );
 ALTER TABLE public.node_node_ngrams OWNER TO gargantua;
 
-
 CREATE TABLE public.node_node_ngrams2 (
 node_id         INTEGER NOT NULL REFERENCES public.nodes  (id) ON DELETE CASCADE,
 nodengrams_id   INTEGER NOT NULL REFERENCES public.node_ngrams  (id) ON DELETE CASCADE,

src/Gargantext/API/Node.hs

@@ -282,7 +282,7 @@ type PairWith = Summary "Pair a Corpus with an Annuaire"
 pairWith :: CorpusId -> GargServer PairWith
 pairWith cId aId lId = do
   r <- pairing cId aId lId
-  _ <- insertNodeNode [ NodeNode cId aId Nothing Nothing]
+  _ <- insertNodeNode [ NodeNode Nothing cId aId Nothing Nothing]
   pure r
 
 ------------------------------------------------------------------------

src/Gargantext/Database/Action/Flow/Pairing.hs

@@ -7,6 +7,30 @@ Maintainer  : team@gargantext.org
 Stability   : experimental
 Portability : POSIX
 
+# Spécifications for pairing
+
+database:
+
+add NodeType Community (instead of texts, contacts)
+
+nodes_nodes
+corpusId_communitId
+
+get defaultList Id of each (for now)
+
+corpusId_docId
+listId_ngramsId (authors)
+
+listId_docId_ngramsId
+listId_contactId_ngramsId'
+
+if isSame ngramsId ngramsId'
+ then
+   insert listId_docId_contactId
+ else
+   nothing
+
+
 -}
 
 {-# LANGUAGE QuasiQuotes       #-}

src/Gargantext/Database/Action/Share.hs

@@ -56,7 +56,7 @@ shareNodeWith (ShareNodeWith_User NodeFolderShared u) n = do
         then errorWith "[G.D.A.S.shareNodeWith] Can share to others only"
         else do
           folderSharedId  <- getFolderId u NodeFolderShared
-          insertNodeNode [NodeNode folderSharedId n Nothing Nothing]
+          insertNodeNode [NodeNode Nothing folderSharedId n Nothing Nothing]
 
 shareNodeWith (ShareNodeWith_Node NodeFolderPublic nId) n = do
   nodeToCheck <- getNode n
@@ -66,7 +66,7 @@ shareNodeWith (ShareNodeWith_Node NodeFolderPublic nId) n = do
     else do
       folderToCheck <- getNode nId
       if hasNodeType folderToCheck NodeFolderPublic
-         then insertNodeNode [NodeNode nId n Nothing Nothing]
+         then insertNodeNode [NodeNode Nothing nId n Nothing Nothing]
          else errorWith "[G.D.A.S.shareNodeWith] Can share NodeWith NodeFolderPublic only"
 
 shareNodeWith _ _ = errorWith "[G.D.A.S.shareNodeWith] Not implemented for this NodeType"

src/Gargantext/Database/Query/Table/Node/Children.hs

@@ -70,7 +70,7 @@ selectChildren :: ParentId
                -> Query NodeRead
 selectChildren parentId maybeNodeType = proc () -> do
     row@(Node nId typeName _ parent_id _ _ _) <- queryNodeTable -< ()
-    (NodeNode n1id n2id _ _) <- queryNodeNodeTable -< ()
+    (NodeNode _ n1id n2id _ _) <- queryNodeNodeTable -< ()
 
     let nodeType = maybe 0 nodeTypeId maybeNodeType
     restrict -< typeName  .== pgInt4 nodeType

src/Gargantext/Database/Query/Table/NodeNode.hs

@@ -76,8 +76,9 @@ insertNodeNode ns = mkCmd $ \conn -> runInsert_ conn
                           $ Insert nodeNodeTable ns' rCount Nothing
   where
     ns' :: [NodeNodeWrite]
-    ns' = map (\(NodeNode n1 n2 x y)
-                -> NodeNode (pgNodeId n1)
+    ns' = map (\(NodeNode n n1 n2 x y)
+                -> NodeNode (pgInt4   <$> n)
+                            (pgNodeId n1)
                             (pgNodeId n2)
                             (pgDouble <$> x)
                             (pgInt4   <$> y)
@@ -90,7 +91,7 @@ type Node2_Id = NodeId
 deleteNodeNode :: Node1_Id -> Node2_Id -> Cmd err Int
 deleteNodeNode n1 n2 = mkCmd $ \conn ->
   fromIntegral <$> runDelete conn nodeNodeTable
-                 (\(NodeNode n1_id n2_id _ _) -> n1_id .== pgNodeId n1
+                 (\(NodeNode _ n1_id n2_id _ _) -> n1_id .== pgNodeId n1
                                              .&& n2_id .== pgNodeId n2 )
 
 ------------------------------------------------------------------------

src/Gargantext/Database/Schema/NodeNode.hs

@@ -26,36 +26,41 @@ import Gargantext.Database.Schema.Prelude
 import Gargantext.Prelude
 
 
-data NodeNodePoly node1_id node2_id score cat
-                   = NodeNode { _nn_node1_id   :: !node1_id
+data NodeNodePoly n node1_id node2_id score cat
+                   = NodeNode { _nn_id         :: !n
+                              , _nn_node1_id   :: !node1_id
                               , _nn_node2_id   :: !node2_id
                               , _nn_score      :: !score
                               , _nn_category   :: !cat
                               } deriving (Show)
 
-type NodeNodeWrite     = NodeNodePoly (Column (PGInt4))
+type NodeNodeWrite     = NodeNodePoly (Maybe  (Column (PGInt4)))
+                                      (Column (PGInt4))
                                       (Column (PGInt4))
                                       (Maybe  (Column (PGFloat8)))
                                       (Maybe  (Column (PGInt4)))
 
 type NodeNodeRead      = NodeNodePoly (Column (PGInt4))
+                                      (Column (PGInt4))
                                       (Column (PGInt4))
                                       (Column (PGFloat8))
                                       (Column (PGInt4))
 
 type NodeNodeReadNull  = NodeNodePoly (Column (Nullable PGInt4))
+                                      (Column (Nullable PGInt4))
                                       (Column (Nullable PGInt4))
                                       (Column (Nullable PGFloat8))
                                       (Column (Nullable PGInt4))
 
-type NodeNode = NodeNodePoly NodeId NodeId (Maybe Double) (Maybe Int)
+type NodeNode = NodeNodePoly (Maybe Int) NodeId NodeId (Maybe Double) (Maybe Int)
 
 $(makeAdaptorAndInstance "pNodeNode" ''NodeNodePoly)
 makeLenses ''NodeNodePoly
 
 nodeNodeTable :: Table NodeNodeWrite NodeNodeRead
 nodeNodeTable  = Table "nodes_nodes" (pNodeNode
-                                NodeNode { _nn_node1_id = required "node1_id"
+                                NodeNode { _nn_id       = optional "id"
+                                         , _nn_node1_id = required "node1_id"
                                          , _nn_node2_id = required "node2_id"
                                          , _nn_score    = optional "score"
                                          , _nn_category = optional "category"