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 LambdaCase                #-}
  14 {-# LANGUAGE QuasiQuotes               #-}
  15 {-# LANGUAGE NoMonomorphismRestriction #-}
  16 {-# LANGUAGE TemplateHaskell           #-}
  17 {-# LANGUAGE TypeFamilies              #-}
  18 ------------------------------------------------------------------------
  19 module Gargantext.Database.Query.Facet
  20   ( runViewAuthorsDoc
  21   , runViewDocuments
  22   , viewDocuments
  23   , runCountDocuments
  24   , filterWith
  25
  26   , Category
  27   , Score
  28   , Title
  29
  30   , Pair(..)
  31   , Facet(..)
  32   , FacetDoc
  33   , FacetDocRead
  34   , FacetPaired(..)
  35   , FacetPairedRead
  36   , OrderBy(..)
  37   )
  38   where
  39
  40 import Control.Arrow (returnA)
  41 import Control.Lens ((^.))
  42 import qualified Data.Text as T
  43 import Opaleye
  44 import qualified Opaleye.Aggregate as OAgg
  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.Core.Types.Query (Limit, Offset, IsTrash)
  51 import Gargantext.Database.Query.Filter
  52 import Gargantext.Database.Query.Table.Context
  53 import Gargantext.Database.Query.Table.ContextNodeNgrams
  54 import Gargantext.Database.Query.Table.Ngrams
  55 import Gargantext.Database.Query.Table.Node (defaultList)
  56 import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
  57 import Gargantext.Database.Query.Table.NodeContext (queryNodeContextTable)
  58 import Gargantext.Database.Query.Facet.Types
  59 import Gargantext.Database.Prelude
  60 import Gargantext.Database.Schema.Context
  61 import Gargantext.Database.Schema.Node
  62 import Gargantext.Database.Schema.NodeContext
  63
  64 ------------------------------------------------------------------------
  65
  66
  67 -- TODO-SECURITY check
  68 runViewAuthorsDoc :: HasDBid NodeType
  69                   => ContactId
  70                   -> IsTrash
  71                   -> Maybe Offset
  72                   -> Maybe Limit
  73                   -> Maybe OrderBy
  74                   -> Cmd err [FacetDoc]
  75 runViewAuthorsDoc cId t o l order = runOpaQuery $ filterWith o l order $ viewAuthorsDoc cId t ntId
  76   where
  77     ntId = NodeDocument
  78
  79 -- TODO add delete ?
  80 viewAuthorsDoc :: HasDBid NodeType
  81                => ContactId
  82                -> IsTrash
  83                -> NodeType
  84                -> Select FacetDocRead
  85 viewAuthorsDoc cId _ nt = proc () -> do
  86   --(doc,(_,(_,(_,contact')))) <- queryAuthorsDoc      -< ()
  87   (doc, _, _, _, contact') <- queryAuthorsDoc -< ()
  88
  89   restrict -< fromMaybeFields (sqlInt4 $ -1) (_node_id <$> contact') .=== pgNodeId cId
  90   restrict -< _node_typename doc   .== sqlInt4 (toDBid nt)
  91
  92   returnA  -< FacetDoc { facetDoc_id         = _node_id        doc
  93                        , facetDoc_created    = _node_date      doc
  94                        , facetDoc_title      = _node_name      doc
  95                        , facetDoc_hyperdata  = _node_hyperdata doc
  96                        , facetDoc_category   = toNullable $ sqlInt4 1
  97                        , facetDoc_ngramCount = toNullable $ sqlDouble 1.0
  98                        , facetDoc_score      = toNullable $ sqlDouble 1 }
  99
 100 queryAuthorsDoc :: Select ( NodeRead
 101                           , MaybeFields ContextNodeNgramsRead
 102                           , MaybeFields NgramsRead
 103                           , MaybeFields ContextNodeNgramsRead
 104                           , MaybeFields NodeRead)
 105 queryAuthorsDoc = proc () -> do
 106   n <- queryNodeTable -< ()
 107   cnn <- optionalRestrict queryContextNodeNgramsTable -<
 108     \cnn' -> _node_id n .== _cnng_context_id cnn'
 109   ng <- optionalRestrict queryNgramsTable -<
 110     \ng' -> justFields (ng' ^. ngrams_id) .=== (_cnng_ngrams_id <$> cnn)
 111   cnn2 <- optionalRestrict queryContextNodeNgramsTable -<
 112     \cnn2' -> (_ngrams_id <$> ng) .=== justFields (_cnng_ngrams_id cnn2')
 113   contact <- optionalRestrict queryNodeTable -<
 114     \contact' -> justFields (_node_id contact') .=== (_cnng_context_id <$> cnn2)
 115
 116   returnA -< (n, cnn, ng, cnn2, contact)
 117
 118
 119 ------------------------------------------------------------------------
 120 -- TODO-SECURITY check
 121 runViewDocuments :: (HasDBid NodeType, HasNodeError err)
 122                  => CorpusId
 123                  -> IsTrash
 124                  -> Maybe Offset
 125                  -> Maybe Limit
 126                  -> Maybe OrderBy
 127                  -> Maybe Text
 128                  -> Maybe Text
 129                  -> Cmd err [FacetDoc]
 130 runViewDocuments cId t o l order query year = do
 131     listId <- defaultList cId
 132
 133     res <- runOpaQuery $ filterWith' o l order (sqlQuery listId) :: Cmd err [FacetDocAgg']
 134     pure $ remapNgramsCount <$> res
 135   where
 136     sqlQuery lId = viewDocuments cId lId t (toDBid NodeDocument) query year
 137
 138     remapNgramsCount (FacetDoc { .. }) =
 139       FacetDoc { facetDoc_ngramCount = Just $ fromIntegral facetDoc_ngramCount
 140                , facetDoc_score      = Just $ fromIntegral facetDoc_score
 141                , .. }
 142
 143 runCountDocuments :: (HasDBid NodeType, HasNodeError err)
 144                   => CorpusId -> IsTrash -> Maybe Text -> Maybe Text -> Cmd err Int
 145 runCountDocuments cId t mQuery mYear = do
 146   listId <- defaultList cId
 147   runCountOpaQuery (sqlQuery listId)
 148   where
 149     sqlQuery lId = viewDocuments cId lId t (toDBid NodeDocument) mQuery mYear
 150
 151 viewDocuments :: CorpusId
 152                -> ListId
 153                -> IsTrash
 154                -> NodeTypeId
 155                -> Maybe Text
 156                -> Maybe Text
 157                -> Select FacetDocAgg
 158 viewDocuments cId lId t ntId mQuery mYear =
 159   aggregate (pFacetDoc FacetDoc { facetDoc_id         = OAgg.groupBy
 160                                 , facetDoc_created    = OAgg.groupBy
 161                                 , facetDoc_title      = OAgg.groupBy
 162                                 , facetDoc_hyperdata  = OAgg.groupBy
 163                                 , facetDoc_category   = OAgg.groupBy
 164                                 , facetDoc_ngramCount = OAgg.sumInt4
 165                                 , facetDoc_score      = OAgg.sumInt4 })
 166         (viewDocumentsAgg cId lId t ntId mQuery mYear)
 167
 168 viewDocumentsAgg :: CorpusId
 169                  -> ListId
 170                  -> IsTrash
 171                  -> NodeTypeId
 172                  -> Maybe Text
 173                  -> Maybe Text
 174                  -> Select FacetDocAggPart
 175 viewDocumentsAgg cId lId t ntId mQuery mYear = proc () -> do
 176   (c, nc) <- viewDocumentsQuery cId t ntId mQuery mYear -< ()
 177   cnng <- optionalRestrict queryContextNodeNgramsTable -<
 178     \cnng' -> (cnng' ^. cnng_node_id)    .== pgNodeId lId .&&  -- (nc ^. nc_node_id) .&&
 179               (cnng' ^. cnng_context_id) .== (c ^. cs_id)
 180   let ngramCount = fromMaybeFields 0 $ _cnng_doc_count <$> cnng
 181   returnA  -< FacetDoc { facetDoc_id         = _cs_id        c
 182                        , facetDoc_created    = _cs_date      c
 183                        , facetDoc_title      = _cs_name      c
 184                        , facetDoc_hyperdata  = _cs_hyperdata c
 185                        , facetDoc_category   = nc ^. nc_category
 186                        , facetDoc_ngramCount = ngramCount
 187                        -- NOTE This is a slight abuse of "score" but
 188                        -- currently it is all 0's in the DB and the
 189                        -- search functionality on the frontend orders
 190                        -- by Score.
 191                        , facetDoc_score      = ngramCount
 192                        }
 193
 194 -- TODO Join with context_node_ngrams at context_id/node_id and sum by
 195 -- doc_count.
 196 viewDocumentsQuery :: CorpusId
 197                    -> IsTrash
 198                    -> NodeTypeId
 199                    -> Maybe Text
 200                    -> Maybe Text
 201                    -> Select (ContextSearchRead, NodeContextRead)
 202 viewDocumentsQuery cId t ntId mQuery mYear = proc () -> do
 203   c  <- queryContextSearchTable -< ()
 204   nc <- queryNodeContextTable -< ()
 205   restrict -< (c^.cs_id)       .== (nc^.nc_context_id)
 206   restrict -< nc^.nc_node_id   .== pgNodeId cId
 207   restrict -< c^.cs_typename   .== sqlInt4 ntId
 208   restrict -< if t then nc^.nc_category .== sqlInt4 0
 209                    else nc^.nc_category .>= sqlInt4 1
 210
 211   let
 212     query         = (fromMaybe "" mQuery)
 213     year          = (fromMaybe "" mYear)
 214     iLikeQuery    = T.intercalate "" ["%", query, "%"]
 215     abstractLHS h = fromNullable (sqlStrictText "")
 216                   $ toNullable h .->> sqlStrictText "abstract"
 217     yearLHS h     = fromNullable (sqlStrictText "")
 218                   $ toNullable h .->> sqlStrictText "publication_year"
 219
 220   restrict -<
 221     if query == "" then sqlBool True
 222       else  ((c^.cs_name) `ilike` (sqlStrictText iLikeQuery))
 223         .|| ((abstractLHS (c^.cs_hyperdata)) `ilike` (sqlStrictText iLikeQuery))
 224   restrict -<
 225     if year == "" then sqlBool True
 226       else yearLHS (c ^. cs_hyperdata) .== sqlStrictText year
 227
 228   returnA -< (c, nc)
 229   -- returnA -< (c, nc, cnng)
 230
 231
 232 ------------------------------------------------------------------------
 233 filterWith :: (SqlOrd date, SqlOrd title, SqlOrd category, SqlOrd score, hyperdata ~ SqlJsonb) =>
 234         Maybe Offset
 235      -> Maybe Limit
 236      -> Maybe OrderBy
 237      -> Select (Facet id (Field date) (Field title) (Field hyperdata) (FieldNullable category) ngramCount (FieldNullable score))
 238      -> Select (Facet id (Field date) (Field title) (Field hyperdata)(FieldNullable category) ngramCount (FieldNullable score))
 239 filterWith o l order q = limit' l $ offset' o $ orderBy (orderWith order) q
 240
 241
 242 orderWith :: (SqlOrd b1, SqlOrd b2, SqlOrd b3, SqlOrd b4)
 243           => Maybe OrderBy
 244           -> Order (Facet id (Field b1) (Field b2) (Field SqlJsonb) (FieldNullable b3) ngramCount (FieldNullable b4))
 245 orderWith (Just DateAsc)   = asc  facetDoc_created
 246 orderWith (Just DateDesc)  = desc facetDoc_created
 247
 248 orderWith (Just TitleAsc)  = asc  facetDoc_title
 249 orderWith (Just TitleDesc) = desc facetDoc_title
 250
 251 orderWith (Just ScoreAsc)  = ascNullsLast  facetDoc_score
 252 orderWith (Just ScoreDesc) = descNullsLast facetDoc_score
 253
 254 orderWith (Just SourceAsc)  = ascNullsLast  facetDoc_source
 255 orderWith (Just SourceDesc) = descNullsLast facetDoc_source
 256
 257 orderWith (Just TagAsc)     = ascNullsLast  facetDoc_category
 258 orderWith (Just TagDesc)    = descNullsLast facetDoc_category
 259
 260 orderWith _                = asc facetDoc_created
 261
 262
 263
 264 filterWith' :: (SqlOrd date, SqlOrd title, SqlOrd category, SqlOrd score, hyperdata ~ SqlJsonb, SqlOrd ngramCount) =>
 265         Maybe Offset
 266      -> Maybe Limit
 267      -> Maybe OrderBy
 268      -> Select (Facet id (Field date) (Field title) (Field hyperdata) (Field category) (Field ngramCount) (Field score))
 269      -> Select (Facet id (Field date) (Field title) (Field hyperdata) (Field category) (Field ngramCount) (Field score))
 270 filterWith' o l order q = limit' l $ offset' o $ orderBy (orderWith' order) q
 271
 272
 273 orderWith' :: (SqlOrd date, SqlOrd title, SqlOrd category, SqlOrd ngramCount, SqlOrd score)
 274            => Maybe OrderBy
 275            -> Order (Facet id (Field date) (Field title) (Field SqlJsonb) (Field category) (Field ngramCount) (Field score))
 276 orderWith' (Just DateAsc)   = asc  facetDoc_created
 277 orderWith' (Just DateDesc)  = desc facetDoc_created
 278
 279 orderWith' (Just TitleAsc)  = asc  facetDoc_title
 280 orderWith' (Just TitleDesc) = desc facetDoc_title
 281
 282 orderWith' (Just NgramCountAsc)  = asc  facetDoc_ngramCount
 283 orderWith' (Just NgramCountDesc) = desc facetDoc_ngramCount
 284
 285 orderWith' (Just ScoreAsc)  = asc  facetDoc_score
 286 orderWith' (Just ScoreDesc) = desc facetDoc_score
 287
 288 orderWith' (Just SourceAsc)  = ascNullsLast  facetDoc_source
 289 orderWith' (Just SourceDesc) = descNullsLast facetDoc_source
 290
 291 orderWith' (Just TagAsc)     = asc  facetDoc_category
 292 orderWith' (Just TagDesc)    = desc facetDoc_category
 293
 294 orderWith' _                = asc facetDoc_created
 295
 296 facetDoc_source :: SqlIsJson a
 297                 => Facet id created title (Field a) favorite ngramCount score
 298                 -> FieldNullable SqlText
 299 facetDoc_source x = (toNullable $ facetDoc_hyperdata x) .->> sqlString "source"