]> Git — Sourcephile - gargantext.git/blob - src/Gargantext/Database/TextSearch.hs
[FEAT] grouping ngrams better written (simplified) with semigroup. TODO: update the...
[gargantext.git] / src / Gargantext / Database / TextSearch.hs
1 {-|
2 Module : Gargantext.Database.TextSearch
3 Description :
4 Copyright : (c) CNRS, 2017-Present
5 License : AGPL + CECILL v3
6 Maintainer : team@gargantext.org
7 Stability : experimental
8 Portability : POSIX
9
10 Here is a longer description of this module, containing some
11 commentary with @some markup@.
12 -}
13
14 {-# LANGUAGE NoImplicitPrelude #-}
15 {-# LANGUAGE OverloadedStrings #-}
16
17 module Gargantext.Database.TextSearch where
18
19 import Prelude (print)
20
21 import Control.Monad
22
23 import Data.Aeson
24 import Data.List (intersperse)
25 import Data.String (IsString(..))
26 import Data.Text (Text, words)
27
28 import Database.PostgreSQL.Simple
29 import Database.PostgreSQL.Simple.ToField
30
31 import Gargantext (connectGargandb)
32 import Gargantext.Prelude
33
34 newtype TSQuery = UnsafeTSQuery [Text]
35
36 instance IsString TSQuery
37 where
38 fromString = UnsafeTSQuery . words . cs
39
40
41 instance ToField TSQuery
42 where
43 toField (UnsafeTSQuery xs)
44 = Many $ intersperse (Plain " && ")
45 $ map (\q -> Many [ Plain "plainto_tsquery("
46 , Escape (cs q)
47 , Plain ")"
48 ]
49 ) xs
50
51 type ParentId = Int
52 type Limit = Int
53 type Offset = Int
54 data Order = Asc | Desc
55
56 instance ToField Order
57 where
58 toField Asc = Plain "ASC"
59 toField Desc = Plain "DESC"
60
61 -- TODO
62 -- FIX fav
63 -- ADD ngrams count
64 -- TESTS
65 textSearchQuery :: Query
66 textSearchQuery = "SELECT n.id, n.hyperdata->'publication_date' \
67 \ , n.hyperdata->'title' \
68 \ , n.hyperdata->'source' \
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.title_abstract @@ (?::tsquery) \
74 \ AND n.parent_id = ? AND n.typename = 4 \
75 \ ORDER BY n.hyperdata -> 'publication_date' ? \
76 \ offset ? limit ?;"
77
78
79 textSearch :: Connection
80 -> TSQuery -> ParentId
81 -> Limit -> Offset -> Order
82 -> IO [(Int,Value,Value,Value, Maybe Int)]
83 textSearch conn q p l o ord = query conn textSearchQuery (q,p,ord, o,l)
84
85 textSearchTest :: TSQuery -> IO ()
86 textSearchTest q = connectGargandb "gargantext.ini"
87 >>= \conn -> textSearch conn q 421968 10 0 Asc
88 >>= mapM_ print