src/Gargantext/Database/Action/Search.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 {-# LANGUAGE Arrows            #-}
  12
  13 module Gargantext.Database.Action.Search where
  14
  15 import Control.Arrow (returnA)
  16 import Control.Lens ((^.))
  17 import Data.Maybe
  18 import Data.Text (Text, unpack, intercalate)
  19 import Data.Time (UTCTime)
  20 import Gargantext.Core
  21 import Gargantext.Core.Types
  22 import Gargantext.Database.Admin.Types.Hyperdata (HyperdataDocument(..), HyperdataContact(..))
  23 import Gargantext.Database.Prelude (Cmd, runOpaQuery, runCountOpaQuery)
  24 import Gargantext.Database.Query.Facet
  25 import Gargantext.Database.Query.Filter
  26 import Gargantext.Database.Query.Join (leftJoin5)
  27 import Gargantext.Database.Query.Table.Node
  28 import Gargantext.Database.Query.Table.NodeNode
  29 import Gargantext.Database.Schema.Node
  30 import Gargantext.Prelude
  31 import Gargantext.Core.Text.Terms.Mono.Stem.En (stemIt)
  32 import Opaleye hiding (Query, Order)
  33 import Data.Profunctor.Product (p4)
  34 import qualified Opaleye as O hiding (Order)
  35
  36 ------------------------------------------------------------------------
  37 searchDocInDatabase :: HasDBid NodeType
  38                     => ParentId
  39                     -> Text
  40                     -> Cmd err [(NodeId, HyperdataDocument)]
  41 searchDocInDatabase _p t = runOpaQuery (queryDocInDatabase t)
  42   where
  43     -- | Global search query where ParentId is Master Node Corpus Id
  44     queryDocInDatabase :: Text -> O.Query (Column PGInt4, Column PGJsonb)
  45     queryDocInDatabase q = proc () -> do
  46         row <- queryNodeSearchTable -< ()
  47         restrict -< (_ns_search row)    @@ (pgTSQuery (unpack q))
  48         restrict -< (_ns_typename row) .== (sqlInt4 $ toDBid NodeDocument)
  49         returnA  -< (_ns_id row, _ns_hyperdata row)
  50
  51 ------------------------------------------------------------------------
  52 -- | todo add limit and offset and order
  53 searchInCorpus :: HasDBid NodeType
  54                => CorpusId
  55                -> IsTrash
  56                -> [Text]
  57                -> Maybe Offset
  58                -> Maybe Limit
  59                -> Maybe OrderBy
  60                -> Cmd err [FacetDoc]
  61 searchInCorpus cId t q o l order = runOpaQuery
  62                                  $ filterWith o l order
  63                                  $ queryInCorpus cId t
  64                                  $ intercalate " | "
  65                                  $ map stemIt q
  66
  67 searchCountInCorpus :: HasDBid NodeType
  68                     => CorpusId
  69                     -> IsTrash
  70                     -> [Text]
  71                     -> Cmd err Int
  72 searchCountInCorpus cId t q = runCountOpaQuery
  73                             $ queryInCorpus cId t
  74                             $ intercalate " | "
  75                             $ map stemIt q
  76
  77 queryInCorpus :: HasDBid NodeType
  78               => CorpusId
  79               -> IsTrash
  80               -> Text
  81               -> O.Query FacetDocRead
  82 queryInCorpus cId t q = proc () -> do
  83   (n, nn) <- joinInCorpus -< ()
  84   restrict -< (nn^.nn_node1_id) .== (toNullable $ pgNodeId cId)
  85   restrict -< if t
  86                  then (nn^.nn_category) .== (toNullable $ sqlInt4 0)
  87                  else (nn^.nn_category) .>= (toNullable $ sqlInt4 1)
  88   restrict -< (n ^. ns_search)           @@ (pgTSQuery (unpack q))
  89   restrict -< (n ^. ns_typename )       .== (sqlInt4 $ toDBid NodeDocument)
  90   returnA  -< FacetDoc (n^.ns_id        )
  91                        (n^.ns_date      )
  92                        (n^.ns_name      )
  93                        (n^.ns_hyperdata )
  94                        (nn^.nn_category )
  95                        (nn^.nn_score    )
  96                        (nn^.nn_score    )
  97
  98 joinInCorpus :: O.Query (NodeSearchRead, NodeNodeReadNull)
  99 joinInCorpus = leftJoin queryNodeSearchTable queryNodeNodeTable cond
 100   where
 101     cond :: (NodeSearchRead, NodeNodeRead) -> Column PGBool
 102     cond (n, nn) = nn^.nn_node2_id .== _ns_id n
 103
 104 ------------------------------------------------------------------------
 105 searchInCorpusWithContacts
 106   :: HasDBid NodeType
 107   => CorpusId
 108   -> AnnuaireId
 109   -> [Text]
 110   -> Maybe Offset
 111   -> Maybe Limit
 112   -> Maybe OrderBy
 113   -> Cmd err [FacetPaired Int UTCTime HyperdataContact Int]
 114 searchInCorpusWithContacts cId aId q o l _order =
 115   runOpaQuery $ limit'   l
 116               $ offset'  o
 117               $ orderBy ( desc _fp_score)
 118               $ selectGroup cId aId
 119               $ intercalate " | "
 120               $ map stemIt q
 121
 122 selectContactViaDoc
 123   :: HasDBid NodeType
 124   => CorpusId
 125   -> AnnuaireId
 126   -> Text
 127   -> QueryArr ()
 128               ( Column (Nullable PGInt4)
 129               , Column (Nullable PGTimestamptz)
 130               , Column (Nullable PGJsonb)
 131               , Column (Nullable PGInt4)
 132               )
 133 selectContactViaDoc cId aId q = proc () -> do
 134   (doc, (corpus_doc, (_contact_doc, (annuaire_contact, contact)))) <- queryContactViaDoc -< ()
 135   restrict -< (doc^.ns_search)           @@ (pgTSQuery  $ unpack q  )
 136   restrict -< (doc^.ns_typename)        .== (sqlInt4 $ toDBid NodeDocument)
 137   restrict -< (corpus_doc^.nn_node1_id)  .== (toNullable $ pgNodeId cId)
 138   restrict -< (annuaire_contact^.nn_node1_id) .== (toNullable $ pgNodeId aId)
 139   restrict -< (contact^.node_typename)        .== (toNullable $ sqlInt4 $ toDBid NodeContact)
 140   returnA  -< ( contact^.node_id
 141               , contact^.node_date
 142               , contact^.node_hyperdata
 143               , toNullable $ sqlInt4 1
 144               )
 145
 146 selectGroup :: HasDBid NodeType
 147             => NodeId
 148             -> NodeId
 149             -> Text
 150             -> Select FacetPairedReadNull
 151 selectGroup cId aId q = proc () -> do
 152   (a, b, c, d) <- aggregate (p4 (groupBy, groupBy, groupBy, O.sum))
 153                             (selectContactViaDoc cId aId q) -< ()
 154   returnA -< FacetPaired a b c d
 155
 156
 157 queryContactViaDoc :: O.Query ( NodeSearchRead
 158                               , ( NodeNodeReadNull
 159                                 , ( NodeNodeReadNull
 160                                   , ( NodeNodeReadNull
 161                                     , NodeReadNull
 162                                     )
 163                                   )
 164                                 )
 165                               )
 166 queryContactViaDoc =
 167   leftJoin5
 168   queryNodeTable
 169   queryNodeNodeTable
 170   queryNodeNodeTable
 171   queryNodeNodeTable
 172   queryNodeSearchTable
 173   cond12
 174   cond23
 175   cond34
 176   cond45
 177     where
 178       cond12 :: (NodeNodeRead, NodeRead) -> Column PGBool
 179       cond12 (annuaire_contact, contact) = contact^.node_id .== annuaire_contact^.nn_node2_id
 180
 181       cond23 :: ( NodeNodeRead
 182                 , ( NodeNodeRead
 183                   , NodeReadNull
 184                   )
 185                 ) -> Column PGBool
 186       cond23 (contact_doc, (annuaire_contact, _)) = contact_doc^.nn_node1_id .== annuaire_contact^.nn_node2_id
 187
 188       cond34 :: ( NodeNodeRead
 189                 , ( NodeNodeRead
 190                   , ( NodeNodeReadNull
 191                     , NodeReadNull
 192                     )
 193                   )
 194                 ) -> Column PGBool
 195       cond34 (corpus_doc, (contact_doc, (_,_))) =  corpus_doc^.nn_node2_id .== contact_doc^.nn_node2_id
 196
 197
 198       cond45 :: ( NodeSearchRead
 199                 , ( NodeNodeRead
 200                   , ( NodeNodeReadNull
 201                     , ( NodeNodeReadNull
 202                       , NodeReadNull
 203                       )
 204                     )
 205                   )
 206                 ) -> Column PGBool
 207       cond45 (doc, (corpus_doc, (_,(_,_)))) = doc^.ns_id .== corpus_doc^.nn_node2_id
 208
 209
 210 ------------------------------------------------------------------------