src/Gargantext/Database/Query/Facet.hs

   1 {-|
   2 Module      : Gargantext.Database.Query.Facet
   3 Description : Main requests of Node to the database
   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 {-# LANGUAGE FunctionalDependencies    #-}
  13 {-# LANGUAGE QuasiQuotes               #-}
  14 {-# LANGUAGE NoMonomorphismRestriction #-}
  15 {-# LANGUAGE TemplateHaskell           #-}
  16 {-# LANGUAGE TypeFamilies              #-}
  17 ------------------------------------------------------------------------
  18 module Gargantext.Database.Query.Facet
  19   ( runViewAuthorsDoc
  20   , runViewDocuments
  21 --   , viewDocuments'
  22   , runCountDocuments
  23   , filterWith
  24
  25   , Category
  26   , Score
  27   , Title
  28
  29   , Pair(..)
  30   , Facet(..)
  31   , FacetDoc
  32   , FacetDocRead
  33   , FacetPaired(..)
  34   , FacetPairedRead
  35   , FacetPairedReadNull
  36   , FacetPairedReadNullAgg
  37   , OrderBy(..)
  38   )
  39   where
  40
  41 import Control.Arrow (returnA, (>>>))
  42 import Control.Lens ((^.))
  43 import qualified Data.Text as T
  44 import Opaleye
  45 import Protolude hiding (null, map, sum, not)
  46 import qualified Opaleye.Internal.Unpackspec()
  47
  48 import Gargantext.Core
  49 import Gargantext.Core.Types
  50 import Gargantext.Database.Query.Filter
  51 import Gargantext.Database.Query.Join (leftJoin5)
  52 import Gargantext.Database.Query.Table.Ngrams
  53 import Gargantext.Database.Query.Table.Context
  54 import Gargantext.Database.Query.Facet.Types
  55 import Gargantext.Database.Query.Table.ContextNodeNgrams
  56 import Gargantext.Database.Query.Table.NodeContext (queryNodeContextTable)
  57 import Gargantext.Database.Prelude
  58 import Gargantext.Database.Schema.Context
  59 import Gargantext.Database.Schema.Node
  60 import Gargantext.Database.Schema.NodeContext
  61 import Gargantext.Prelude (printDebug)
  62
  63 ------------------------------------------------------------------------
  64
  65
  66 -- TODO-SECURITY check
  67 runViewAuthorsDoc :: HasDBid NodeType
  68                   => ContactId
  69                   -> IsTrash
  70                   -> Maybe Offset
  71                   -> Maybe Limit
  72                   -> Maybe OrderBy
  73                   -> Cmd err [FacetDoc]
  74 runViewAuthorsDoc cId t o l order = runOpaQuery $ filterWith o l order $ viewAuthorsDoc cId t ntId
  75   where
  76     ntId = NodeDocument
  77
  78 -- TODO add delete ?
  79 viewAuthorsDoc :: HasDBid NodeType
  80                => ContactId
  81                -> IsTrash
  82                -> NodeType
  83                -> Select FacetDocRead
  84 viewAuthorsDoc cId _ nt = proc () -> do
  85   (doc,(_,(_,(_,contact')))) <- queryAuthorsDoc      -< ()
  86
  87   restrict -< _node_id   contact'  .== (toNullable $ pgNodeId cId)
  88   restrict -< _node_typename doc   .== (sqlInt4 $ toDBid nt)
  89
  90   returnA  -< FacetDoc { facetDoc_id         = _node_id        doc
  91                        , facetDoc_created    = _node_date      doc
  92                        , facetDoc_title      = _node_name      doc
  93                        , facetDoc_hyperdata  = _node_hyperdata doc
  94                        , facetDoc_category   = toNullable $ sqlInt4 1
  95                        , facetDoc_ngramCount = toNullable $ sqlDouble 1
  96                        , facetDoc_score      = toNullable $ sqlDouble 1 }
  97
  98 queryAuthorsDoc :: Select (NodeRead, (ContextNodeNgramsReadNull, (NgramsReadNull, (ContextNodeNgramsReadNull, NodeReadNull))))
  99 queryAuthorsDoc = leftJoin5 queryNodeTable queryContextNodeNgramsTable queryNgramsTable queryContextNodeNgramsTable queryNodeTable cond12 cond23 cond34 cond45
 100     where
 101          cond12 :: (ContextNodeNgramsRead, NodeRead) -> Column SqlBool
 102          cond12 (nodeNgram, doc) =  _node_id doc
 103                                 .== _cnng_context_id nodeNgram
 104
 105          cond23 :: (NgramsRead, (ContextNodeNgramsRead, NodeReadNull)) -> Column SqlBool
 106          cond23 (ngrams', (nodeNgram, _)) =  ngrams'^.ngrams_id
 107                                         .== _cnng_ngrams_id nodeNgram
 108
 109          cond34 :: (ContextNodeNgramsRead, (NgramsRead, (ContextNodeNgramsReadNull, NodeReadNull))) -> Column SqlBool
 110          cond34 (nodeNgram2, (ngrams', (_,_)))= ngrams'^.ngrams_id .== _cnng_ngrams_id       nodeNgram2
 111
 112          cond45 :: (NodeRead, (ContextNodeNgramsRead, (NgramsReadNull, (ContextNodeNgramsReadNull, NodeReadNull)))) -> Column SqlBool
 113          cond45 (contact', (nodeNgram2', (_, (_,_)))) = _node_id  contact'  .== _cnng_context_id         nodeNgram2'
 114
 115
 116 ------------------------------------------------------------------------
 117 -- TODO-SECURITY check
 118 runViewDocuments :: HasDBid NodeType
 119                  => CorpusId
 120                  -> IsTrash
 121                  -> Maybe Offset
 122                  -> Maybe Limit
 123                  -> Maybe OrderBy
 124                  -> Maybe Text
 125                  -> Maybe Text
 126                  -> Cmd err [FacetDoc]
 127 runViewDocuments cId t o l order query year = do
 128     printDebug "[runViewDocuments] sqlQuery" $ showSql sqlQuery
 129     runOpaQuery $ filterWith o l order sqlQuery
 130   where
 131     sqlQuery = viewDocuments cId t (toDBid NodeDocument) query year
 132
 133 runCountDocuments :: HasDBid NodeType => CorpusId -> IsTrash -> Maybe Text -> Maybe Text -> Cmd err Int
 134 runCountDocuments cId t mQuery mYear = do
 135   runCountOpaQuery sqlQuery
 136   where
 137     sqlQuery = viewDocuments cId t (toDBid NodeDocument) mQuery mYear
 138
 139
 140 viewDocuments :: CorpusId
 141               -> IsTrash
 142               -> NodeTypeId
 143               -> Maybe Text
 144               -> Maybe Text
 145               -> Select FacetDocRead
 146 viewDocuments cId t ntId mQuery mYear = viewDocumentsQuery cId t ntId mQuery mYear >>> proc (c, nc) -> do
 147   returnA  -< FacetDoc { facetDoc_id         = _cs_id        c
 148                        , facetDoc_created    = _cs_date      c
 149                        , facetDoc_title      = _cs_name      c
 150                        , facetDoc_hyperdata  = _cs_hyperdata c
 151                        , facetDoc_category   = toNullable $ nc^.nc_category
 152                        , facetDoc_ngramCount = toNullable $ nc^.nc_score
 153                        , facetDoc_score      = toNullable $ nc^.nc_score
 154                        }
 155
 156 viewDocumentsQuery :: CorpusId
 157                    -> IsTrash
 158                    -> NodeTypeId
 159                    -> Maybe Text
 160                    -> Maybe Text
 161                    -> Select (ContextSearchRead, NodeContextRead)
 162 viewDocumentsQuery cId t ntId mQuery mYear = proc () -> do
 163   c  <- queryContextSearchTable -< ()
 164   nc <- queryNodeContextTable   -< ()
 165   restrict -< c^.cs_id         .== nc^.nc_context_id
 166   restrict -< nc^.nc_node_id   .== (pgNodeId cId)
 167   restrict -< c^.cs_typename   .== (sqlInt4 ntId)
 168   restrict -< if t then nc^.nc_category .== (sqlInt4 0)
 169                    else nc^.nc_category .>= (sqlInt4 1)
 170
 171   let
 172     query         = (fromMaybe "" mQuery)
 173     year          = (fromMaybe "" mYear)
 174     iLikeQuery    = T.intercalate "" ["%", query, "%"]
 175     abstractLHS h = fromNullable (sqlStrictText "")
 176                   $ toNullable h .->> (sqlStrictText "abstract")
 177     yearLHS h     = fromNullable (sqlStrictText "")
 178                   $ toNullable h .->> (sqlStrictText "publication_year")
 179
 180   restrict -<
 181     if query == "" then sqlBool True
 182       else  ((c^.cs_name) `ilike` (sqlStrictText iLikeQuery))
 183         .|| ((abstractLHS (c^.cs_hyperdata)) `ilike` (sqlStrictText iLikeQuery))
 184   restrict -<
 185     if year == "" then sqlBool True
 186       else (yearLHS (c^.cs_hyperdata)) .== (sqlStrictText year)
 187
 188   returnA -< (c, nc)
 189
 190
 191 ------------------------------------------------------------------------
 192 filterWith :: (SqlOrd date, SqlOrd title, SqlOrd category, SqlOrd score, hyperdata ~ Column SqlJsonb) =>
 193         Maybe Gargantext.Core.Types.Offset
 194      -> Maybe Gargantext.Core.Types.Limit
 195      -> Maybe OrderBy
 196      -> Select (Facet id (Column date) (Column title) hyperdata (Column category) ngramCount (Column score))
 197      -> Select (Facet id (Column date) (Column title) hyperdata (Column category) ngramCount (Column score))
 198 filterWith o l order q = limit' l $ offset' o $ orderBy (orderWith order) q
 199
 200
 201 orderWith :: (SqlOrd b1, SqlOrd b2, SqlOrd b3, SqlOrd b4)
 202           => Maybe OrderBy
 203           -> Order (Facet id (Column b1) (Column b2) (Column SqlJsonb) (Column b3) ngramCount (Column b4))
 204 orderWith (Just DateAsc)   = asc  facetDoc_created
 205 orderWith (Just DateDesc)  = desc facetDoc_created
 206
 207 orderWith (Just TitleAsc)  = asc  facetDoc_title
 208 orderWith (Just TitleDesc) = desc facetDoc_title
 209
 210 orderWith (Just ScoreAsc)  = asc  facetDoc_score
 211 orderWith (Just ScoreDesc) = descNullsLast facetDoc_score
 212
 213 orderWith (Just SourceAsc)  = asc  facetDoc_source
 214 orderWith (Just SourceDesc) = desc facetDoc_source
 215
 216 orderWith (Just TagAsc)     = asc  facetDoc_category
 217 orderWith (Just TagDesc)    = desc facetDoc_category
 218
 219 orderWith _                = asc facetDoc_created
 220
 221 facetDoc_source :: SqlIsJson a
 222                 => Facet id created title (Column a) favorite ngramCount score
 223                 -> Column (Nullable SqlText)
 224 facetDoc_source x = toNullable (facetDoc_hyperdata x) .->> sqlString "source"