[Utils] function to list all Annuaires paired with a corpus

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

@@ -10,7 +10,7 @@ Portability : POSIX
 -}
 
 {-# LANGUAGE QuasiQuotes #-}
--- {-# LANGUAGE Arrows #-}
+{-# LANGUAGE Arrows      #-}
 
 module Gargantext.Database.Action.Flow.Pairing
   -- (pairing)
@@ -26,9 +26,11 @@ import Gargantext.Core.Types (TableResult(..), Term)
 import Gargantext.Database
 import Gargantext.Database.Admin.Types.Hyperdata -- (HyperdataContact(..))
 import Gargantext.Database.Admin.Types.Node -- (AnnuaireId, CorpusId, ListId, DocId, ContactId, NodeId)
-import Gargantext.Database.Prelude (Cmd, runPGSQuery)
+import Gargantext.Database.Prelude (Cmd, runPGSQuery, runOpaQuery)
+import Gargantext.Database.Query.Prelude (leftJoin2, returnA, queryNodeNodeTable)
 import Gargantext.Database.Query.Table.Node.Children (getAllContacts)
 import Gargantext.Database.Schema.Ngrams -- (NgramsType(..))
+import Gargantext.Database.Admin.Config (nodeTypeId)
 import Gargantext.Database.Schema.Node
 import Gargantext.Prelude hiding (sum)
 import Safe (lastMay)
@@ -36,6 +38,28 @@ import qualified Data.List as List
 import qualified Data.Map  as Map
 import qualified Data.Text as DT
 import qualified Data.Set  as Set
+import Opaleye
+
+
+-- | isPairedWith
+-- All NodeAnnuaire paired with a Corpus of NodeId nId:
+-- isPairedWith NodeAnnuaire corpusId
+isPairedWith :: NodeType -> NodeId -> Cmd err [NodeId]
+isPairedWith nt nId = runOpaQuery (selectQuery nt nId)
+  where
+    selectQuery :: NodeType -> NodeId -> Query (Column PGInt4)
+    selectQuery nt' nId' = proc () -> do
+      (node, node_node) <- queryJoin -< ()
+      restrict -< (node^.node_typename)    .== (pgInt4 $ nodeTypeId nt')
+      restrict -< (node_node^.nn_node1_id) .== (toNullable $ pgNodeId nId')
+      returnA  -<  node^.node_id
+
+    queryJoin :: Query (NodeRead, NodeNodeReadNull)
+    queryJoin = leftJoin2 queryNodeTable queryNodeNodeTable cond
+      where
+        cond (node, node_node) = node^.node_id .== node_node^. nn_node2_id
+
+
 
 
 -----------------------------------------------------------------------
@@ -170,4 +194,3 @@ selectNgramsDocId corpusId' listId' ngramsType' =
                       AND nnng.ngrams_type = ?
                     ;
                    |]
-

src/Gargantext/Database/Action/Search.hs

@@ -136,8 +136,6 @@ selectContactViaDoc cId aId q = proc () -> do
                           (contact^.node_hyperdata)
                           (toNullable $ pgInt4 0)
 
-
-
 queryContactViaDoc :: O.Query ( NodeSearchRead
                               , ( NodeNodeReadNull
                                 , ( NodeNodeReadNull

src/Gargantext/Database/Query/Join.hs

@@ -22,7 +22,15 @@ Multiple Join functions with Opaleye.
 
 ------------------------------------------------------------------------
 
-module Gargantext.Database.Query.Join
+module Gargantext.Database.Query.Join ( leftJoin2
+                                      , leftJoin3
+                                      , leftJoin4
+                                      , leftJoin5
+                                      , leftJoin6
+                                      , leftJoin7
+                                      , leftJoin8
+                                      , leftJoin9
+                                      )
   where
 
 import Control.Applicative ((<*>))
@@ -33,17 +41,24 @@ import Opaleye
 import Opaleye.Internal.Join (NullMaker(..))
 import qualified Opaleye.Internal.Unpackspec()
 
---leftJoin3 :: Query columnsL1 -> Query columnsR -> Query columnsL
---     -> ((columnsL1, columnsR) -> Column PGBool)
---     -> ((columnsL, (columnsL1, nullableColumnsR1)) -> Column PGBool)
---     -> Query (columnsL, nullableColumnsR)
---leftJoin3 q1 q2 q3 cond12 cond23 = leftJoin q3 (leftJoin q1 q2 cond12) cond23
-join3 :: Query columnsA -> Query columnsB -> Query columnsC 
+------------------------------------------------------------------------
+leftJoin2 :: (Default Unpackspec fieldsL fieldsL,
+              Default Unpackspec fieldsR fieldsR,
+              Default NullMaker fieldsR nullableFieldsR) =>
+             Select fieldsL
+             -> Select fieldsR
+             -> ((fieldsL, fieldsR) -> Column PGBool)
+             -> Select (fieldsL, nullableFieldsR)
+leftJoin2 = leftJoin
+
+------------------------------------------------------------------------
+-- | LeftJoin3 in two ways to write it
+_leftJoin3 :: Query columnsA -> Query columnsB -> Query columnsC
       -> ((columnsA, columnsB, columnsC) -> Column PGBool) 
       -> Query (columnsA, columnsB, columnsC)
-join3 q1 q2 q3 cond = ((,,) <$> q1 <*> q2 <*> q3) >>> keepWhen cond
+_leftJoin3 q1 q2 q3 cond = ((,,) <$> q1 <*> q2 <*> q3) >>> keepWhen cond
+
 
-------------------------------------------------------------------------
 leftJoin3
   :: (Default Unpackspec fieldsL1 fieldsL1,
       Default Unpackspec fieldsL2 fieldsL2,

src/Gargantext/Database/Query/Prelude.hs

+{-|
+Module      : Gargantext.Database.Query.Prelude
+Description :
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+
+-}
+
+------------------------------------------------------------------------
+module Gargantext.Database.Query.Prelude
+ ( module Gargantext.Database.Query.Join
+ , module Gargantext.Database.Query.Table.Node
+ , module Gargantext.Database.Query.Table.NodeNode
+ , module Control.Arrow
+ )
+  where
+
+import Control.Arrow (returnA)
+import Gargantext.Database.Query.Join
+import Gargantext.Database.Query.Table.Node
+import Gargantext.Database.Query.Table.NodeNode