[API][DB] Pairing tools: get pairs and pairWith.

src/Gargantext/API/Node.hs

@@ -12,7 +12,6 @@ Portability : POSIX
 -- TODO-ACCESS: CanGetNode
 -- TODO-EVENTS: No events as this is a read only query.
 Node API
-
 -------------------------------------------------------------------
 -- TODO-ACCESS: access by admin only.
 --              At first let's just have an isAdmin check.
@@ -61,7 +60,7 @@ import Gargantext.Database.Flow.Pairing (pairing)
 import Gargantext.Database.Facet (FacetDoc, OrderBy(..))
 import Gargantext.Database.Node.Children (getChildren)
 import Gargantext.Database.Schema.Node ( getNodesWithParentId, getNodeWith, getNode, deleteNode, deleteNodes, mkNodeWithParent, JSONB, HasNodeError(..))
-import Gargantext.Database.Schema.NodeNode (nodeNodesCategory)
+import Gargantext.Database.Schema.NodeNode -- (nodeNodesCategory, insertNodeNode, NodeNode(..))
 import Gargantext.Database.Node.UpdateOpaleye (updateHyperdata)
 import Gargantext.Database.Tree (treeDB)
 import Gargantext.Database.Types.Node
@@ -132,7 +131,10 @@ type NodeAPI a = Get '[JSON] (Node a)
 
              :<|> "category"  :> CatApi
              :<|> "search"     :> SearchDocsAPI
+
              -- Pairing utilities
+             :<|> "pairwith"   :> PairWith
+             :<|> "pairs"      :> Pairs
              :<|> "pairing"    :> PairingApi
              :<|> "searchPair" :> SearchPairsAPI
 
@@ -192,11 +194,13 @@ nodeAPI p uId id = withAccess (Proxy :: Proxy (NodeAPI a)) Proxy uId (PathNode i
            :<|> tableApi             id
            :<|> apiNgramsTableCorpus id
 
-           :<|> catApi        id
+           :<|> catApi      id
 
            :<|> searchDocs  id
            -- Pairing Tools
-           :<|> getPair       id
+           :<|> pairWith    id
+           :<|> pairs       id
+           :<|> getPair     id
            :<|> searchPairs id
 
            :<|> getScatter id
@@ -268,6 +272,12 @@ type PairingApi = Summary " Pairing API"
               :> Get '[JSON] [FacetDoc]
 
 ----------
+type Pairs    = Summary "List of Pairs"
+              :> Get '[JSON] [AnnuaireId]
+pairs :: CorpusId -> GargServer Pairs
+pairs cId = do
+  ns <- getNodeNode cId
+  pure $ map _nn_node2_id ns
 
 type PairWith = Summary "Pair a Corpus with an Annuaire"
               :> "annuaire" :> Capture "annuaire_id" AnnuaireId
@@ -277,6 +287,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]
   pure r
 
 ------------------------------------------------------------------------

src/Gargantext/Database/Node/Document/Add.hs

@@ -75,7 +75,6 @@ prepare pId ns = map (\nId -> InputData pId nId) ns
 ------------------------------------------------------------------------
 -- * Main Types used
 
-
 data InputData = InputData { inNode1_id :: NodeId
                            , inNode2_id :: NodeId
                            } deriving (Show, Generic, Typeable)

src/Gargantext/Database/Node/Document/Insert.hs

@@ -135,7 +135,6 @@ instance InsertDb HyperdataContact
                       , (toField . toJSON) h
                       ]
 
-
 -- | Debug SQL function
 --
 -- to print rendered query (Debug purpose) use @formatQuery@ function.

src/Gargantext/Database/Schema/Node.hs

@@ -530,9 +530,16 @@ arbitraryDashboard = HyperdataDashboard (Just "Preferences")
 ------------------------------------------------------------------------
 
 node :: (ToJSON a, Hyperdata a) => NodeType -> Name -> a -> Maybe ParentId -> UserId -> NodeWrite
-node nodeType name hyperData parentId userId = Node Nothing (pgInt4 typeId) (pgInt4 userId) (pgNodeId <$> parentId) (pgStrictText name) Nothing (pgJSONB $ cs $ encode hyperData)
-  where
-    typeId = nodeTypeId nodeType
+node nodeType name hyperData parentId userId =
+  Node Nothing 
+       (pgInt4 typeId)
+       (pgInt4 userId)
+       (pgNodeId <$> parentId)
+       (pgStrictText name)
+       Nothing
+       (pgJSONB $ cs $ encode hyperData)
+    where
+      typeId = nodeTypeId nodeType
 
                   -------------------------------
 insertNodes :: [NodeWrite] -> Cmd err Int64

src/Gargantext/Database/Schema/NodeNode.hs

@@ -65,7 +65,7 @@ type NodeNodeReadNull  = NodeNodePoly (Column (Nullable PGInt4))
                                       (Column (Nullable PGFloat8))
                                       (Column (Nullable PGInt4))
 
-type NodeNode = NodeNodePoly Int Int (Maybe Double) (Maybe Int)
+type NodeNode = NodeNodePoly NodeId NodeId (Maybe Double) (Maybe Int)
 
 $(makeAdaptorAndInstance "pNodeNode" ''NodeNodePoly)
 makeLenses ''NodeNodePoly
@@ -102,8 +102,30 @@ instance QueryRunnerColumnDefault PGFloat8 (Maybe Double) where
 instance QueryRunnerColumnDefault PGInt4 (Maybe Int) where
     queryRunnerColumnDefault = fieldQueryRunnerColumn
 
-
 ------------------------------------------------------------------------
+-- | Basic NodeNode tools
+getNodeNode :: NodeId -> Cmd err [NodeNode]
+getNodeNode n = runOpaQuery (selectNodeNode $ pgNodeId n)
+  where
+    selectNodeNode :: Column PGInt4 -> Query NodeNodeRead
+    selectNodeNode n' = proc () -> do
+      ns <- queryNodeNodeTable -< ()
+      restrict -< _nn_node1_id ns .== n'
+      returnA -< ns
+
+-------------------------
+insertNodeNode :: [NodeNode] -> Cmd err Int64
+insertNodeNode ns = mkCmd $ \conn -> runInsert_ conn $ Insert nodeNodeTable ns' rCount Nothing
+  where
+    ns' :: [NodeNodeWrite]
+    ns' = map (\(NodeNode n1 n2 x y)
+                -> NodeNode (pgNodeId n1)
+                            (pgNodeId n2)
+                            (pgDouble <$> x)
+                            (pgInt4   <$> y) 
+              ) ns
+
+
 -- | Favorite management
 nodeNodeCategory :: CorpusId -> DocId -> Int -> Cmd err [Int]
 nodeNodeCategory cId dId c = map (\(PGS.Only a) -> a) <$> runPGSQuery favQuery (c,cId,dId)
@@ -131,12 +153,10 @@ nodeNodesCategory inputData = map (\(PGS.Only a) -> a)
 ------------------------------------------------------------------------
 -- | TODO use UTCTime fast 
 selectDocsDates :: CorpusId -> Cmd err [Text]
-selectDocsDates cId = 
-                map (head' "selectDocsDates" . splitOn "-")
-               <$> catMaybes
-               <$> map (view hyperdataDocument_publication_date)
-               <$> selectDocs cId
-
+selectDocsDates cId =  map (head' "selectDocsDates" . splitOn "-")
+                   <$> catMaybes
+                   <$> map (view hyperdataDocument_publication_date)
+                   <$> selectDocs cId
 
 selectDocs :: CorpusId -> Cmd err [HyperdataDocument]
 selectDocs cId = runOpaQuery (queryDocs cId)
@@ -149,7 +169,6 @@ queryDocs cId = proc () -> do
   restrict -< n^.node_typename .== (pgInt4 $ nodeTypeId NodeDocument)
   returnA -< view (node_hyperdata) n
 
-
 selectDocNodes :: CorpusId -> Cmd err [Node HyperdataDocument]
 selectDocNodes cId = runOpaQuery (queryDocNodes cId)
 
@@ -161,14 +180,12 @@ queryDocNodes cId = proc () -> do
   restrict -< n^.node_typename .== (pgInt4 $ nodeTypeId NodeDocument)
   returnA -<  n
 
-
 joinInCorpus :: O.Query (NodeRead, NodeNodeReadNull)
 joinInCorpus = leftJoin queryNodeTable queryNodeNodeTable cond
   where
     cond :: (NodeRead, NodeNodeRead) -> Column PGBool
     cond (n, nn) = nn^.nn_node2_id .== (view node_id n)
 
-
 ------------------------------------------------------------------------
 -- | Trash management
 nodeToTrash :: CorpusId -> DocId -> Bool -> Cmd err [PGS.Only Int]