Skip to content

H
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 ( ...@@ -38,6 +38,9 @@ CREATE TABLE public.nodes (
FOREIGN KEY (user_id) REFERENCES public.auth_user(id) ON DELETE CASCADE FOREIGN KEY (user_id) REFERENCES public.auth_user(id) ON DELETE CASCADE
); );
ALTER TABLE public.nodes OWNER TO gargantua; 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 -- | Ngrams
...@@ -207,5 +210,5 @@ CREATE OR REPLACE function node_pos(int, int) returns bigint ...@@ -207,5 +210,5 @@ CREATE OR REPLACE function node_pos(int, int) returns bigint
LANGUAGE SQL immutable; LANGUAGE SQL immutable;
--drop index node_by_pos; --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 ...@@ -14,18 +14,13 @@ module Gargantext.Database.Action.Search where
import Control.Arrow (returnA) import Control.Arrow (returnA)
import Control.Lens ((^.)) import Control.Lens ((^.))
import Data.Aeson
import Data.List (intersperse)
import Data.Maybe import Data.Maybe
import Data.String (IsString(..)) import Data.Text (Text, unpack, intercalate)
import Data.Text (Text, words, unpack, intercalate)
import Data.Time (UTCTime) import Data.Time (UTCTime)
import Database.PostgreSQL.Simple (Query)
import Database.PostgreSQL.Simple.ToField
import Gargantext.Core import Gargantext.Core
import Gargantext.Core.Types import Gargantext.Core.Types
import Gargantext.Database.Admin.Types.Hyperdata (HyperdataDocument(..), HyperdataContact(..)) 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.Facet
import Gargantext.Database.Query.Filter import Gargantext.Database.Query.Filter
import Gargantext.Database.Query.Join (leftJoin5) import Gargantext.Database.Query.Join (leftJoin5)
...@@ -43,11 +38,11 @@ searchDocInDatabase :: HasDBid NodeType ...@@ -43,11 +38,11 @@ searchDocInDatabase :: HasDBid NodeType
=> ParentId => ParentId
-> Text -> Text
-> Cmd err [(NodeId, HyperdataDocument)] -> Cmd err [(NodeId, HyperdataDocument)]
searchDocInDatabase p t = runOpaQuery (queryDocInDatabase p t) searchDocInDatabase _p t = runOpaQuery (queryDocInDatabase t)
where where
-- | Global search query where ParentId is Master Node Corpus Id -- | Global search query where ParentId is Master Node Corpus Id
queryDocInDatabase :: ParentId -> Text -> O.Query (Column PGInt4, Column PGJsonb) queryDocInDatabase :: Text -> O.Query (Column PGInt4, Column PGJsonb)
queryDocInDatabase _ q = proc () -> do queryDocInDatabase q = proc () -> do
row <- queryNodeSearchTable -< () row <- queryNodeSearchTable -< ()
restrict -< (_ns_search row) @@ (pgTSQuery (unpack q)) restrict -< (_ns_search row) @@ (pgTSQuery (unpack q))
restrict -< (_ns_typename row) .== (pgInt4 $ toDBid NodeDocument) restrict -< (_ns_typename row) .== (pgInt4 $ toDBid NodeDocument)
...@@ -213,66 +208,3 @@ queryContactViaDoc = ...@@ -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) => ...@@ -82,18 +82,26 @@ instance (Typeable hyperdata, ToSchema hyperdata) =>
declareNamedSchema = wellNamedSchema "_node_" declareNamedSchema = wellNamedSchema "_node_"
instance (Typeable hyperdata, ToSchema hyperdata) => instance (Typeable hyperdata, ToSchema hyperdata) =>
ToSchema (NodePolySearch NodeId NodeTypeId ToSchema (NodePolySearch NodeId
(Maybe UserId) NodeTypeId
ParentId NodeName (Maybe UserId)
UTCTime hyperdata (Maybe TSVector) ParentId
NodeName
UTCTime
hyperdata
(Maybe TSVector)
) where ) where
declareNamedSchema = wellNamedSchema "_ns_" declareNamedSchema = wellNamedSchema "_ns_"
instance (Typeable hyperdata, ToSchema hyperdata) => instance (Typeable hyperdata, ToSchema hyperdata) =>
ToSchema (NodePolySearch NodeId NodeTypeId ToSchema (NodePolySearch NodeId
UserId NodeTypeId
(Maybe ParentId) NodeName UserId
UTCTime hyperdata (Maybe TSVector) (Maybe ParentId)
NodeName
UTCTime
hyperdata
(Maybe TSVector)
) where ) where
declareNamedSchema = wellNamedSchema "_ns_" declareNamedSchema = wellNamedSchema "_ns_"
...@@ -115,12 +123,25 @@ instance (Arbitrary hyperdata ...@@ -115,12 +123,25 @@ instance (Arbitrary hyperdata
,Arbitrary toDBid ,Arbitrary toDBid
,Arbitrary userId ,Arbitrary userId
,Arbitrary nodeParentId ,Arbitrary nodeParentId
) => Arbitrary (NodePolySearch nodeId toDBid userId nodeParentId ) => Arbitrary (NodePolySearch nodeId
NodeName UTCTime hyperdata (Maybe TSVector)) where toDBid
userId
nodeParentId
NodeName
UTCTime
hyperdata
(Maybe TSVector)
) where
--arbitrary = Node 1 1 (Just 1) 1 "name" (jour 2018 01 01) (arbitrary) (Just "") --arbitrary = Node 1 1 (Just 1) 1 "name" (jour 2018 01 01) (arbitrary) (Just "")
arbitrary = NodeSearch <$> arbitrary <*> arbitrary <*> arbitrary arbitrary = NodeSearch <$> arbitrary
<*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
<*> arbitrary <*> arbitrary <*> arbitrary
<*> arbitrary
<*> arbitrary
<*> arbitrary
<*> arbitrary
<*> arbitrary
<*> arbitrary
------------------------------------------------------------------------ ------------------------------------------------------------------------
pgNodeId :: NodeId -> O.Column O.PGInt4 pgNodeId :: NodeId -> O.Column O.PGInt4
......
src/Gargantext/Database/Query/Facet.hs
View file @ 759d28f9
...@@ -44,6 +44,8 @@ import Control.Arrow (returnA) ...@@ -44,6 +44,8 @@ import Control.Arrow (returnA)
import Control.Lens ((^.)) import Control.Lens ((^.))
import Data.Aeson (FromJSON, ToJSON) import Data.Aeson (FromJSON, ToJSON)
import Data.Aeson.TH (deriveJSON) 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.Profunctor.Product.TH (makeAdaptorAndInstance)
import Data.Swagger import Data.Swagger
import qualified Data.Text as T import qualified Data.Text as T
...@@ -59,14 +61,17 @@ import qualified Opaleye.Internal.Unpackspec() ...@@ -59,14 +61,17 @@ import qualified Opaleye.Internal.Unpackspec()
import Gargantext.Core import Gargantext.Core
import Gargantext.Core.Types import Gargantext.Core.Types
import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger, wellNamedSchema) import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger, wellNamedSchema)
-- import Gargantext.Database.Action.TSQuery (toTSQuery)
import Gargantext.Database.Admin.Types.Hyperdata import Gargantext.Database.Admin.Types.Hyperdata
import Gargantext.Database.Query.Filter import Gargantext.Database.Query.Filter
import Gargantext.Database.Query.Join (leftJoin5) import Gargantext.Database.Query.Join (leftJoin5)
import Gargantext.Database.Query.Table.Ngrams import Gargantext.Database.Query.Table.Ngrams
import Gargantext.Database.Query.Table.Node (queryNodeSearchTable)
import Gargantext.Database.Query.Table.NodeNode import Gargantext.Database.Query.Table.NodeNode
import Gargantext.Database.Query.Table.NodeNodeNgrams import Gargantext.Database.Query.Table.NodeNodeNgrams
import Gargantext.Database.Prelude import Gargantext.Database.Prelude
import Gargantext.Database.Schema.Node import Gargantext.Database.Schema.Node
import Gargantext.Prelude (printDebug)
------------------------------------------------------------------------ ------------------------------------------------------------------------
-- | DocFacet -- | DocFacet
...@@ -303,10 +308,29 @@ runViewDocuments :: HasDBid NodeType ...@@ -303,10 +308,29 @@ runViewDocuments :: HasDBid NodeType
-> Maybe Text -> Maybe Text
-> Cmd err [FacetDoc] -> Cmd err [FacetDoc]
runViewDocuments cId t o l order query = do 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 runOpaQuery $ filterWith o l order sqlQuery
where where
ntId = toDBid NodeDocument ntId = toDBid NodeDocument
sqlQuery = viewDocuments cId t ntId query 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 :: HasDBid NodeType => CorpusId -> IsTrash -> Maybe Text -> Cmd err Int
runCountDocuments cId t mQuery = do runCountDocuments cId t mQuery = do
...@@ -321,22 +345,27 @@ viewDocuments :: CorpusId ...@@ -321,22 +345,27 @@ viewDocuments :: CorpusId
-> Maybe Text -> Maybe Text
-> Query FacetDocRead -> Query FacetDocRead
viewDocuments cId t ntId mQuery = proc () -> do viewDocuments cId t ntId mQuery = proc () -> do
n <- queryNodeTable -< () --n <- queryNodeTable -< ()
n <- queryNodeSearchTable -< ()
nn <- queryNodeNodeTable -< () 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 -< 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) restrict -< if t then nn^.nn_category .== (pgInt4 0)
else nn^.nn_category .>= (pgInt4 1) else nn^.nn_category .>= (pgInt4 1)
let query = (fromMaybe "" mQuery) let query = (fromMaybe "" mQuery)
iLikeQuery = T.intercalate "" ["%", query, "%"] -- iLikeQuery = T.intercalate "" ["%", query, "%"]
restrict -< (n^.node_name) `ilike` (pgStrictText iLikeQuery) -- 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) returnA -< FacetDoc (_ns_id n)
(_node_date n) (_ns_date n)
(_node_name n) (_ns_name n)
(_node_hyperdata n) (_ns_hyperdata n)
(toNullable $ nn^.nn_category) (toNullable $ nn^.nn_category)
(toNullable $ nn^.nn_score) (toNullable $ nn^.nn_score)
(toNullable $ nn^.nn_score) (toNullable $ nn^.nn_score)
......
src/Gargantext/Database/Schema/Node.hs
View file @ 759d28f9
...@@ -144,16 +144,17 @@ data NodePolySearch id ...@@ -144,16 +144,17 @@ data NodePolySearch id
date date
hyperdata hyperdata
search = search =
NodeSearch { _ns_id :: id NodeSearch { _ns_id :: id
, _ns_typename :: typename , _ns_typename :: typename
, _ns_user_id :: user_id , _ns_user_id :: user_id
-- , nodeUniqId :: shaId -- , nodeUniqId :: shaId
, _ns_parent_id :: parent_id , _ns_parent_id :: parent_id
, _ns_name :: name , _ns_name :: name
, _ns_date :: date , _ns_date :: date
, _ns_hyperdata :: hyperdata , _ns_hyperdata :: hyperdata
, _ns_search :: search , _ns_search :: search
, _ns_search_title :: search
} deriving (Show, Generic) } deriving (Show, Generic)
$(makeAdaptorAndInstance "pNodeSearch" ''NodePolySearch) $(makeAdaptorAndInstance "pNodeSearch" ''NodePolySearch)
...@@ -163,16 +164,17 @@ $(makeLenses ''NodePolySearch) ...@@ -163,16 +164,17 @@ $(makeLenses ''NodePolySearch)
nodeTableSearch :: Table NodeSearchWrite NodeSearchRead nodeTableSearch :: Table NodeSearchWrite NodeSearchRead
nodeTableSearch = Table "nodes" ( pNodeSearch nodeTableSearch = Table "nodes" ( pNodeSearch
NodeSearch { _ns_id = optional "id" NodeSearch { _ns_id = optional "id"
, _ns_typename = required "typename" , _ns_typename = required "typename"
, _ns_user_id = required "user_id" , _ns_user_id = required "user_id"
, _ns_parent_id = required "parent_id" , _ns_parent_id = required "parent_id"
, _ns_name = required "name" , _ns_name = required "name"
, _ns_date = optional "date" , _ns_date = optional "date"
, _ns_hyperdata = required "hyperdata" , _ns_hyperdata = required "hyperdata"
, _ns_search = optional "search" , _ns_search = optional "search"
, _ns_search_title = optional "search_title"
} }
) )
------------------------------------------------------------------------ ------------------------------------------------------------------------
stack.yaml
View file @ 759d28f9
...@@ -43,8 +43,10 @@ extra-deps: ...@@ -43,8 +43,10 @@ extra-deps:
commit: 8cb8aaf2962ad44d319fcea48442e4397b3c49e8 commit: 8cb8aaf2962ad44d319fcea48442e4397b3c49e8
# Databases libs # Databases libs
- git: https://github.com/delanoe/haskell-opaleye.git #- opaleye-0.6.7002.0 #- git: https://github.com/delanoe/haskell-opaleye.git #- opaleye-0.6.7002.0)
commit: 63ee65d974e9d20eaaf17a2e83652175988cbb79 # commit: 63ee65d974e9d20eaaf17a2e83652175988cbb79
- git: https://github.com/cgenie/haskell-opaleye.git
commit: 41e3212e7da83d295cd6d0fa4f0a2b55b86bbbca
- git: https://github.com/delanoe/hsparql.git - git: https://github.com/delanoe/hsparql.git
commit: 308c74b71a1abb0a91546fa57d353131248e3a7f commit: 308c74b71a1abb0a91546fa57d353131248e3a7f
- git: https://github.com/robstewart57/rdf4h.git - 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