Skip to content

haskell-gargantext
haskell-gargantext
Commit 0d46ed5e authored by Alexandre Delanoë's avatar Alexandre Delanoë
Browse files
Options

[Database][Search] types, tables + missing files.

parent f9eeab02
Hide whitespace changes
Inline Side-by-side
Showing with 123 additions and 33 deletions
src/Gargantext/Database/Queries/Filter.hs 0 → 100644
View file @ 0d46ed5e
{-|
Module : Gargantext.Database.Queries.Filter
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 #-}
{-# LANGUAGE Arrows #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Gargantext.Database.Queries.Filter where
import Gargantext.Core.Types (Limit, Offset)
import Data.Maybe (Maybe, maybe)
import Opaleye (Query, limit, offset)
limit' :: Maybe Limit -> Query a -> Query a
limit' maybeLimit query = maybe query (\l -> limit l query) maybeLimit
offset' :: Maybe Offset -> Query a -> Query a
offset' maybeOffset query = maybe query (\o -> offset o query) maybeOffset
src/Gargantext/Database/Schema/Node.hs
View file @ 0d46ed5e
......@@ -40,11 +40,10 @@ import Gargantext.Core (Lang(..))
import Gargantext.Core.Types
import Gargantext.Core.Types.Individu (Username)
import Gargantext.Core.Types.Main (UserId)
import Gargantext.Database.Utils
import Gargantext.Database.Config (nodeTypeId)
import Gargantext.Database.Queries.Filter (limit', offset')
import Gargantext.Database.Types.Node (NodeType, defaultCorpus, Hyperdata)
import Gargantext.Database.Utils (fromField')
import Gargantext.Database.Utils
import Gargantext.Prelude hiding (sum, head)
import Opaleye hiding (FromField)
import Opaleye.Internal.QueryArr (Query)
......@@ -123,6 +122,10 @@ instance QueryRunnerColumnDefault PGTSVector (Maybe TSVector)
------------------------------------------------------------------------
$(makeAdaptorAndInstance "pNode" ''NodePoly)
$(makeLensesWith abbreviatedFields ''NodePoly)
$(makeAdaptorAndInstance "pNodeSearch" ''NodePolySearch)
$(makeLensesWith abbreviatedFields ''NodePolySearch)
type NodeWrite' = NodePoly (Maybe Int) Int Int (Maybe ParentId) Text (Maybe UTCTime) ByteString (Maybe TSVector)
......@@ -168,22 +171,8 @@ nodeTable = Table "nodes" (pNode Node { _node_id = optional "id"
, _node_search = optional "search"
}
)
{-
nodeTableSearch :: Table NodeWriteSearch NodeReadSearch
nodeTableSearch = Table "nodes" (pNode Node { _node_id = optional "id"
, _node_typename = required "typename"
, _node_userId = required "user_id"
, _node_parentId = required "parent_id"
, _node_name = required "name"
, _node_date = optional "date"
, _node_hyperdata = required "hyperdata"
, _node_search = optional "search"
}
)
--}
-- | TODO remove below
nodeTable' :: Table (Maybe (Column PGInt4)
, Column PGInt4
, Column PGInt4
......@@ -216,14 +205,61 @@ nodeTable' = Table "nodes" (PP.p8 ( optional "id"
)
)
queryNodeTable :: Query NodeRead
queryNodeTable = queryTable nodeTable
{-
queryNodeTableSearch :: Query NodeReadSearch
queryNodeTableSearch = queryTable nodeTableSearch
-}
------------------------------------------------------------------------
-- | Node(Read|Write)Search is slower than Node(Write|Read) use it
-- for full text search only
type NodeSearchWrite = NodePolySearch (Maybe (Column PGInt4 ))
(Column PGInt4 )
(Column PGInt4 )
(Column (Nullable PGInt4 ))
(Column (PGText ))
(Maybe (Column PGTimestamptz))
(Column PGJsonb )
(Maybe (Column PGTSVector))
type NodeSearchRead = NodePolySearch (Column PGInt4 )
(Column PGInt4 )
(Column PGInt4 )
(Column (Nullable PGInt4 ))
(Column (PGText ))
(Column PGTimestamptz )
(Column PGJsonb)
(Column PGTSVector)
type NodeSearchReadNull = NodePolySearch (Column (Nullable PGInt4 ))
(Column (Nullable PGInt4 ))
(Column (Nullable PGInt4 ))
(Column (Nullable PGInt4 ))
(Column (Nullable PGText ))
(Column (Nullable PGTimestamptz ))
(Column (Nullable PGJsonb))
(Column (Nullable PGTSVector))
--{-
nodeTableSearch :: Table NodeSearchWrite NodeSearchRead
nodeTableSearch = Table "nodes" (pNodeSearch NodeSearch { _ns_id = optional "id"
, _ns_typename = required "typename"
, _ns_userId = required "user_id"
, _ns_parentId = required "parent_id"
, _ns_name = required "name"
, _ns_date = optional "date"
, _ns_hyperdata = required "hyperdata"
, _ns_search = optional "search"
}
)
--}
queryNodeSearchTable :: Query NodeSearchRead
queryNodeSearchTable = queryTable nodeTableSearch
selectNode :: Column PGInt4 -> Query NodeRead
......
src/Gargantext/Database/TextSearch.hs
View file @ 0d46ed5e
......@@ -38,10 +38,10 @@ globalTextSearch c p t = runQuery c (globalTextSearchQuery p t)
-- | Global search query where ParentId is Master Node Corpus Id
globalTextSearchQuery :: ParentId -> Text -> O.Query (Column PGInt4, Column PGJsonb)
globalTextSearchQuery _ q = proc () -> do
row <- queryNodeTable -< ()
restrict -< (_node_search row) @@ (pgTSQuery (unpack q))
restrict -< (_node_typename row) .== (pgInt4 $ nodeTypeId NodeDocument)
returnA -< (_node_id row, _node_hyperdata row)
row <- queryNodeSearchTable -< ()
restrict -< (_ns_search row) @@ (pgTSQuery (unpack q))
restrict -< (_ns_typename row) .== (pgInt4 $ nodeTypeId NodeDocument)
returnA -< (_ns_id row, _ns_hyperdata row)
------------------------------------------------------------------------
{-
......@@ -65,16 +65,16 @@ graphCorpusAuthorQuery = leftJoin4 queryNgramsTable queryNodeNgramTable queryNod
graphCorpusDocSearch :: CorpusId -> Text -> O.Query (Column PGInt4, Column PGJsonb)
graphCorpusDocSearch cId t = proc () -> do
(n, nn) <- graphCorpusDocSearchQuery -< ()
restrict -< (_node_search n) @@ (pgTSQuery (unpack t))
restrict -< (_ns_search n) @@ (pgTSQuery (unpack t))
restrict -< ( nodeNode_node1_id nn) .== (toNullable $ pgInt4 cId)
restrict -< (_node_typename n) .== (pgInt4 $ nodeTypeId NodeDocument)
returnA -< (_node_id n, _node_hyperdata n)
restrict -< (_ns_typename n) .== (pgInt4 $ nodeTypeId NodeDocument)
returnA -< (_ns_id n, _ns_hyperdata n)
graphCorpusDocSearchQuery :: O.Query (NodeRead, NodeNodeReadNull)
graphCorpusDocSearchQuery = leftJoin queryNodeTable queryNodeNodeTable cond
graphCorpusDocSearchQuery :: O.Query (NodeSearchRead, NodeNodeReadNull)
graphCorpusDocSearchQuery = leftJoin queryNodeSearchTable queryNodeNodeTable cond
where
cond :: (NodeRead, NodeNodeRead) -> Column PGBool
cond (n, nn) = nodeNode_node1_id nn .== _node_id n
cond :: (NodeSearchRead, NodeNodeRead) -> Column PGBool
cond (n, nn) = nodeNode_node1_id nn .== _ns_id n
......
src/Gargantext/Database/Types/Node.hs
View file @ 0d46ed5e
......@@ -323,6 +323,7 @@ instance Hyperdata HyperdataNotebook
-- | NodePoly indicates that Node has a Polymorphism Type
type Node json = NodePoly NodeId NodeTypeId NodeUserId (Maybe NodeParentId) NodeName UTCTime json (Maybe TSVector)
type NodeSearch json = NodePoly NodeId NodeTypeId NodeUserId (Maybe NodeParentId) NodeName UTCTime json (Maybe TSVector)
-- type Node json = NodePoly NodeId NodeTypeId UserId ParentId NodeName UTCTime json
type NodeTypeId = Int
......@@ -394,6 +395,25 @@ $(deriveJSON (unPrefix "_node_") ''NodePoly)
$(makeLenses ''NodePoly)
data NodePolySearch id typename userId
parentId name date
hyperdata search = NodeSearch { _ns_id :: id
, _ns_typename :: typename
, _ns_userId :: userId
-- , nodeUniqId :: hashId
, _ns_parentId :: parentId
, _ns_name :: name
, _ns_date :: date
, _ns_hyperdata :: hyperdata
, _ns_search :: search
} deriving (Show, Generic)
$(deriveJSON (unPrefix "_ns_") ''NodePolySearch)
$(makeLenses ''NodePolySearch)
------------------------------------------------------------------------
instance (Arbitrary hyperdata
,Arbitrary nodeId
,Arbitrary nodeTypeId
......
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