]> Git — Sourcephile - gargantext.git/blob - src/Gargantext/Database/TextSearch.hs
[Annuaire] Flow insertion ok, needs to fix API.
[gargantext.git] / src / Gargantext / Database / TextSearch.hs
1 {-|
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
8 Portability : POSIX
9
10
11 -}
12
13 {-# LANGUAGE NoImplicitPrelude #-}
14 {-# LANGUAGE OverloadedStrings #-}
15
16 module Gargantext.Database.TextSearch where
17
18
19 import Data.Aeson
20 import Data.List (intersperse)
21 import Data.String (IsString(..))
22 import Data.Text (Text, words)
23
24 import Database.PostgreSQL.Simple
25 import Database.PostgreSQL.Simple.ToField
26
27 import Gargantext.Prelude
28
29 newtype TSQuery = UnsafeTSQuery [Text]
30
31 -- | TODO [""] -> panic "error"
32 toTSQuery :: [Text] -> TSQuery
33 toTSQuery txt = UnsafeTSQuery txt
34
35 instance IsString TSQuery
36 where
37 fromString = UnsafeTSQuery . words . cs
38
39
40 instance ToField TSQuery
41 where
42 toField (UnsafeTSQuery xs)
43 = Many $ intersperse (Plain " && ")
44 $ map (\q -> Many [ Plain "plainto_tsquery("
45 , Escape (cs q)
46 , Plain ")"
47 ]
48 ) xs
49
50 type ParentId = Int
51 type Limit = Int
52 type Offset = Int
53 data Order = Asc | Desc
54
55 instance ToField Order
56 where
57 toField Asc = Plain "ASC"
58 toField Desc = Plain "DESC"
59
60 -- TODO
61 -- FIX fav
62 -- ADD ngrams count
63 -- TESTS
64 textSearchQuery :: Query
65 textSearchQuery = "SELECT n.id, n.hyperdata->'publication_year' \
66 \ , n.hyperdata->'title' \
67 \ , n.hyperdata->'source' \
68 \ , n.hyperdata->'authors' \
69 \ , COALESCE(nn.score,null) \
70 \ FROM nodes n \
71 \ LEFT JOIN nodes_nodes nn ON nn.node2_id = n.id \
72 \ WHERE \
73 \ n.search @@ (?::tsquery) \
74 \ AND n.parent_id = ? AND n.typename = 4 \
75 \ ORDER BY n.hyperdata -> 'publication_date' ? \
76 \ offset ? limit ?;"
77
78 -- | Text Search Function for Master Corpus
79 -- TODO : text search for user corpus
80 -- Example:
81 -- textSearchTest :: ParentId -> TSQuery -> Cmd [(Int, Value, Value, Value, Value, Maybe Int)]
82 -- textSearchTest pId q = mkCmd $ \c -> textSearch c q pId 5 0 Asc
83 textSearch :: Connection
84 -> TSQuery -> ParentId
85 -> Limit -> Offset -> Order
86 -> IO [(Int,Value,Value,Value, Value, Maybe Int)]
87 textSearch conn q p l o ord = query conn textSearchQuery (q,p,ord, o,l)
88
89