]> Git — Sourcephile - gargantext.git/blob - src/Gargantext/Database/Action/TSQuery.hs
[MERGE] Phylo
[gargantext.git] / src / Gargantext / Database / Action / TSQuery.hs
1 module Gargantext.Database.Action.TSQuery where
2
3 import Data.Aeson
4 import Data.List (intersperse)
5 import Data.Maybe
6 import Data.String (IsString(..))
7 import Data.Text (Text, words)
8 import Database.PostgreSQL.Simple (Query)
9 import Database.PostgreSQL.Simple.ToField
10 import Gargantext.Core
11 import Gargantext.Core.Types
12 import Gargantext.Core.Types.Query (Limit, Offset)
13 import Gargantext.Database.Prelude (Cmd, runPGSQuery)
14 import Gargantext.Prelude
15 import Gargantext.Core.Text.Terms.Mono.Stem.En (stemIt)
16
17
18 newtype TSQuery = UnsafeTSQuery [Text]
19
20 -- | TODO [""] -> panic "error"
21 toTSQuery :: [Text] -> TSQuery
22 toTSQuery txt = UnsafeTSQuery $ map stemIt txt
23
24
25 instance IsString TSQuery
26 where
27 fromString = UnsafeTSQuery . words . cs
28
29
30 instance ToField TSQuery
31 where
32 toField (UnsafeTSQuery xs)
33 = Many $ intersperse (Plain " && ")
34 $ map (\q -> Many [ Plain "plainto_tsquery("
35 , Escape (cs q)
36 , Plain ")"
37 ]
38 ) xs
39
40 data Order = Asc | Desc
41
42 instance ToField Order
43 where
44 toField Asc = Plain "ASC"
45 toField Desc = Plain "DESC"
46
47 -- TODO
48 -- FIX fav
49 -- ADD ngrams count
50 -- TESTS
51 textSearchQuery :: Query
52 textSearchQuery = "SELECT n.id, n.hyperdata->'publication_year' \
53 \ , n.hyperdata->'title' \
54 \ , n.hyperdata->'source' \
55 \ , n.hyperdata->'authors' \
56 \ , COALESCE(nn.score,null) \
57 \ FROM nodes n \
58 \ LEFT JOIN nodes_nodes nn ON nn.node2_id = n.id \
59 \ WHERE \
60 \ n.search @@ (?::tsquery) \
61 \ AND (n.parent_id = ? OR nn.node1_id = ?) \
62 \ AND n.typename = ? \
63 \ ORDER BY n.hyperdata -> 'publication_date' ? \
64 \ offset ? limit ?;"
65
66 -- | Text Search Function for Master Corpus
67 -- TODO : text search for user corpus
68 -- Example:
69 -- textSearchTest :: ParentId -> TSQuery -> Cmd err [(Int, Value, Value, Value, Value, Maybe Int)]
70 -- textSearchTest pId q = textSearch q pId 5 0 Asc
71 textSearch :: HasDBid NodeType
72 => TSQuery -> ParentId
73 -> Limit -> Offset -> Order
74 -> Cmd err [(Int,Value,Value,Value, Value, Maybe Int)]
75 textSearch q p l o ord = runPGSQuery textSearchQuery (q,p,p,typeId,ord,o,l)
76 where
77 typeId = toDBid NodeDocument