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