Merge branch 'dev-pairing' into dev

devops/postgres/schema.sql

@@ -135,16 +135,27 @@ CREATE TABLE public.nodes_nodes (
 ALTER TABLE public.nodes_nodes OWNER TO gargantua;
 
 
+
 -- To attach contexts to a Corpus
 CREATE TABLE public.nodes_contexts (
+    id SERIAL                          ,
     node_id    INTEGER NOT NULL REFERENCES public.nodes(id)    ON DELETE CASCADE,
     context_id INTEGER NOT NULL REFERENCES public.contexts(id) ON DELETE CASCADE,
     score    REAL    ,
     category INTEGER ,
-    PRIMARY KEY (node_id, context_id)
+    PRIMARY KEY (id)
 );
 ALTER TABLE public.nodes_contexts OWNER TO gargantua;
 
+CREATE TABLE public.nodescontexts_nodescontexts (
+    nodescontexts1 INTEGER NOT NULL REFERENCES public.nodes_contexts(id) ON DELETE CASCADE,
+    nodescontexts2 INTEGER NOT NULL REFERENCES public.nodes_contexts(id) ON DELETE CASCADE,
+
+    PRIMARY KEY (nodescontexts1, nodescontexts2)
+);
+ALTER TABLE public.nodescontexts_nodescontexts OWNER TO gargantua;
+
+
 ---------------------------------------------------------------
 CREATE TABLE public.context_node_ngrams (
     context_id    INTEGER NOT NULL REFERENCES public.contexts (id) ON DELETE CASCADE,
@@ -185,8 +196,6 @@ PRIMARY KEY (node_id, nodengrams_id)
 ALTER TABLE public.node_node_ngrams2 OWNER TO gargantua;
 
 
-
-
 --------------------------------------------------------------
 
 --CREATE TABLE public.nodes_ngrams_repo (
@@ -230,7 +239,7 @@ CREATE INDEX        ON public.contexts USING btree (id, typename, date DESC);
 CREATE INDEX        ON public.contexts USING btree (typename, id);
 CREATE UNIQUE INDEX ON public.contexts USING btree (hash_id);
 
-
+CREATE INDEX ON public.nodescontexts_nodescontexts USING btree (nodescontexts1, nodescontexts2);
 -- CREATE UNIQUE INDEX ON public.nodes USING btree (((hyperdata ->> 'uniqId'::text)));
 -- CREATE UNIQUE INDEX ON public.nodes USING btree (((hyperdata ->> 'uniqIdBdd'::text)));
 -- CREATE UNIQUE INDEX ON public.nodes USING btree (typename, parent_id, ((hyperdata ->> 'uniqId'::text)));
@@ -249,6 +258,7 @@ CREATE UNIQUE INDEX ON public.node_ngrams USING btree (node_id,node_subtype, ngr
 CREATE UNIQUE INDEX ON public.nodes_nodes  USING btree (node1_id, node2_id);
 CREATE INDEX        ON public.nodes_nodes  USING btree (node1_id, node2_id, category);
 
+
 -- To make the links between Corpus Node and its contexts
 CREATE UNIQUE INDEX ON public.nodes_contexts  USING btree (node_id, context_id);
 CREATE INDEX        ON public.nodes_contexts  USING btree (node_id, context_id, category);

devops/postgres/upgrade/0.0.5.7.5.sql

+
+ALTER TABLE nodes_contexts DROP CONSTRAINT nodes_contexts_pkey;
+ALTER TABLE nodes_contexts ADD COLUMN id SERIAL PRIMARY KEY ;
+
+CREATE TABLE public.nodescontexts_nodescontexts (
+    nodescontexts1 INTEGER NOT NULL REFERENCES public.nodes_contexts(id) ON DELETE CASCADE,
+    nodescontexts2 INTEGER NOT NULL REFERENCES public.nodes_contexts(id) ON DELETE CASCADE,
+
+    PRIMARY KEY (nodescontexts1, nodescontexts2)
+);
+ALTER TABLE public.nodescontexts_nodescontexts OWNER TO gargantua;
+
+CREATE INDEX ON public.nodescontexts_nodescontexts USING btree (nodescontexts1, nodescontexts2)
+

src/Gargantext/API/Client.hs

@@ -116,7 +116,7 @@ postNodeSearch :: Token -> NodeId -> SearchQuery -> Maybe Int -> Maybe Int -> Ma
 
 postNodeShare :: Token -> NodeId -> ShareNodeParams -> ClientM Int
 
-postNodePairCorpusAnnuaire :: Token -> NodeId -> AnnuaireId -> Maybe ListId -> ClientM Int
+postNodePairCorpusAnnuaire :: Token -> NodeId -> AnnuaireId -> Maybe ListId -> ClientM [Int]
 getNodePairs :: Token -> NodeId -> ClientM [AnnuaireId]
 getNodePairings :: Token -> NodeId -> Maybe TabType -> Maybe Int -> Maybe Int -> Maybe Facet.OrderBy -> ClientM [FacetDoc]
 
@@ -205,7 +205,7 @@ postCorpusSearch :: Token -> CorpusId -> SearchQuery -> Maybe Int -> Maybe Int -
 
 postCorpusShare :: Token -> CorpusId -> ShareNodeParams -> ClientM Int
 
-postCorpusPairCorpusAnnuaire :: Token -> CorpusId -> AnnuaireId -> Maybe ListId -> ClientM Int
+postCorpusPairCorpusAnnuaire :: Token -> CorpusId -> AnnuaireId -> Maybe ListId -> ClientM [Int]
 getCorpusPairs :: Token -> CorpusId -> ClientM [AnnuaireId]
 getCorpusPairings :: Token -> CorpusId -> Maybe TabType -> Maybe Int -> Maybe Int -> Maybe Facet.OrderBy -> ClientM [FacetDoc]
 
@@ -299,7 +299,7 @@ putAnnuaireScore :: Token -> AnnuaireId -> NodesToScore -> ClientM [Int]
 postAnnuaireSearch :: Token -> AnnuaireId -> SearchQuery -> Maybe Int -> Maybe Int -> Maybe Facet.OrderBy -> ClientM SearchResult
 postAnnuaireShare :: Token -> AnnuaireId -> ShareNodeParams -> ClientM Int
 
-postAnnuairePairCorpusAnnuaire :: Token -> AnnuaireId -> AnnuaireId -> Maybe ListId -> ClientM Int
+postAnnuairePairCorpusAnnuaire :: Token -> AnnuaireId -> AnnuaireId -> Maybe ListId -> ClientM [Int]
 getAnnuairePairs :: Token -> AnnuaireId -> ClientM [AnnuaireId]
 getAnnuairePairings :: Token -> AnnuaireId -> Maybe TabType -> Maybe Int -> Maybe Int -> Maybe Facet.OrderBy -> ClientM [FacetDoc]
 

src/Gargantext/API/Ngrams/Tools.hs

@@ -135,16 +135,16 @@ filterListWithRootHashMap lt m = snd <$> HM.filter isMapTerm m
         Nothing -> panic $ "[Garg.API.Ngrams.Tools] filterWithRoot, unknown key: " <> unNgramsTerm r
         Just  (l',_) -> l' == lt
 
-filterListWithRoot :: ListType
+filterListWithRoot :: [ListType]
                    -> HashMap NgramsTerm (ListType, Maybe NgramsTerm)
                    -> HashMap NgramsTerm (Maybe RootTerm)
 filterListWithRoot lt m = snd <$> HM.filter isMapTerm m
   where
     isMapTerm (l, maybeRoot) = case maybeRoot of
-      Nothing -> l == lt
+      Nothing -> elem l lt
       Just  r -> case HM.lookup r m of
         Nothing -> panic $ "[Garg.API.Ngrams.Tools] filterWithRoot, unknown key: " <> unNgramsTerm r
-        Just  (l',_) -> l' == lt
+        Just  (l',_) -> elem l' lt
 
 groupNodesByNgrams :: ( At root_map
                       , Index root_map ~ NgramsTerm

src/Gargantext/API/Node.hs

@@ -312,7 +312,7 @@ pairs cId = do
 type PairWith = Summary "Pair a Corpus with an Annuaire"
               :> "annuaire" :> Capture "annuaire_id" AnnuaireId
               :> QueryParam "list_id"     ListId
-              :> Post '[JSON] Int
+              :> Post '[JSON] [Int]
 
 pairWith :: CorpusId -> GargServer PairWith
 pairWith cId aId lId = do

src/Gargantext/API/Node/Corpus/Export.hs

@@ -95,7 +95,7 @@ getContextNgrams cId lId listType nt repo = do
 --    Just  l -> pure l
 
   lIds <- selectNodesWithUsername NodeList userMaster
-  let ngs = filterListWithRoot listType $ mapTermListRoot [lId] nt repo
+  let ngs = filterListWithRoot [listType] $ mapTermListRoot [lId] nt repo
   -- TODO HashMap
   r <- getNgramsByContextOnlyUser cId (lIds <> [lId]) nt (HashMap.keys ngs)
   pure r

src/Gargantext/Core/Viz/Chart.hs

@@ -61,7 +61,7 @@ chartData cId nt lt = do
   ls <- map (_node_id) <$> getListsWithParentId cId
   ts <- mapTermListRoot ls nt <$> getRepo' ls
   let
-    dico = filterListWithRoot lt ts
+    dico = filterListWithRoot [lt] ts
     terms = catMaybes $ List.concat $ map (\(a,b) -> [Just a, b]) $ HashMap.toList dico
     group dico' x = case HashMap.lookup x dico' of
         Nothing -> x
@@ -86,7 +86,7 @@ treeData cId nt lt = do
   ts <- mapTermListRoot ls nt <$> getRepo' ls
 
   let
-    dico = filterListWithRoot lt ts
+    dico = filterListWithRoot [lt] ts
     terms = catMaybes $ List.concat $ map (\(a,b) -> [Just a, b]) $ HashMap.toList dico
 
   cs' <- getContextsByNgramsOnlyUser cId (ls' <> ls) nt terms

src/Gargantext/Core/Viz/Graph/API.hs

@@ -174,7 +174,7 @@ computeGraph cId method d nt repo = do
   lId  <- defaultList cId
   lIds <- selectNodesWithUsername NodeList userMaster
 
-  let ngs = filterListWithRoot MapTerm
+  let ngs = filterListWithRoot [MapTerm]
           $ mapTermListRoot [lId] nt repo
 
   myCooc <- HashMap.filter (>1) -- Removing the hapax (ngrams with 1 cooc)

src/Gargantext/Database/Action/Metrics.hs

@@ -234,8 +234,9 @@ getNgrams :: (HasMail env, HasNodeStory env err m)
 getNgrams lId tabType = do
 
   lists <- mapTermListRoot [lId] (ngramsTypeFromTabType tabType) <$> getRepo' [lId]
+  -- TODO filterListWithRoot [MapTerm, StopTerm, CandidateTerm] lists
   let maybeSyn = HM.unions $ map (\t -> filterListWithRoot t lists)
-                                 [MapTerm, StopTerm, CandidateTerm]
+                                 [[MapTerm], [StopTerm], [CandidateTerm]]
   pure (lists, maybeSyn)
 
 -- Some useful Tools

src/Gargantext/Database/Action/Metrics/NgramsByContext.hs

@@ -172,7 +172,7 @@ selectNgramsOccurrencesOnlyByContextUser_withSample cId int nt tms =
 
 queryNgramsOccurrencesOnlyByContextUser_withSample :: DPS.Query
 queryNgramsOccurrencesOnlyByContextUser_withSample = [sql|
-  WITH nodes_sample AS (SELECT id FROM contexts n TABLESAMPLE SYSTEM_ROWS (?)
+  WITH nodes_sample AS (SELECT n.id FROM contexts n TABLESAMPLE SYSTEM_ROWS (?)
                           JOIN nodes_contexts nn ON n.id = nn.context_id
                             WHERE n.typename  = ?
                             AND nn.node_id = ?),

src/Gargantext/Database/Action/Search.hs

@@ -26,8 +26,8 @@ import Gargantext.Database.Query.Filter
 import Gargantext.Database.Query.Join (leftJoin5)
 import Gargantext.Database.Query.Table.Node
 import Gargantext.Database.Query.Table.Context
-import Gargantext.Database.Query.Table.NodeNode
 import Gargantext.Database.Query.Table.NodeContext
+import Gargantext.Database.Query.Table.NodeContext_NodeContext
 import Gargantext.Database.Schema.Node
 import Gargantext.Database.Schema.Context
 import Gargantext.Prelude
@@ -41,11 +41,11 @@ searchDocInDatabase :: HasDBid NodeType
                     => ParentId
                     -> Text
                     -> Cmd err [(NodeId, HyperdataDocument)]
-searchDocInDatabase _p t = runOpaQuery (queryDocInDatabase t)
+searchDocInDatabase p t = runOpaQuery (queryDocInDatabase p t)
   where
     -- | Global search query where ParentId is Master Node Corpus Id 
-    queryDocInDatabase :: Text -> O.Select (Column SqlInt4, Column SqlJsonb)
-    queryDocInDatabase q = proc () -> do
+    queryDocInDatabase :: ParentId -> Text -> O.Select (Column SqlInt4, Column SqlJsonb)
+    queryDocInDatabase _p q = proc () -> do
         row <- queryNodeSearchTable -< ()
         restrict -< (_ns_search row)    @@ (sqlTSQuery (unpack q))
         restrict -< (_ns_typename row) .== (sqlInt4 $ toDBid NodeDocument)
@@ -118,11 +118,22 @@ searchInCorpusWithContacts
 searchInCorpusWithContacts cId aId q o l _order =
   runOpaQuery $ limit'   l
               $ offset'  o
-              $ orderBy ( desc _fp_score)
+              $ orderBy (desc _fp_score)
               $ selectGroup cId aId
               $ intercalate " | "
               $ map stemIt q
 
+selectGroup :: HasDBid NodeType
+            => CorpusId
+            -> AnnuaireId
+            -> Text
+            -> Select FacetPairedReadNull
+selectGroup cId aId q = proc () -> do
+  (a, b, c, d) <- aggregate (p4 (groupBy, groupBy, groupBy, O.sum))
+                            (selectContactViaDoc cId aId q) -< ()
+  returnA -< FacetPaired a b c d
+
+
 selectContactViaDoc
   :: HasDBid NodeType
   => CorpusId
@@ -134,81 +145,68 @@ selectContactViaDoc
                , Column (Nullable SqlJsonb)
                , Column (Nullable SqlInt4)
                )
-selectContactViaDoc cId aId q = proc () -> do
-  (doc, (corpus_doc, (_contact_doc, (annuaire_contact, contact)))) <- queryContactViaDoc -< ()
-  restrict -< (doc^.ns_search)           @@ (sqlTSQuery  $ unpack q  )
-  restrict -< (doc^.ns_typename)        .== (sqlInt4 $ toDBid NodeDocument)
-  restrict -< (corpus_doc^.nn_node1_id)  .== (toNullable $ pgNodeId cId)
-  restrict -< (annuaire_contact^.nn_node1_id) .== (toNullable $ pgNodeId aId)
-  restrict -< (contact^.node_typename)        .== (toNullable $ sqlInt4 $ toDBid NodeContact)
-  returnA  -< ( contact^.node_id
-              , contact^.node_date
-              , contact^.node_hyperdata
+selectContactViaDoc cId aId query = proc () -> do
+  (doc, (corpus, (_nodeContext_nodeContext, (annuaire, contact)))) <- queryContactViaDoc -< ()
+  restrict -< (doc^.cs_search)             @@ (sqlTSQuery $ unpack query                )
+  restrict -< (doc^.cs_typename)          .== (sqlInt4    $ toDBid NodeDocument         )
+  restrict -< (corpus^.nc_node_id)        .== (toNullable $ pgNodeId cId                )
+  restrict -< (annuaire^.nc_node_id)      .== (toNullable $ pgNodeId aId                )
+  restrict -< (contact^.context_typename) .== (toNullable $ sqlInt4 $ toDBid NodeContact)
+  returnA  -< ( contact^.context_id
+              , contact^.context_date
+              , contact^.context_hyperdata
               , toNullable $ sqlInt4 1
               )
 
-selectGroup :: HasDBid NodeType
-            => NodeId
-            -> NodeId
-            -> Text
-            -> Select FacetPairedReadNull
-selectGroup cId aId q = proc () -> do
-  (a, b, c, d) <- aggregate (p4 (groupBy, groupBy, groupBy, O.sum))
-                            (selectContactViaDoc cId aId q) -< ()
-  returnA -< FacetPaired a b c d
-
-
-queryContactViaDoc :: O.Select ( NodeSearchRead
-                               , ( NodeNodeReadNull
-                                 , ( NodeNodeReadNull
-                                   , ( NodeNodeReadNull
-                                     , NodeReadNull
+queryContactViaDoc :: O.Select ( ContextSearchRead
+                               , ( NodeContextReadNull
+                                 , ( NodeContext_NodeContextReadNull
+                                   , ( NodeContextReadNull
+                                     , ContextReadNull
                                      )
                                    )
                                  )
                                )
 queryContactViaDoc =
   leftJoin5
-  queryNodeTable
-  queryNodeNodeTable
-  queryNodeNodeTable
-  queryNodeNodeTable
-  queryNodeSearchTable
+  queryContextTable
+  queryNodeContextTable
+  queryNodeContext_NodeContextTable
+  queryNodeContextTable
+  queryContextSearchTable
   cond12
   cond23
   cond34
   cond45
     where
-      cond12 :: (NodeNodeRead, NodeRead) -> Column SqlBool
-      cond12 (annuaire_contact, contact) = contact^.node_id .== annuaire_contact^.nn_node2_id
+      cond12 :: (NodeContextRead, ContextRead) -> Column SqlBool
+      cond12 (annuaire, contact) = contact^.context_id .== annuaire^.nc_context_id
 
-      cond23 :: ( NodeNodeRead
-                , ( NodeNodeRead
-                  , NodeReadNull
+      cond23 :: ( NodeContext_NodeContextRead
+                , ( NodeContextRead
+                  , ContextReadNull
                   )
                 ) -> Column SqlBool
-      cond23 (contact_doc, (annuaire_contact, _)) = contact_doc^.nn_node1_id .== annuaire_contact^.nn_node2_id
+      cond23 (nodeContext_nodeContext, (annuaire, _)) = nodeContext_nodeContext^.ncnc_nodecontext2 .== annuaire^.nc_id
 
-      cond34 :: ( NodeNodeRead
-                , ( NodeNodeRead
-                  , ( NodeNodeReadNull
-                    , NodeReadNull
+      cond34 :: ( NodeContextRead
+                , ( NodeContext_NodeContextRead
+                  , ( NodeContextReadNull
+                    , ContextReadNull
                     )
                   )
                 ) -> Column SqlBool
-      cond34 (corpus_doc, (contact_doc, (_,_))) =  corpus_doc^.nn_node2_id .== contact_doc^.nn_node2_id
+      cond34 (corpus, (nodeContext_nodeContext, (_,_))) =  nodeContext_nodeContext^.ncnc_nodecontext1 .== corpus^.nc_id
 
 
-      cond45 :: ( NodeSearchRead
-                , ( NodeNodeRead
-                  , ( NodeNodeReadNull
-                    , ( NodeNodeReadNull
-                      , NodeReadNull
+      cond45 :: ( ContextSearchRead
+                , ( NodeContextRead
+                  , ( NodeContext_NodeContextReadNull
+                    , ( NodeContextReadNull
+                      , ContextReadNull
                       )
                     )
                   )
                 ) -> Column SqlBool
-      cond45 (doc, (corpus_doc, (_,(_,_)))) = doc^.ns_id .== corpus_doc^.nn_node2_id
+      cond45 (doc, (corpus, (_,(_,_)))) = doc^.cs_id .== corpus^.nc_context_id
 
-
-------------------------------------------------------------------------

src/Gargantext/Database/Admin/Types/Node.hs

@@ -212,10 +212,13 @@ pgContextId = pgNodeId
 newtype NodeId = NodeId Int
   deriving (Read, Generic, Num, Eq, Ord, Enum, ToJSONKey, FromJSONKey, ToJSON, FromJSON, Hashable, Csv.ToField)
 
-
--- TODO make another type?
+-- TODO make another type
 type ContextId = NodeId
 
+newtype NodeContextId = NodeContextId Int
+  deriving (Read, Generic, Num, Eq, Ord, Enum, ToJSONKey, FromJSONKey, ToJSON, FromJSON, Hashable, Csv.ToField)
+
+
 instance GQLType NodeId
 instance Show NodeId where
   show (NodeId n) = "nodeId-" <> show n

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

 {-|
-import Gargantext.Database.Prelude (Cmd, runPGSQuery)
 Module      : Gargantext.Database.Query.Table.Node
 Description : Main Tools of Node to the database
 Copyright   : (c) CNRS, 2017-Present
@@ -9,7 +8,6 @@ Stability   : experimental
 Portability : POSIX
 -}
 
-
 {-# OPTIONS_GHC -fno-warn-orphans        #-}
 
 {-# LANGUAGE Arrows                 #-}

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

@@ -122,7 +122,7 @@ selectChildren' :: HasDBid NodeType
                -> Select ContextRead
 selectChildren' parentId maybeNodeType = proc () -> do
     row@(Context cid _ typeName _ _ _ _ _) <- queryContextTable     -< ()
-    (NodeContext nid cid' _ _)                    <- queryNodeContextTable -< ()
+    (NodeContext _ nid cid' _ _)           <- queryNodeContextTable -< ()
 
     let nodeType = maybe 0 toDBid maybeNodeType
     restrict -< typeName  .== sqlInt4 nodeType

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

@@ -77,8 +77,9 @@ insertNodeContext ns = mkCmd $ \conn -> fromIntegral <$> (runInsert_ conn
                           $ Insert nodeContextTable ns' rCount (Just DoNothing))
   where
     ns' :: [NodeContextWrite]
-    ns' = map (\(NodeContext n c x y)
-                -> NodeContext (pgNodeId n)
+    ns' = map (\(NodeContext i n c x y)
+                -> NodeContext (sqlInt4 <$> i)
+                               (pgNodeId n)
                                (pgNodeId c)
                                (sqlDouble <$> x)
                                (sqlInt4  <$> y)
@@ -93,7 +94,7 @@ deleteNodeContext :: Node_Id -> Context_Id -> Cmd err Int
 deleteNodeContext n c = mkCmd $ \conn ->
   fromIntegral <$> runDelete_ conn
                               (Delete nodeContextTable
-                                      (\(NodeContext n_id c_id _ _) -> n_id .== pgNodeId n
+                                      (\(NodeContext _ n_id c_id _ _) -> n_id .== pgNodeId n
                                                                    .&& c_id .== pgNodeId c
                                       )
                                       rCount

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

+{-|
+Module      : Gargantext.Database.Select.Table.NodeContext_NodeContext
+Description : 
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+-}
+
+{-# LANGUAGE Arrows                 #-}
+{-# LANGUAGE QuasiQuotes            #-}
+{-# LANGUAGE TemplateHaskell        #-}
+
+module Gargantext.Database.Query.Table.NodeContext_NodeContext
+  ( module Gargantext.Database.Schema.NodeContext_NodeContext
+--  , query_NodeContext_NodeContext_Table
+  , insertNodeContext_NodeContext
+  )
+  where
+
+import Data.Text (Text)
+import Gargantext.Core.Types
+import Gargantext.Database.Prelude
+import Gargantext.Database.Schema.NodeContext_NodeContext
+import Gargantext.Database.Schema.Prelude hiding (sum)
+import Gargantext.Prelude
+import qualified Database.PostgreSQL.Simple as PGS
+
+{-
+queryNodeContext_NodeContextTable :: Select NodeContext_NodeContextRead
+queryNodeContext_NodeContextTable = selectTable nodeContext_NodeContextTable
+-}
+
+insertNodeContext_NodeContext :: [(CorpusId, DocId, AnnuaireId, ContactId)] -> Cmd err [Int]
+insertNodeContext_NodeContext contexts = do
+  let
+    fields = map (\t -> QualifiedIdentifier Nothing t) $ snd fields_name
+    fields_name :: ( [Text], [Text])
+    fields_name = ( ["corpus_id", "doc_id", "annuaire_id", "contact_id"]
+                            , ["int4"     , "int4"  , "int4"       , "int4"      ]
+                            )
+  result <- map (\(PGS.Only a) -> a) <$> runPGSQuery queryInsert (PGS.Only $ Values fields contexts)
+  pure [sum result]
+
+queryInsert :: PGS.Query
+queryInsert = [sql|
+  WITH input(corpus_id, doc_id, annuaire_id, contact_id) AS (?)
+  INSERT into nodescontexts_nodescontexts (nodescontexts1, nodescontexts2)
+  SELECT context1.id, context2.id FROM input
+  INNER JOIN nodes_contexts context1 ON context1.node_id = input.corpus_id
+  INNER JOIN nodes_contexts context2 ON context2.node_id = input.annuaire_id
+  WHERE context1.context_id = input.doc_id
+  AND   context2.context_id = input.contact_id
+  ON CONFLICT (nodescontexts1, nodescontexts2) DO Nothing
+  RETURNING 1
+  |]

src/Gargantext/Database/Schema/NodeContext.hs

@@ -26,29 +26,33 @@ import Gargantext.Database.Schema.NodeNode () -- Just importing some instances
 import Gargantext.Prelude
 
 
-data NodeContextPoly node_id context_id score cat
-                   = NodeContext { _nc_node_id     :: !node_id
+data NodeContextPoly id node_id context_id score cat
+                   = NodeContext { _nc_id          :: !id
+                                 , _nc_node_id     :: !node_id
                                  , _nc_context_id  :: !context_id
                                  , _nc_score       :: !score
                                  , _nc_category    :: !cat
                                  } deriving (Show)
 
-type NodeContextWrite     = NodeContextPoly (Column (SqlInt4))
+type NodeContextWrite     = NodeContextPoly (Maybe (Column (SqlInt4)))
+                                            (Column (SqlInt4))
                                             (Column (SqlInt4))
                                             (Maybe  (Column (SqlFloat8)))
                                             (Maybe  (Column (SqlInt4)))
 
 type NodeContextRead      = NodeContextPoly (Column (SqlInt4))
+                                            (Column (SqlInt4))
                                             (Column (SqlInt4))
                                             (Column (SqlFloat8))
                                             (Column (SqlInt4))
 
 type NodeContextReadNull  = NodeContextPoly (Column (Nullable SqlInt4))
+                                            (Column (Nullable SqlInt4))
                                             (Column (Nullable SqlInt4))
                                             (Column (Nullable SqlFloat8))
                                             (Column (Nullable SqlInt4))
 
-type NodeContext = NodeContextPoly NodeId NodeId (Maybe Double) (Maybe Int)
+type NodeContext = NodeContextPoly (Maybe Int) NodeId NodeId (Maybe Double) (Maybe Int)
 
 $(makeAdaptorAndInstance "pNodeContext" ''NodeContextPoly)
 makeLenses ''NodeContextPoly
@@ -57,7 +61,8 @@ nodeContextTable :: Table NodeContextWrite NodeContextRead
 nodeContextTable  =
   Table "nodes_contexts"
          ( pNodeContext
-           NodeContext { _nc_node_id    = requiredTableField "node_id"
+           NodeContext { _nc_id         = optionalTableField "id" 
+                       , _nc_node_id    = requiredTableField "node_id"
                        , _nc_context_id = requiredTableField "context_id"
                        , _nc_score      = optionalTableField "score"
                        , _nc_category   = optionalTableField "category"

src/Gargantext/Database/Schema/NodeContext_NodeContext.hs

+{-|
+Module      : Gargantext.Database.Schema.ContextContext
+Description : 
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+-}
+
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+{-# LANGUAGE Arrows                 #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE QuasiQuotes            #-}
+{-# LANGUAGE TemplateHaskell        #-}
+
+module Gargantext.Database.Schema.NodeContext_NodeContext where
+
+import Gargantext.Core.Types
+import Gargantext.Database.Schema.Prelude
+import Gargantext.Prelude
+
+
+
+data NodeContext_NodeContextPoly nodecontext1 nodecontext2
+                   = NodeContext_NodeContext { _ncnc_nodecontext1 :: !nodecontext1
+                                             , _ncnc_nodecontext2 :: !nodecontext2
+                                    } deriving (Show)
+
+type NodeContext_NodeContextWrite = NodeContext_NodeContextPoly (Column (SqlInt4))
+                                                                (Column (SqlInt4))
+
+type NodeContext_NodeContextRead  = NodeContext_NodeContextPoly (Column (SqlInt4))
+                                                                (Column (SqlInt4))
+
+type NodeContext_NodeContextReadNull  = NodeContext_NodeContextPoly (Column (Nullable SqlInt4))
+                                                                    (Column (Nullable SqlInt4))
+
+type NodeContext_NodeContext = NodeContext_NodeContextPoly NodeContextId NodeContextId
+
+$(makeAdaptorAndInstance "pNodeContext_NodeContext" ''NodeContext_NodeContextPoly)
+makeLenses ''NodeContext_NodeContextPoly
+
+nodeContext_NodeContextTable :: Table NodeContext_NodeContextWrite NodeContext_NodeContextRead
+nodeContext_NodeContextTable =
+  Table "nodescontexts_nodescontexts"
+         ( pNodeContext_NodeContext
+           NodeContext_NodeContext { _ncnc_nodecontext1 = requiredTableField "nodescontexts1"
+                                   , _ncnc_nodecontext2 = requiredTableField "nodescontexts2"
+                                   }
+          )
+queryNodeContext_NodeContextTable :: Query NodeContext_NodeContextRead
+queryNodeContext_NodeContextTable = selectTable nodeContext_NodeContextTable
+
+
+

src/Gargantext/Database/Schema/NodeNode.hs

@@ -11,8 +11,6 @@ Here is a longer description of this module, containing some
 commentary with @some markup@.
 -}
 
-{-# OPTIONS_GHC -fno-warn-orphans #-}
-
 {-# LANGUAGE Arrows                 #-}
 {-# LANGUAGE FunctionalDependencies #-}
 {-# LANGUAGE QuasiQuotes            #-}
@@ -63,18 +61,3 @@ nodeNodeTable  =
                     }
                 )
 
-instance DefaultFromField (Nullable SqlInt4)   Int            where
-    defaultFromField = fromPGSFromField
-
-instance DefaultFromField (Nullable SqlFloat8) Int            where
-    defaultFromField = fromPGSFromField
-
-instance DefaultFromField (Nullable SqlFloat8) Double         where
-    defaultFromField = fromPGSFromField
-
-instance DefaultFromField SqlFloat8            (Maybe Double) where
-    defaultFromField = fromPGSFromField
-
-instance DefaultFromField SqlInt4              (Maybe Int)    where
-    defaultFromField = fromPGSFromField
-

src/Gargantext/Database/Types.hs

@@ -9,6 +9,7 @@ Portability : POSIX
 
 -}
 
+{-# OPTIONS_GHC -fno-warn-orphans #-}
 {-# LANGUAGE TemplateHaskell        #-}
 
 module Gargantext.Database.Types
@@ -40,3 +41,19 @@ instance HasText a => HasText (Indexed i a)
     hasText (Indexed _ a) = hasText a
 
 instance (Hashable a, Hashable b) => Hashable (Indexed a b)
+
+instance DefaultFromField (Nullable SqlInt4)   Int            where
+    defaultFromField = fromPGSFromField
+
+instance DefaultFromField (Nullable SqlFloat8) Int            where
+    defaultFromField = fromPGSFromField
+
+instance DefaultFromField (Nullable SqlFloat8) Double         where
+    defaultFromField = fromPGSFromField
+
+instance DefaultFromField SqlFloat8            (Maybe Double) where
+    defaultFromField = fromPGSFromField
+
+instance DefaultFromField SqlInt4              (Maybe Int)    where
+    defaultFromField = fromPGSFromField
+