diff --git a/src/Gargantext/API/Node.hs b/src/Gargantext/API/Node.hs
index 3a2f9458607c9b85b886b9e9d03f89fb6f0a9640..9d1aa87b35eca968552c2bf2216b80f5a1094815 100644
--- a/src/Gargantext/API/Node.hs
+++ b/src/Gargantext/API/Node.hs
@@ -53,8 +53,9 @@ import Gargantext.Prelude
import Gargantext.Database.Types.Node
import Gargantext.Database.Node ( runCmd
, getNodesWithParentId
- , getNode, getNodesWith
+ , getNode
, deleteNode, deleteNodes, mk, JSONB)
+import Gargantext.Database.Node.Children (getChildren)
import qualified Gargantext.Database.Node.Update as U (update, Update(..))
import Gargantext.Database.Facet (FacetDoc , runViewDocuments', OrderBy(..)
,FacetChart)
@@ -137,7 +138,7 @@ nodeAPI conn p id
:<|> postNode conn id
:<|> putNode conn id
:<|> deleteNode' conn id
- :<|> getNodesWith' conn id p
+ :<|> getChildren' conn id p
-- TODO gather it
:<|> getTable conn id
@@ -285,9 +286,9 @@ deleteNodes' conn ids = liftIO (runCmd conn $ deleteNodes ids)
deleteNode' :: Connection -> NodeId -> Handler Int
deleteNode' conn id = liftIO (runCmd conn $ deleteNode id)
-getNodesWith' :: JSONB a => Connection -> NodeId -> proxy a -> Maybe NodeType
+getChildren' :: JSONB a => Connection -> NodeId -> proxy a -> Maybe NodeType
-> Maybe Int -> Maybe Int -> Handler [Node a]
-getNodesWith' conn id p nodeType offset limit = liftIO (getNodesWith conn id p nodeType offset limit)
+getChildren' conn pId p nodeType offset limit = liftIO (getChildren conn pId p nodeType offset limit)
tableNgramsPatch' :: Connection -> CorpusId -> Maybe ListId -> NgramsIdPatchsFeed -> Handler NgramsIdPatchsBack
tableNgramsPatch' c cId mL ns = liftIO $ tableNgramsPatch c cId mL ns
diff --git a/src/Gargantext/Database/Flow.hs b/src/Gargantext/Database/Flow.hs
index 7fae0e6a22a628bfc6b1770af8c806c669b71794..c1312868c4b712d1176db648b448c1b54a4c01d0 100644
--- a/src/Gargantext/Database/Flow.hs
+++ b/src/Gargantext/Database/Flow.hs
@@ -65,7 +65,7 @@ flowInsert _nt hyperdataDocuments cName = do
let hyperdataDocuments' = map (\h -> ToDbDocument h) hyperdataDocuments
(masterUserId, _, masterCorpusId) <- subFlowCorpus userMaster corpusMasterName
- ids <- runCmd' $ insertDocuments masterUserId masterCorpusId hyperdataDocuments'
+ ids <- runCmd' $ insertDocuments masterUserId masterCorpusId NodeDocument hyperdataDocuments'
(userId, _, userCorpusId) <- subFlowCorpus userArbitrary cName
_ <- runCmd' $ add userCorpusId (map reId ids)
@@ -79,7 +79,6 @@ flowAnnuaire filePath = do
ps <- flowInsertAnnuaire "Annuaire" $ map (\h-> ToDbContact h) $ map addUniqIdsContact contacts
printDebug "length annuaire" (ps)
---{-
flowInsertAnnuaire :: CorpusName
-> [ToDbData]
@@ -87,7 +86,7 @@ flowInsertAnnuaire :: CorpusName
flowInsertAnnuaire name children = do
(masterUserId, _, masterCorpusId) <- subFlowCorpus userMaster corpusMasterName
- ids <- runCmd' $ insertDocuments masterUserId masterCorpusId children
+ ids <- runCmd' $ insertDocuments masterUserId masterCorpusId NodeContact children
(userId, _, userCorpusId) <- subFlowAnnuaire userArbitrary name
_ <- runCmd' $ add userCorpusId (map reId ids)
diff --git a/src/Gargantext/Database/Ngrams.hs b/src/Gargantext/Database/Ngrams.hs
index 166fe64989b00439864e9df85417b7b9ef05768e..d2b7c4b591a6edd64196ce2ac38669b4bd514b73 100644
--- a/src/Gargantext/Database/Ngrams.hs
+++ b/src/Gargantext/Database/Ngrams.hs
@@ -203,9 +203,9 @@ getNgramsTableDb c nt ngrt ntp@(NgramsTableParam listIdUser _) = do
let masterRootId = maybe (panic $ path <> "no userMaster Tree") (view node_id) maybeRoot
-- let errMess = panic "Error"
- corpusMasterId <- maybe (panic "error corpus master") (view node_id) <$> head <$> getCorporaWithParentId c masterRootId
+ corpusMasterId <- maybe (panic "error master corpus") (view node_id) <$> head <$> getCorporaWithParentId c masterRootId
- listMasterId <- maybe (panic "error liste master") (view node_id) <$> head <$> getListsWithParentId c corpusMasterId
+ listMasterId <- maybe (panic "error master list") (view node_id) <$> head <$> getListsWithParentId c corpusMasterId
ngramsTableData <- getNgramsTableData c nt ngrt ntp (NgramsTableParam listMasterId corpusMasterId)
@@ -239,7 +239,7 @@ getNgramsTableData conn nodeT ngrmT (NgramsTableParam ul uc) (NgramsTableParam m
nodeTId = nodeTypeId nodeT
ngrmTId = ngramsTypeId ngrmT
params = (ul,uc,nodeTId,ngrmTId,ml,mc,nodeTId,ngrmTId,uc)
-
+
querySelectTableNgrams :: DPS.Query
diff --git a/src/Gargantext/Database/Node/Children.hs b/src/Gargantext/Database/Node/Children.hs
new file mode 100644
index 0000000000000000000000000000000000000000..b2ebce13b8971f30aee6f50d4ae6b221d7ce37b4
--- /dev/null
+++ b/src/Gargantext/Database/Node/Children.hs
@@ -0,0 +1,51 @@
+{-|
+Module : Gargantext.Database.Node.Children
+Description : Main requests of Node to the database
+Copyright : (c) CNRS, 2017-Present
+License : AGPL + CECILL v3
+Maintainer : team@gargantext.org
+Stability : experimental
+Portability : POSIX
+-}
+
+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+{-# LANGUAGE Arrows #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FlexibleContexts #-}
+
+module Gargantext.Database.Node.Children where
+
+import Database.PostgreSQL.Simple (Connection)
+import Opaleye
+import Gargantext.Core.Types
+import Gargantext.Database.Node
+import Gargantext.Database.NodeNode
+import Gargantext.Database.Config (nodeTypeId)
+import Gargantext.Database.Queries
+import Control.Arrow (returnA)
+
+getChildren :: JSONB a => Connection -> ParentId -> proxy a -> Maybe NodeType
+ -> Maybe Offset -> Maybe Limit -> IO [Node a]
+getChildren c pId _ maybeNodeType maybeOffset maybeLimit = runQuery c
+ $ limit' maybeLimit $ offset' maybeOffset
+ $ orderBy (asc _node_id)
+ $ selectChildren pId maybeNodeType
+
+selectChildren :: ParentId -> Maybe NodeType -> Query NodeRead
+selectChildren parentId maybeNodeType = proc () -> do
+ row@(Node nId typeName _ parent_id _ _ _) <- queryNodeTable -< ()
+ (NodeNode n1id n2id _ _ _) <- queryNodeNodeTable -< ()
+
+ let nodeType = maybe 0 nodeTypeId maybeNodeType
+ restrict -< typeName .== pgInt4 nodeType
+
+ restrict -< (.||) (parent_id .== (toNullable $ pgInt4 parentId))
+ ( (.&&) (n1id .== pgInt4 parentId)
+ (n2id .== nId))
+ returnA -< row
+
+
+
+
diff --git a/src/Gargantext/Database/Node/Contact.hs b/src/Gargantext/Database/Node/Contact.hs
index c110cd83c1852fd08eeead327addcc1800b9bddf..937e35924af052a5584ea84be52cd72a73a83765 100644
--- a/src/Gargantext/Database/Node/Contact.hs
+++ b/src/Gargantext/Database/Node/Contact.hs
@@ -52,7 +52,7 @@ data HyperdataContact =
} deriving (Eq, Show, Generic)
--- TOD contact metadata (Type is too flat)
+-- TOD0 contact metadata (Type is too flat)
data ContactMetaData =
ContactMetaData { _cm_bdd :: Maybe Text
, _cm_lastValidation :: Maybe Text
diff --git a/src/Gargantext/Database/Node/Document/Insert.hs b/src/Gargantext/Database/Node/Document/Insert.hs
index bf89c6157e8c79645bcbaec7ae9faeb2aa0a897c..2da2c8aff3c277072cad5b8397c98f003b5195de 100644
--- a/src/Gargantext/Database/Node/Document/Insert.hs
+++ b/src/Gargantext/Database/Node/Document/Insert.hs
@@ -113,8 +113,8 @@ import Database.PostgreSQL.Simple (formatQuery)
data ToDbData = ToDbDocument HyperdataDocument | ToDbContact HyperdataContact
-insertDocuments :: UserId -> ParentId -> [ToDbData] -> Cmd [ReturnId]
-insertDocuments uId pId hs = mkCmd $ \c -> query c queryInsert (Only $ Values fields $ prepare uId pId hs)
+insertDocuments :: UserId -> ParentId -> NodeType -> [ToDbData] -> Cmd [ReturnId]
+insertDocuments uId pId nodeType hs = mkCmd $ \c -> query c queryInsert (Only $ Values fields $ prepare uId pId nodeType hs)
where
fields = map (\t-> QualifiedIdentifier Nothing t) inputSqlTypes
@@ -158,10 +158,10 @@ queryInsert = [sql|
JOIN nodes c USING (hyperdata); -- columns of unique index
|]
-prepare :: UserId -> ParentId -> [ToDbData] -> [InputData]
-prepare uId pId = map (\h -> InputData tId uId pId (name h) (toJSON' h))
+prepare :: UserId -> ParentId -> NodeType -> [ToDbData] -> [InputData]
+prepare uId pId nodeType = map (\h -> InputData tId uId pId (name h) (toJSON' h))
where
- tId = nodeTypeId NodeDocument
+ tId = nodeTypeId nodeType
toJSON' (ToDbDocument hd) = toJSON hd
toJSON' (ToDbContact hc) = toJSON hc
diff --git a/src/Gargantext/Database/TextSearch.hs b/src/Gargantext/Database/TextSearch.hs
index fc8c41a1ddb1f269c579c12f99dbd502a7eedc50..4d7bb306a14c5d52ca5e314dc7c5fdd2ca93b06d 100644
--- a/src/Gargantext/Database/TextSearch.hs
+++ b/src/Gargantext/Database/TextSearch.hs
@@ -23,7 +23,8 @@ import Data.Text (Text, words)
import Database.PostgreSQL.Simple
import Database.PostgreSQL.Simple.ToField
-
+import Gargantext.Database.Config (nodeTypeId)
+import Gargantext.Database.Types.Node (NodeType(..))
import Gargantext.Prelude
newtype TSQuery = UnsafeTSQuery [Text]
@@ -71,7 +72,8 @@ textSearchQuery = "SELECT n.id, n.hyperdata->'publication_year' \
\ LEFT JOIN nodes_nodes nn ON nn.node2_id = n.id \
\ WHERE \
\ n.search @@ (?::tsquery) \
-\ AND n.parent_id = ? AND n.typename = 4 \
+\ AND (n.parent_id = ? OR nn.node1_id = ?) \
+\ AND n.typename = ? \
\ ORDER BY n.hyperdata -> 'publication_date' ? \
\ offset ? limit ?;"
@@ -84,6 +86,8 @@ textSearch :: Connection
-> TSQuery -> ParentId
-> Limit -> Offset -> Order
-> IO [(Int,Value,Value,Value, Value, Maybe Int)]
-textSearch conn q p l o ord = query conn textSearchQuery (q,p,ord, o,l)
+textSearch conn q p l o ord = query conn textSearchQuery (q,p,p,typeId,ord,o,l)
+ where
+ typeId = nodeTypeId NodeDocument