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   , 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.Database.Query.Filter
  51 import Gargantext.Database.Query.Table.Ngrams
  52 import Gargantext.Database.Query.Table.Context
  53 import Gargantext.Database.Query.Facet.Types
  54 import Gargantext.Database.Query.Table.ContextNodeNgrams
  55 import Gargantext.Database.Query.Table.NodeContext (queryNodeContextTable)
  56 import Gargantext.Database.Prelude
  57 import Gargantext.Database.Schema.Context
  58 import Gargantext.Database.Schema.Node
  59 import Gargantext.Database.Schema.NodeContext
  60 import Gargantext.Prelude (printDebug)
  61
  62 ------------------------------------------------------------------------
  63
  64
  65 -- TODO-SECURITY check
  66 runViewAuthorsDoc :: HasDBid NodeType
  67                   => ContactId
  68                   -> IsTrash
  69                   -> Maybe Offset
  70                   -> Maybe Limit
  71                   -> Maybe OrderBy
  72                   -> Cmd err [FacetDoc]
  73 runViewAuthorsDoc cId t o l order = runOpaQuery $ filterWith o l order $ viewAuthorsDoc cId t ntId
  74   where
  75     ntId = NodeDocument
  76
  77 -- TODO add delete ?
  78 viewAuthorsDoc :: HasDBid NodeType
  79                => ContactId
  80                -> IsTrash
  81                -> NodeType
  82                -> Select FacetDocRead
  83 viewAuthorsDoc cId _ nt = proc () -> do
  84   --(doc,(_,(_,(_,contact')))) <- queryAuthorsDoc      -< ()
  85   (doc, _, _, _, contact') <- queryAuthorsDoc -< ()
  86
  87   restrict -< fromMaybeFields (sqlInt4 $ -1) (_node_id <$> contact') .=== 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.0
  96                        , facetDoc_score      = toNullable $ sqlDouble 1 }
  97
  98 queryAuthorsDoc :: Select ( NodeRead
  99                           , MaybeFields ContextNodeNgramsRead
 100                           , MaybeFields NgramsRead
 101                           , MaybeFields ContextNodeNgramsRead
 102                           , MaybeFields NodeRead)
 103 queryAuthorsDoc = proc () -> do
 104   n <- queryNodeTable -< ()
 105   cnn <- optionalRestrict queryContextNodeNgramsTable -<
 106     \cnn' -> _node_id n .== _cnng_context_id cnn'
 107   ng <- optionalRestrict queryNgramsTable -<
 108     \ng' -> justFields (ng' ^. ngrams_id) .=== (_cnng_ngrams_id <$> cnn)
 109   cnn2 <- optionalRestrict queryContextNodeNgramsTable -<
 110     \cnn2' -> (_ngrams_id <$> ng) .=== justFields (_cnng_ngrams_id cnn2')
 111   contact <- optionalRestrict queryNodeTable -<
 112     \contact' -> justFields (_node_id contact') .=== (_cnng_context_id <$> cnn2)
 113
 114   returnA -< (n, cnn, ng, cnn2, contact)
 115
 116
 117 ------------------------------------------------------------------------
 118 -- TODO-SECURITY check
 119 runViewDocuments :: HasDBid NodeType
 120                  => CorpusId
 121                  -> IsTrash
 122                  -> Maybe Offset
 123                  -> Maybe Limit
 124                  -> Maybe OrderBy
 125                  -> Maybe Text
 126                  -> Maybe Text
 127                  -> Cmd err [FacetDoc]
 128 runViewDocuments cId t o l order query year = do
 129     printDebug "[runViewDocuments] sqlQuery" $ showSql sqlQuery
 130     res <- runOpaQuery $ filterWith' o l order sqlQuery :: Cmd err [FacetDocAgg']
 131     pure $ remapNgramsCount <$> res
 132   where
 133     sqlQuery = viewDocuments' cId t (toDBid NodeDocument) query year
 134
 135     remapNgramsCount (FacetDoc { .. }) =
 136       FacetDoc { facetDoc_ngramCount = Just $ fromIntegral facetDoc_ngramCount
 137                , .. }
 138
 139 runCountDocuments :: HasDBid NodeType => CorpusId -> IsTrash -> Maybe Text -> Maybe Text -> Cmd err Int
 140 runCountDocuments cId t mQuery mYear = do
 141   runCountOpaQuery sqlQuery
 142   where
 143     sqlQuery = viewDocuments' cId t (toDBid NodeDocument) mQuery mYear
 144
 145
 146 viewDocuments :: CorpusId
 147               -> IsTrash
 148               -> NodeTypeId
 149               -> Maybe Text
 150               -> Maybe Text
 151               -> Select FacetDocRead
 152 viewDocuments cId t ntId mQuery mYear = proc () -> do
 153   (c, nc) <- viewDocumentsQuery cId t ntId mQuery mYear -< ()
 154   --ngramCountAgg <- laterally . aggregate sumInt4 -< cnng
 155
 156   -- TODO PGInt8 -> PGFloat conversion
 157   --      https://github.com/tomjaguarpaw/haskell-opaleye/issues/401
 158   --      unsafeCast "float8"
 159   -- cnng <- optionalRestrict queryContextNodeNgramsTable -<
 160   --   \cnng' -> (cnng' ^. cnng_node_id)    .== pgNodeId cId .&&
 161   --             (cnng' ^. cnng_context_id) .== (c ^. cs_id)
 162
 163   -- cnt <- aggregate sum -< maybeFields (sqlInt4 0) _cnng_doc_count cnng
 164   -- (proc cnng' -> do
 165   --                          returnA -< maybeFields (sqlInt4 0) _cnng_doc_count cnng') -< cnng
 166
 167   returnA  -< FacetDoc { facetDoc_id         = _cs_id        c
 168                        , facetDoc_created    = _cs_date      c
 169                        , facetDoc_title      = _cs_name      c
 170                        , facetDoc_hyperdata  = _cs_hyperdata c
 171                        , facetDoc_category   = toNullable $ nc^.nc_category
 172                        , facetDoc_ngramCount = toNullable $ nc^.nc_score
 173                        -- , facetDoc_ngramCount = toNullable $ toFields cnt
 174                        , facetDoc_score      = toNullable $ nc^.nc_score
 175                        }
 176
 177 viewDocuments' :: CorpusId
 178                -> IsTrash
 179                -> NodeTypeId
 180                -> Maybe Text
 181                -> Maybe Text
 182                -> Select FacetDocAgg
 183 viewDocuments' cId t ntId mQuery mYear =
 184   aggregate (pFacetDoc FacetDoc { facetDoc_id         = OAgg.groupBy
 185                                 , facetDoc_created    = OAgg.groupBy
 186                                 , facetDoc_title      = OAgg.groupBy
 187                                 , facetDoc_hyperdata  = OAgg.groupBy
 188                                 , facetDoc_category   = OAgg.groupBy
 189                                 , facetDoc_ngramCount = OAgg.sumInt4
 190                                 , facetDoc_score      = OAgg.sum })
 191         (viewDocumentsAgg cId t ntId mQuery mYear)
 192
 193 viewDocumentsAgg :: CorpusId
 194                  -> IsTrash
 195                  -> NodeTypeId
 196                  -> Maybe Text
 197                  -> Maybe Text
 198                  -> Select FacetDocAggPart
 199 viewDocumentsAgg cId t ntId mQuery mYear = proc () -> do
 200   (c, nc) <- viewDocumentsQuery cId t ntId mQuery mYear -< ()
 201   cnng <- optionalRestrict queryContextNodeNgramsTable -<
 202     \cnng' -> (cnng' ^. cnng_node_id)    .== (nc ^. nc_node_id) .&&
 203               (cnng' ^. cnng_context_id) .== (c ^. cs_id)
 204   returnA  -< FacetDoc { facetDoc_id         = _cs_id        c
 205                        , facetDoc_created    = _cs_date      c
 206                        , facetDoc_title      = _cs_name      c
 207                        , facetDoc_hyperdata  = _cs_hyperdata c
 208                        , facetDoc_category   = nc ^. nc_category
 209                        , facetDoc_ngramCount = fromMaybeFields 0 $ _cnng_doc_count <$> cnng  -- toNullable $ nc^.nc_score
 210                        -- , facetDoc_ngramCount = toNullable $ toFields cnt
 211                        , facetDoc_score      = nc ^. nc_score
 212                        }
 213
 214 -- TODO Join with context_node_ngrams at context_id/node_id and sum by
 215 -- doc_count.
 216 viewDocumentsQuery :: CorpusId
 217                    -> IsTrash
 218                    -> NodeTypeId
 219                    -> Maybe Text
 220                    -> Maybe Text
 221                    -> Select (ContextSearchRead, NodeContextRead)
 222                    -- -> Select (ContextSearchRead, NodeContextRead, MaybeFields ContextNodeNgramsRead)
 223 viewDocumentsQuery cId t ntId mQuery mYear = proc () -> do
 224   c  <- queryContextSearchTable -< ()
 225   -- let joinCond (nc, cnn) = do
 226   --       restrict -< (nc ^. context_id) .== (cnn ^. context_id)
 227   --       restrict -< (nc ^. node_id)    .== (cnn ^. node_id)  -- :: (NodeContextRead, ContextNodeNgramsRead) -> Field SqlBool
 228   nc <- queryNodeContextTable -< ()
 229   restrict -< (c^.cs_id)       .== (nc^.nc_context_id)
 230   restrict -< nc^.nc_node_id   .== pgNodeId cId
 231   restrict -< c^.cs_typename   .== sqlInt4 ntId
 232   -- cnng <- optionalRestrict queryContextNodeNgramsTable -<
 233   --   (\cnng' -> (nc ^. nc_context_id) .== (cnng' ^. cnng_context_id) .&&
 234   --              (nc ^. nc_node_id)    .== (cnng' ^. cnng_node_id))
 235   restrict -< if t then nc^.nc_category .== sqlInt4 0
 236                    else nc^.nc_category .>= sqlInt4 1
 237
 238   let
 239     query         = (fromMaybe "" mQuery)
 240     year          = (fromMaybe "" mYear)
 241     iLikeQuery    = T.intercalate "" ["%", query, "%"]
 242     abstractLHS h = fromNullable (sqlStrictText "")
 243                   $ toNullable h .->> sqlStrictText "abstract"
 244     yearLHS h     = fromNullable (sqlStrictText "")
 245                   $ toNullable h .->> sqlStrictText "publication_year"
 246
 247   restrict -<
 248     if query == "" then sqlBool True
 249       else  ((c^.cs_name) `ilike` (sqlStrictText iLikeQuery))
 250         .|| ((abstractLHS (c^.cs_hyperdata)) `ilike` (sqlStrictText iLikeQuery))
 251   restrict -<
 252     if year == "" then sqlBool True
 253       else yearLHS (c ^. cs_hyperdata) .== sqlStrictText year
 254
 255   returnA -< (c, nc)
 256   -- returnA -< (c, nc, cnng)
 257
 258
 259 ------------------------------------------------------------------------
 260 filterWith :: (SqlOrd date, SqlOrd title, SqlOrd category, SqlOrd score, hyperdata ~ SqlJsonb) =>
 261         Maybe Gargantext.Core.Types.Offset
 262      -> Maybe Gargantext.Core.Types.Limit
 263      -> Maybe OrderBy
 264      -> Select (Facet id (Field date) (Field title) (Field hyperdata) (FieldNullable category) ngramCount (FieldNullable score))
 265      -> Select (Facet id (Field date) (Field title) (Field hyperdata)(FieldNullable category) ngramCount (FieldNullable score))
 266 filterWith o l order q = limit' l $ offset' o $ orderBy (orderWith order) q
 267
 268
 269 orderWith :: (SqlOrd b1, SqlOrd b2, SqlOrd b3, SqlOrd b4)
 270           => Maybe OrderBy
 271           -> Order (Facet id (Field b1) (Field b2) (Field SqlJsonb) (FieldNullable b3) ngramCount (FieldNullable b4))
 272 orderWith (Just DateAsc)   = asc  facetDoc_created
 273 orderWith (Just DateDesc)  = desc facetDoc_created
 274
 275 orderWith (Just TitleAsc)  = asc  facetDoc_title
 276 orderWith (Just TitleDesc) = desc facetDoc_title
 277
 278 orderWith (Just ScoreAsc)  = ascNullsLast  facetDoc_score
 279 orderWith (Just ScoreDesc) = descNullsLast facetDoc_score
 280
 281 orderWith (Just SourceAsc)  = ascNullsLast  facetDoc_source
 282 orderWith (Just SourceDesc) = descNullsLast facetDoc_source
 283
 284 orderWith (Just TagAsc)     = ascNullsLast  facetDoc_category
 285 orderWith (Just TagDesc)    = descNullsLast facetDoc_category
 286
 287 orderWith _                = asc facetDoc_created
 288
 289
 290
 291 filterWith' :: (SqlOrd date, SqlOrd title, SqlOrd category, SqlOrd score, hyperdata ~ SqlJsonb) =>
 292         Maybe Gargantext.Core.Types.Offset
 293      -> Maybe Gargantext.Core.Types.Limit
 294      -> Maybe OrderBy
 295      -> Select (Facet id (Field date) (Field title) (Field hyperdata) (Field category) ngramCount (Field score))
 296      -> Select (Facet id (Field date) (Field title) (Field hyperdata) (Field category) ngramCount (Field score))
 297 filterWith' o l order q = limit' l $ offset' o $ orderBy (orderWith' order) q
 298
 299
 300 orderWith' :: (SqlOrd b1, SqlOrd b2, SqlOrd b3, SqlOrd b4)
 301            => Maybe OrderBy
 302            -> Order (Facet id (Field b1) (Field b2) (Field SqlJsonb) (Field b3) ngramCount (Field b4))
 303 orderWith' (Just DateAsc)   = asc  facetDoc_created
 304 orderWith' (Just DateDesc)  = desc facetDoc_created
 305
 306 orderWith' (Just TitleAsc)  = asc  facetDoc_title
 307 orderWith' (Just TitleDesc) = desc facetDoc_title
 308
 309 orderWith' (Just ScoreAsc)  = asc  facetDoc_score
 310 orderWith' (Just ScoreDesc) = desc facetDoc_score
 311
 312 orderWith' (Just SourceAsc)  = ascNullsLast  facetDoc_source
 313 orderWith' (Just SourceDesc) = descNullsLast facetDoc_source
 314
 315 orderWith' (Just TagAsc)     = asc  facetDoc_category
 316 orderWith' (Just TagDesc)    = desc facetDoc_category
 317
 318 orderWith' _                = asc facetDoc_created
 319
 320 facetDoc_source :: SqlIsJson a
 321                 => Facet id created title (Field a) favorite ngramCount score
 322                 -> FieldNullable SqlText
 323 facetDoc_source x = (toNullable $ facetDoc_hyperdata x) .->> sqlString "source"