Commit eb358cc7 authored by Alexandre Delanoë's avatar Alexandre Delanoë

[Children][TextQueries]

parent 20d568ee
Pipeline #37 failed with stage
......@@ -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
......
......@@ -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)
......
......@@ -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
......
{-|
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
......@@ -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
......
......@@ -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
......
......@@ -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
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment