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