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 import Gargantext.Database.Config (nodeTypeId)
  27 import Gargantext.Database.Types.Node (NodeType(..))
  28 import Gargantext.Prelude
  29
  30 newtype TSQuery = UnsafeTSQuery [Text]
  31
  32 -- | TODO [""] -> panic "error"
  33 toTSQuery :: [Text] -> TSQuery
  34 toTSQuery txt = UnsafeTSQuery txt
  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_year'     \
  67 \                   , n.hyperdata->'title'                          \
  68 \                   , n.hyperdata->'source'                         \
  69 \                   , n.hyperdata->'authors'                        \
  70 \                   , COALESCE(nn.score,null)                       \
  71 \                      FROM nodes n                                 \
  72 \            LEFT JOIN nodes_nodes nn  ON nn.node2_id = n.id        \
  73 \              WHERE                                                \
  74 \                n.search @@ (?::tsquery)                           \
  75 \                AND (n.parent_id = ? OR nn.node1_id = ?)           \
  76 \                AND n.typename  = ?                                \
  77 \                ORDER BY n.hyperdata -> 'publication_date' ?       \
  78 \            offset ? limit ?;"
  79
  80 -- | Text Search Function for Master Corpus
  81 -- TODO : text search for user corpus
  82 -- Example:
  83 -- textSearchTest :: ParentId -> TSQuery -> Cmd [(Int, Value, Value, Value, Value, Maybe Int)]
  84 -- textSearchTest pId q = mkCmd $ \c -> textSearch c q pId 5 0 Asc
  85 textSearch :: Connection
  86            -> TSQuery -> ParentId
  87            -> Limit -> Offset -> Order
  88            -> IO [(Int,Value,Value,Value, Value, Maybe Int)]
  89 textSearch conn q p l o ord = query conn textSearchQuery (q,p,p,typeId,ord,o,l)
  90   where
  91     typeId = nodeTypeId NodeDocument
  92
  93