Skip to content

haskell-gargantext
haskell-gargantext
Commit 759d28f9 authored by Alexandre Delanoë's avatar Alexandre Delanoë
Browse files
Options

Merge branch 'dev-ilike-search-fix' of... 

Merge branch 'dev-ilike-search-fix' of ssh://gitlab.iscpif.fr:20022/gargantext/haskell-gargantext into dev-merge1
parents e3fd9e58 76279305
Hide whitespace changes
Inline Side-by-side
Showing with 183 additions and 116 deletions
devops/postgres/schema.sql
View file @ 759d28f9
......@@ -38,6 +38,9 @@ CREATE TABLE public.nodes (
FOREIGN KEY (user_id) REFERENCES public.auth_user(id) ON DELETE CASCADE
);
ALTER TABLE public.nodes OWNER TO gargantua;
ALTER TABLE nodes
ADD COLUMN search_title tsvector
GENERATED ALWAYS AS (to_tsvector('english', coalesce("hyperdata"->>'title', '') || ' ' || coalesce("hyperdata"->>'abstract', ''))) STORED;
--------------------------------------------------------------
-- | Ngrams
......@@ -207,5 +210,5 @@ CREATE OR REPLACE function node_pos(int, int) returns bigint
LANGUAGE SQL immutable;
--drop index node_by_pos;
create index node_by_pos on nodes using btree(node_pos(id,typename));
--create index node_by_pos on nodes using btree(node_pos(id,typename));
src/Gargantext/Database/Action/Search.hs
View file @ 759d28f9
......@@ -14,18 +14,13 @@ module Gargantext.Database.Action.Search where
import Control.Arrow (returnA)
import Control.Lens ((^.))
import Data.Aeson
import Data.List (intersperse)
import Data.Maybe
import Data.String (IsString(..))
import Data.Text (Text, words, unpack, intercalate)
import Data.Text (Text, unpack, intercalate)
import Data.Time (UTCTime)
import Database.PostgreSQL.Simple (Query)
import Database.PostgreSQL.Simple.ToField
import Gargantext.Core
import Gargantext.Core.Types
import Gargantext.Database.Admin.Types.Hyperdata (HyperdataDocument(..), HyperdataContact(..))
import Gargantext.Database.Prelude (Cmd, runPGSQuery, runOpaQuery, runCountOpaQuery)
import Gargantext.Database.Prelude (Cmd, runOpaQuery, runCountOpaQuery)
import Gargantext.Database.Query.Facet
import Gargantext.Database.Query.Filter
import Gargantext.Database.Query.Join (leftJoin5)
......@@ -43,11 +38,11 @@ searchDocInDatabase :: HasDBid NodeType
=> ParentId
-> Text
-> Cmd err [(NodeId, HyperdataDocument)]
searchDocInDatabase p t = runOpaQuery (queryDocInDatabase p t)
searchDocInDatabase _p t = runOpaQuery (queryDocInDatabase t)
where
-- | Global search query where ParentId is Master Node Corpus Id
queryDocInDatabase :: ParentId -> Text -> O.Query (Column PGInt4, Column PGJsonb)
queryDocInDatabase _ q = proc () -> do
queryDocInDatabase :: Text -> O.Query (Column PGInt4, Column PGJsonb)
queryDocInDatabase q = proc () -> do
row <- queryNodeSearchTable -< ()
restrict -< (_ns_search row) @@ (pgTSQuery (unpack q))
restrict -< (_ns_typename row) .== (pgInt4 $ toDBid NodeDocument)
......@@ -213,66 +208,3 @@ queryContactViaDoc =
------------------------------------------------------------------------
newtype TSQuery = UnsafeTSQuery [Text]
-- | TODO [""] -> panic "error"
toTSQuery :: [Text] -> TSQuery
toTSQuery txt = UnsafeTSQuery $ map stemIt txt
instance IsString TSQuery
where
fromString = UnsafeTSQuery . words . cs
instance ToField TSQuery
where
toField (UnsafeTSQuery xs)
= Many $ intersperse (Plain " && ")
$ map (\q -> Many [ Plain "plainto_tsquery("
, Escape (cs q)
, Plain ")"
]
) xs
data Order = Asc | Desc
instance ToField Order
where
toField Asc = Plain "ASC"
toField Desc = Plain "DESC"
-- TODO
-- FIX fav
-- ADD ngrams count
-- TESTS
textSearchQuery :: Query
textSearchQuery = "SELECT n.id, n.hyperdata->'publication_year' \
\ , n.hyperdata->'title' \
\ , n.hyperdata->'source' \
\ , n.hyperdata->'authors' \
\ , COALESCE(nn.score,null) \
\ FROM nodes n \
\ LEFT JOIN nodes_nodes nn ON nn.node2_id = n.id \
\ WHERE \
\ n.search @@ (?::tsquery) \
\ AND (n.parent_id = ? OR nn.node1_id = ?) \
\ AND n.typename = ? \
\ ORDER BY n.hyperdata -> 'publication_date' ? \
\ offset ? limit ?;"
-- | Text Search Function for Master Corpus
-- TODO : text search for user corpus
-- Example:
-- textSearchTest :: ParentId -> TSQuery -> Cmd err [(Int, Value, Value, Value, Value, Maybe Int)]
-- textSearchTest pId q = textSearch q pId 5 0 Asc
textSearch :: HasDBid NodeType
=> TSQuery -> ParentId
-> Limit -> Offset -> Order
-> Cmd err [(Int,Value,Value,Value, Value, Maybe Int)]
textSearch q p l o ord = runPGSQuery textSearchQuery (q,p,p,typeId,ord,o,l)
where
typeId = toDBid NodeDocument
src/Gargantext/Database/Action/TSQuery.hs 0 → 100644
View file @ 759d28f9
module Gargantext.Database.Action.TSQuery where
import Data.Aeson
import Data.List (intersperse)
import Data.Maybe
import Data.String (IsString(..))
import Data.Text (Text, words)
import Database.PostgreSQL.Simple (Query)
import Database.PostgreSQL.Simple.ToField
import Gargantext.Core
import Gargantext.Core.Types
import Gargantext.Database.Prelude (Cmd, runPGSQuery)
import Gargantext.Prelude
import Gargantext.Core.Text.Terms.Mono.Stem.En (stemIt)
newtype TSQuery = UnsafeTSQuery [Text]
-- | TODO [""] -> panic "error"
toTSQuery :: [Text] -> TSQuery
toTSQuery txt = UnsafeTSQuery $ map stemIt txt
instance IsString TSQuery
where
fromString = UnsafeTSQuery . words . cs
instance ToField TSQuery
where
toField (UnsafeTSQuery xs)
= Many $ intersperse (Plain " && ")
$ map (\q -> Many [ Plain "plainto_tsquery("
, Escape (cs q)
, Plain ")"
]
) xs
data Order = Asc | Desc
instance ToField Order
where
toField Asc = Plain "ASC"
toField Desc = Plain "DESC"
-- TODO
-- FIX fav
-- ADD ngrams count
-- TESTS
textSearchQuery :: Query
textSearchQuery = "SELECT n.id, n.hyperdata->'publication_year' \
\ , n.hyperdata->'title' \
\ , n.hyperdata->'source' \
\ , n.hyperdata->'authors' \
\ , COALESCE(nn.score,null) \
\ FROM nodes n \
\ LEFT JOIN nodes_nodes nn ON nn.node2_id = n.id \
\ WHERE \
\ n.search @@ (?::tsquery) \
\ AND (n.parent_id = ? OR nn.node1_id = ?) \
\ AND n.typename = ? \
\ ORDER BY n.hyperdata -> 'publication_date' ? \
\ offset ? limit ?;"
-- | Text Search Function for Master Corpus
-- TODO : text search for user corpus
-- Example:
-- textSearchTest :: ParentId -> TSQuery -> Cmd err [(Int, Value, Value, Value, Value, Maybe Int)]
-- textSearchTest pId q = textSearch q pId 5 0 Asc
textSearch :: HasDBid NodeType
=> TSQuery -> ParentId
-> Limit -> Offset -> Order
-> Cmd err [(Int,Value,Value,Value, Value, Maybe Int)]
textSearch q p l o ord = runPGSQuery textSearchQuery (q,p,p,typeId,ord,o,l)
where
typeId = toDBid NodeDocument
src/Gargantext/Database/Admin/Types/Node.hs
View file @ 759d28f9
......@@ -82,18 +82,26 @@ instance (Typeable hyperdata, ToSchema hyperdata) =>
declareNamedSchema = wellNamedSchema "_node_"
instance (Typeable hyperdata, ToSchema hyperdata) =>
ToSchema (NodePolySearch NodeId NodeTypeId
(Maybe UserId)
ParentId NodeName
UTCTime hyperdata (Maybe TSVector)
ToSchema (NodePolySearch NodeId
NodeTypeId
(Maybe UserId)
ParentId
NodeName
UTCTime
hyperdata
(Maybe TSVector)
) where
declareNamedSchema = wellNamedSchema "_ns_"
instance (Typeable hyperdata, ToSchema hyperdata) =>
ToSchema (NodePolySearch NodeId NodeTypeId
UserId
(Maybe ParentId) NodeName
UTCTime hyperdata (Maybe TSVector)
ToSchema (NodePolySearch NodeId
NodeTypeId
UserId
(Maybe ParentId)
NodeName
UTCTime
hyperdata
(Maybe TSVector)
) where
declareNamedSchema = wellNamedSchema "_ns_"
......@@ -115,12 +123,25 @@ instance (Arbitrary hyperdata
,Arbitrary toDBid
,Arbitrary userId
,Arbitrary nodeParentId
) => Arbitrary (NodePolySearch nodeId toDBid userId nodeParentId
NodeName UTCTime hyperdata (Maybe TSVector)) where
) => Arbitrary (NodePolySearch nodeId
toDBid
userId
nodeParentId
NodeName
UTCTime
hyperdata
(Maybe TSVector)
) where
--arbitrary = Node 1 1 (Just 1) 1 "name" (jour 2018 01 01) (arbitrary) (Just "")
arbitrary = NodeSearch <$> arbitrary <*> arbitrary <*> arbitrary
<*> arbitrary <*> arbitrary <*> arbitrary
<*> arbitrary <*> arbitrary
arbitrary = NodeSearch <$> arbitrary
<*> arbitrary
<*> arbitrary
<*> arbitrary
<*> arbitrary
<*> arbitrary
<*> arbitrary
<*> arbitrary
<*> arbitrary
------------------------------------------------------------------------
pgNodeId :: NodeId -> O.Column O.PGInt4
......
src/Gargantext/Database/Query/Facet.hs
View file @ 759d28f9
......@@ -44,6 +44,8 @@ import Control.Arrow (returnA)
import Control.Lens ((^.))
import Data.Aeson (FromJSON, ToJSON)
import Data.Aeson.TH (deriveJSON)
--import qualified Database.PostgreSQL.Simple as DPS
--import Database.PostgreSQL.Simple.SqlQQ (sql)
import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
import Data.Swagger
import qualified Data.Text as T
......@@ -59,14 +61,17 @@ import qualified Opaleye.Internal.Unpackspec()
import Gargantext.Core
import Gargantext.Core.Types
import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger, wellNamedSchema)
-- import Gargantext.Database.Action.TSQuery (toTSQuery)
import Gargantext.Database.Admin.Types.Hyperdata
import Gargantext.Database.Query.Filter
import Gargantext.Database.Query.Join (leftJoin5)
import Gargantext.Database.Query.Table.Ngrams
import Gargantext.Database.Query.Table.Node (queryNodeSearchTable)
import Gargantext.Database.Query.Table.NodeNode
import Gargantext.Database.Query.Table.NodeNodeNgrams
import Gargantext.Database.Prelude
import Gargantext.Database.Schema.Node
import Gargantext.Prelude (printDebug)
------------------------------------------------------------------------
-- | DocFacet
......@@ -303,10 +308,29 @@ runViewDocuments :: HasDBid NodeType
-> Maybe Text
-> Cmd err [FacetDoc]
runViewDocuments cId t o l order query = do
-- docs <- runPGSQuery viewDocuments'
-- ( cId
-- , ntId
-- , (if t then 0 else 1) :: Int
-- , fromMaybe "" query
-- , fromMaybe "" query)
-- pure $ (\(id, date, name', hyperdata, category, score) -> FacetDoc id date name' hyperdata category score score) <$> docs
printDebug "[runViewDocuments] sqlQuery" $ showSql sqlQuery
runOpaQuery $ filterWith o l order sqlQuery
where
ntId = toDBid NodeDocument
sqlQuery = viewDocuments cId t ntId query
-- viewDocuments' :: DPS.Query
-- viewDocuments' = [sql|
-- SELECT n.id, n.date, n.name, n.hyperdata, nn.category, nn.score
-- FROM nodes AS n
-- JOIN nodes_nodes AS nn
-- ON n.id = nn.node2_id
-- WHERE nn.node1_id = ? -- corpusId
-- AND n.typename = ? -- NodeTypeId
-- AND nn.category = ? -- isTrash or not
-- AND (n.search_title @@ to_tsquery(?) OR ? = '') -- query with an OR hack for empty to_tsquery('') results
-- |]
runCountDocuments :: HasDBid NodeType => CorpusId -> IsTrash -> Maybe Text -> Cmd err Int
runCountDocuments cId t mQuery = do
......@@ -321,22 +345,27 @@ viewDocuments :: CorpusId
-> Maybe Text
-> Query FacetDocRead
viewDocuments cId t ntId mQuery = proc () -> do
n <- queryNodeTable -< ()
--n <- queryNodeTable -< ()
n <- queryNodeSearchTable -< ()
nn <- queryNodeNodeTable -< ()
restrict -< n^.node_id .== nn^.nn_node2_id
restrict -< n^.ns_id .== nn^.nn_node2_id
restrict -< nn^.nn_node1_id .== (pgNodeId cId)
restrict -< n^.node_typename .== (pgInt4 ntId)
restrict -< n^.ns_typename .== (pgInt4 ntId)
restrict -< if t then nn^.nn_category .== (pgInt4 0)
else nn^.nn_category .>= (pgInt4 1)
let query = (fromMaybe "" mQuery)
iLikeQuery = T.intercalate "" ["%", query, "%"]
restrict -< (n^.node_name) `ilike` (pgStrictText iLikeQuery)
-- iLikeQuery = T.intercalate "" ["%", query, "%"]
-- restrict -< (n^.node_name) `ilike` (pgStrictText iLikeQuery)
restrict -< if query == ""
then pgBool True
--else (n^.ns_search_title) @@ (pgTSQuery (T.unpack query))
else (n^.ns_search_title) @@ (toTSQuery $ T.unpack query)
returnA -< FacetDoc (_node_id n)
(_node_date n)
(_node_name n)
(_node_hyperdata n)
returnA -< FacetDoc (_ns_id n)
(_ns_date n)
(_ns_name n)
(_ns_hyperdata n)
(toNullable $ nn^.nn_category)
(toNullable $ nn^.nn_score)
(toNullable $ nn^.nn_score)
......
src/Gargantext/Database/Schema/Node.hs
View file @ 759d28f9
......@@ -144,16 +144,17 @@ data NodePolySearch id
date
hyperdata
search =
NodeSearch { _ns_id :: id
, _ns_typename :: typename
, _ns_user_id :: user_id
-- , nodeUniqId :: shaId
, _ns_parent_id :: parent_id
, _ns_name :: name
, _ns_date :: date
, _ns_hyperdata :: hyperdata
, _ns_search :: search
NodeSearch { _ns_id :: id
, _ns_typename :: typename
, _ns_user_id :: user_id
-- , nodeUniqId :: shaId
, _ns_parent_id :: parent_id
, _ns_name :: name
, _ns_date :: date
, _ns_hyperdata :: hyperdata
, _ns_search :: search
, _ns_search_title :: search
} deriving (Show, Generic)
$(makeAdaptorAndInstance "pNodeSearch" ''NodePolySearch)
......@@ -163,16 +164,17 @@ $(makeLenses ''NodePolySearch)
nodeTableSearch :: Table NodeSearchWrite NodeSearchRead
nodeTableSearch = Table "nodes" ( pNodeSearch
NodeSearch { _ns_id = optional "id"
, _ns_typename = required "typename"
, _ns_user_id = required "user_id"
NodeSearch { _ns_id = optional "id"
, _ns_typename = required "typename"
, _ns_user_id = required "user_id"
, _ns_parent_id = required "parent_id"
, _ns_name = required "name"
, _ns_date = optional "date"
, _ns_parent_id = required "parent_id"
, _ns_name = required "name"
, _ns_date = optional "date"
, _ns_hyperdata = required "hyperdata"
, _ns_search = optional "search"
, _ns_hyperdata = required "hyperdata"
, _ns_search = optional "search"
, _ns_search_title = optional "search_title"
}
)
------------------------------------------------------------------------
stack.yaml
View file @ 759d28f9
......@@ -43,8 +43,10 @@ extra-deps:
commit: 8cb8aaf2962ad44d319fcea48442e4397b3c49e8
# Databases libs
- git: https://github.com/delanoe/haskell-opaleye.git #- opaleye-0.6.7002.0
commit: 63ee65d974e9d20eaaf17a2e83652175988cbb79
#- git: https://github.com/delanoe/haskell-opaleye.git #- opaleye-0.6.7002.0)
# commit: 63ee65d974e9d20eaaf17a2e83652175988cbb79
- git: https://github.com/cgenie/haskell-opaleye.git
commit: 41e3212e7da83d295cd6d0fa4f0a2b55b86bbbca
- git: https://github.com/delanoe/hsparql.git
commit: 308c74b71a1abb0a91546fa57d353131248e3a7f
- git: https://github.com/robstewart57/rdf4h.git
......
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