2 Module : Gargantext.Database.TextSearch
3 Description : Postgres text search experimentation
4 Copyright : (c) CNRS, 2017-Present
5 License : AGPL + CECILL v3
6 Maintainer : team@gargantext.org
7 Stability : experimental
11 {-# LANGUAGE Arrows #-}
12 {-# LANGUAGE NoImplicitPrelude #-}
13 {-# LANGUAGE OverloadedStrings #-}
15 module Gargantext.Database.TextSearch where
18 import Data.List (intersperse)
19 import Data.String (IsString(..))
20 import Data.Text (Text, words, unpack)
21 import Database.PostgreSQL.Simple -- (Query, Connection)
22 import Database.PostgreSQL.Simple.ToField
23 import Gargantext.Database.Config (nodeTypeId)
24 import Gargantext.Database.Types.Node (NodeType(..))
25 import Gargantext.Prelude
26 import Gargantext.Database.Schema.Node
27 import Gargantext.Database.Schema.NodeNode
28 import Gargantext.Core.Types
29 import Control.Arrow (returnA)
30 import qualified Opaleye as O hiding (Order)
31 import Opaleye hiding (Query, Order)
33 newtype TSQuery = UnsafeTSQuery [Text]
35 globalTextSearch :: Connection -> ParentId -> Text -> IO [(NodeId, HyperdataDocument)]
36 globalTextSearch c p t = runQuery c (globalTextSearchQuery p t)
38 -- | Global search query where ParentId is Master Node Corpus Id
39 globalTextSearchQuery :: ParentId -> Text -> O.Query (Column PGInt4, Column PGJsonb)
40 globalTextSearchQuery _ q = proc () -> do
41 row <- queryNodeSearchTable -< ()
42 restrict -< (_ns_search row) @@ (pgTSQuery (unpack q))
43 restrict -< (_ns_typename row) .== (pgInt4 $ nodeTypeId NodeDocument)
44 returnA -< (_ns_id row, _ns_hyperdata row)
46 ------------------------------------------------------------------------
48 graphCorpusAuthorQuery :: O.Query (NodeRead, (NodeNgramRead, (NgramsReadNull, NodeNgramReadNull)))
49 graphCorpusAuthorQuery = leftJoin4 queryNgramsTable queryNodeNgramTable queryNodeNgramTable queryNodeTable cond12 cond23 cond34
51 --cond12 :: (NgramsRead, NodeNgramRead) -> Column PGBool
54 cond23 :: (NodeNgramRead, (NodeNgramRead, NodeNgramReadNull)) -> Column PGBool
57 cond34 :: (NodeRead, (NodeNgramRead, (NodeReadNull, NodeNgramReadNull))) -> Column PGBool
60 --runGraphCorpusDocSearch :: Connection -> CorpusId -> Text -> IO [(Column PGInt4, Column PGJsonb)]
61 --runGraphCorpusDocSearch c cId t = runQuery c $ graphCorpusDocSearch cId t
64 -- | todo add limit and offset and order
65 graphCorpusDocSearch :: CorpusId -> Text -> O.Query (Column PGInt4, Column PGJsonb)
66 graphCorpusDocSearch cId t = proc () -> do
67 (n, nn) <- graphCorpusDocSearchQuery -< ()
68 restrict -< (_ns_search n) @@ (pgTSQuery (unpack t))
69 restrict -< ( nodeNode_node1_id nn) .== (toNullable $ pgInt4 cId)
70 restrict -< (_ns_typename n) .== (pgInt4 $ nodeTypeId NodeDocument)
71 returnA -< (_ns_id n, _ns_hyperdata n)
73 graphCorpusDocSearchQuery :: O.Query (NodeSearchRead, NodeNodeReadNull)
74 graphCorpusDocSearchQuery = leftJoin queryNodeSearchTable queryNodeNodeTable cond
76 cond :: (NodeSearchRead, NodeNodeRead) -> Column PGBool
77 cond (n, nn) = nodeNode_node1_id nn .== _ns_id n
94 -- | TODO [""] -> panic "error"
95 toTSQuery :: [Text] -> TSQuery
96 toTSQuery txt = UnsafeTSQuery txt
99 instance IsString TSQuery
101 fromString = UnsafeTSQuery . words . cs
104 instance ToField TSQuery
106 toField (UnsafeTSQuery xs)
107 = Many $ intersperse (Plain " && ")
108 $ map (\q -> Many [ Plain "plainto_tsquery("
114 data Order = Asc | Desc
116 instance ToField Order
118 toField Asc = Plain "ASC"
119 toField Desc = Plain "DESC"
125 textSearchQuery :: Query
126 textSearchQuery = "SELECT n.id, n.hyperdata->'publication_year' \
127 \ , n.hyperdata->'title' \
128 \ , n.hyperdata->'source' \
129 \ , n.hyperdata->'authors' \
130 \ , COALESCE(nn.score,null) \
132 \ LEFT JOIN nodes_nodes nn ON nn.node2_id = n.id \
134 \ n.search @@ (?::tsquery) \
135 \ AND (n.parent_id = ? OR nn.node1_id = ?) \
136 \ AND n.typename = ? \
137 \ ORDER BY n.hyperdata -> 'publication_date' ? \
140 -- | Text Search Function for Master Corpus
141 -- TODO : text search for user corpus
143 -- textSearchTest :: ParentId -> TSQuery -> Cmd [(Int, Value, Value, Value, Value, Maybe Int)]
144 -- textSearchTest pId q = mkCmd $ \c -> textSearch c q pId 5 0 Asc
145 textSearch :: Connection
146 -> TSQuery -> ParentId
147 -> Limit -> Offset -> Order
148 -> IO [(Int,Value,Value,Value, Value, Maybe Int)]
149 textSearch conn q p l o ord = query conn textSearchQuery (q,p,p,typeId,ord,o,l)
151 typeId = nodeTypeId NodeDocument