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   , OrderBy(..)
  36   )
  37   where
  38
  39 import Control.Arrow (returnA)
  40 import Control.Lens ((^.))
  41 import qualified Data.Text as T
  42 import Opaleye
  43 import Protolude hiding (null, map, sum, not)
  44 import qualified Opaleye.Internal.Unpackspec()
  45
  46 import Gargantext.Core
  47 import Gargantext.Core.Types
  48 import Gargantext.Database.Query.Filter
  49 import Gargantext.Database.Query.Table.Ngrams
  50 import Gargantext.Database.Query.Table.Context
  51 import Gargantext.Database.Query.Facet.Types
  52 import Gargantext.Database.Query.Table.ContextNodeNgrams
  53 import Gargantext.Database.Query.Table.NodeContext (queryNodeContextTable)
  54 import Gargantext.Database.Prelude
  55 import Gargantext.Database.Schema.Context
  56 import Gargantext.Database.Schema.Node
  57 import Gargantext.Database.Schema.NodeContext
  58 -- import Gargantext.Prelude (printDebug)
  59
  60 ------------------------------------------------------------------------
  61
  62
  63 -- TODO-SECURITY check
  64 runViewAuthorsDoc :: HasDBid NodeType
  65                   => ContactId
  66                   -> IsTrash
  67                   -> Maybe Offset
  68                   -> Maybe Limit
  69                   -> Maybe OrderBy
  70                   -> Cmd err [FacetDoc]
  71 runViewAuthorsDoc cId t o l order = runOpaQuery $ filterWith o l order $ viewAuthorsDoc cId t ntId
  72   where
  73     ntId = NodeDocument
  74
  75 -- TODO add delete ?
  76 viewAuthorsDoc :: HasDBid NodeType
  77                => ContactId
  78                -> IsTrash
  79                -> NodeType
  80                -> Select FacetDocRead
  81 viewAuthorsDoc cId _ nt = proc () -> do
  82   --(doc,(_,(_,(_,contact')))) <- queryAuthorsDoc      -< ()
  83   (doc, _, _, _, contact') <- queryAuthorsDoc -< ()
  84
  85   restrict -< fromMaybeFields (sqlInt4 $ -1) (_node_id <$> contact')  .=== pgNodeId cId
  86   restrict -< _node_typename doc   .== sqlInt4 (toDBid nt)
  87
  88   returnA  -< FacetDoc { facetDoc_id         = _node_id        doc
  89                        , facetDoc_created    = _node_date      doc
  90                        , facetDoc_title      = _node_name      doc
  91                        , facetDoc_hyperdata  = _node_hyperdata doc
  92                        , facetDoc_category   = toNullable $ sqlInt4 1
  93                        , facetDoc_ngramCount = toNullable $ sqlDouble 1.0
  94                        , facetDoc_score      = toNullable $ sqlDouble 1 }
  95
  96 queryAuthorsDoc :: Select ( NodeRead
  97                           , MaybeFields ContextNodeNgramsRead
  98                           , MaybeFields NgramsRead
  99                           , MaybeFields ContextNodeNgramsRead
 100                           , MaybeFields NodeRead)
 101 queryAuthorsDoc = proc () -> do
 102   n <- queryNodeTable -< ()
 103   cnn <- optionalRestrict queryContextNodeNgramsTable -<
 104     \cnn' -> _node_id n .== _cnng_context_id cnn'
 105   ng <- optionalRestrict queryNgramsTable -<
 106     \ng' -> justFields (ng' ^. ngrams_id) .=== (_cnng_ngrams_id <$> cnn)
 107   cnn2 <- optionalRestrict queryContextNodeNgramsTable -<
 108     \cnn2' -> (_ngrams_id <$> ng) .=== justFields (_cnng_ngrams_id cnn2')
 109   contact <- optionalRestrict queryNodeTable -<
 110     \contact' -> justFields (_node_id contact') .=== (_cnng_context_id <$> cnn2)
 111
 112   returnA -< (n, cnn, ng, cnn2, contact)
 113
 114
 115 ------------------------------------------------------------------------
 116 -- TODO-SECURITY check
 117 runViewDocuments :: HasDBid NodeType
 118                  => CorpusId
 119                  -> IsTrash
 120                  -> Maybe Offset
 121                  -> Maybe Limit
 122                  -> Maybe OrderBy
 123                  -> Maybe Text
 124                  -> Maybe Text
 125                  -> Cmd err [FacetDoc]
 126 runViewDocuments cId t o l order query year = do
 127     -- printDebug "[runViewDocuments] sqlQuery" $ showSql sqlQuery
 128     runOpaQuery $ filterWith o l order sqlQuery
 129   where
 130     sqlQuery = viewDocuments cId t (toDBid NodeDocument) query year
 131
 132 runCountDocuments :: HasDBid NodeType => CorpusId -> IsTrash -> Maybe Text -> Maybe Text -> Cmd err Int
 133 runCountDocuments cId t mQuery mYear = do
 134   runCountOpaQuery sqlQuery
 135   where
 136     sqlQuery = viewDocuments cId t (toDBid NodeDocument) mQuery mYear
 137
 138
 139 viewDocuments :: CorpusId
 140               -> IsTrash
 141               -> NodeTypeId
 142               -> Maybe Text
 143               -> Maybe Text
 144               -> Select FacetDocRead
 145 viewDocuments cId t ntId mQuery mYear = proc () -> do
 146   (c, nc) <- viewDocumentsQuery cId t ntId mQuery mYear -< ()
 147   -- ngramCountAgg <- aggregate sumInt4 -< cnng
 148   returnA  -< FacetDoc { facetDoc_id         = _cs_id        c
 149                        , facetDoc_created    = _cs_date      c
 150                        , facetDoc_title      = _cs_name      c
 151                        , facetDoc_hyperdata  = _cs_hyperdata c
 152                        , facetDoc_category   = toNullable $ nc^.nc_category
 153                        , facetDoc_ngramCount = toNullable $ nc^.nc_score
 154                        , facetDoc_score      = toNullable $ nc^.nc_score
 155                        }
 156
 157 -- TODO Join with context_node_ngrams at context_id/node_id and sum by
 158 -- doc_count.
 159 viewDocumentsQuery :: CorpusId
 160                    -> IsTrash
 161                    -> NodeTypeId
 162                    -> Maybe Text
 163                    -> Maybe Text
 164                    -> Select (ContextSearchRead, NodeContextRead)
 165                    -- -> Select (ContextSearchRead, NodeContextRead, MaybeFields ContextNodeNgramsRead)
 166 viewDocumentsQuery cId t ntId mQuery mYear = proc () -> do
 167   c  <- queryContextSearchTable -< ()
 168   -- let joinCond (nc, cnn) = do
 169   --       restrict -< (nc ^. context_id) .== (cnn ^. context_id)
 170   --       restrict -< (nc ^. node_id)    .== (cnn ^. node_id)  -- :: (NodeContextRead, ContextNodeNgramsRead) -> Field SqlBool
 171   nc <- queryNodeContextTable -< ()
 172   restrict -< (c^.cs_id)       .== (nc^.nc_context_id)
 173   restrict -< nc^.nc_node_id   .== pgNodeId cId
 174   restrict -< c^.cs_typename   .== sqlInt4 ntId
 175   -- cnng <- optionalRestrict queryContextNodeNgramsTable -<
 176   --   (\cnng' -> (nc ^. nc_context_id) .== (cnng' ^. cnng_context_id) .&&
 177   --              (nc ^. nc_node_id)    .== (cnng' ^. cnng_node_id))
 178   restrict -< if t then nc^.nc_category .== sqlInt4 0
 179                    else nc^.nc_category .>= sqlInt4 1
 180
 181   let
 182     query         = (fromMaybe "" mQuery)
 183     year          = (fromMaybe "" mYear)
 184     iLikeQuery    = T.intercalate "" ["%", query, "%"]
 185     abstractLHS h = fromNullable (sqlStrictText "")
 186                   $ toNullable h .->> sqlStrictText "abstract"
 187     yearLHS h     = fromNullable (sqlStrictText "")
 188                   $ toNullable h .->> sqlStrictText "publication_year"
 189
 190   restrict -<
 191     if query == "" then sqlBool True
 192       else  ((c^.cs_name) `ilike` (sqlStrictText iLikeQuery))
 193         .|| ((abstractLHS (c^.cs_hyperdata)) `ilike` (sqlStrictText iLikeQuery))
 194   restrict -<
 195     if year == "" then sqlBool True
 196       else yearLHS (c ^. cs_hyperdata) .== sqlStrictText year
 197
 198   returnA -< (c, nc)
 199   -- returnA -< (c, nc, cnng)
 200
 201
 202 ------------------------------------------------------------------------
 203 filterWith :: (SqlOrd date, SqlOrd title, SqlOrd category, SqlOrd score, hyperdata ~ SqlJsonb) =>
 204         Maybe Gargantext.Core.Types.Offset
 205      -> Maybe Gargantext.Core.Types.Limit
 206      -> Maybe OrderBy
 207      -> Select (Facet id (Field date) (Field title) (Field hyperdata) (FieldNullable category) ngramCount (FieldNullable score))
 208      -> Select (Facet id (Field date) (Field title) (Field hyperdata)(FieldNullable category) ngramCount (FieldNullable score))
 209 filterWith o l order q = limit' l $ offset' o $ orderBy (orderWith order) q
 210
 211
 212 orderWith :: (SqlOrd b1, SqlOrd b2, SqlOrd b3, SqlOrd b4)
 213           => Maybe OrderBy
 214           -> Order (Facet id (Field b1) (Field b2) (Field SqlJsonb) (FieldNullable b3) ngramCount (FieldNullable b4))
 215 orderWith (Just DateAsc)   = asc  facetDoc_created
 216 orderWith (Just DateDesc)  = desc facetDoc_created
 217
 218 orderWith (Just TitleAsc)  = asc  facetDoc_title
 219 orderWith (Just TitleDesc) = desc facetDoc_title
 220
 221 orderWith (Just ScoreAsc)  = ascNullsLast  facetDoc_score
 222 orderWith (Just ScoreDesc) = descNullsLast facetDoc_score
 223
 224 orderWith (Just SourceAsc)  = ascNullsLast  facetDoc_source
 225 orderWith (Just SourceDesc) = descNullsLast facetDoc_source
 226
 227 orderWith (Just TagAsc)     = ascNullsLast  facetDoc_category
 228 orderWith (Just TagDesc)    = descNullsLast facetDoc_category
 229
 230 orderWith _                = asc facetDoc_created
 231
 232 facetDoc_source :: SqlIsJson a
 233                 => Facet id created title (Field a) favorite ngramCount score
 234                 -> FieldNullable SqlText
 235 facetDoc_source x = (toNullable $ facetDoc_hyperdata x) .->> sqlString "source"