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                , facetDoc_score      = Just $ fromIntegral facetDoc_score
 140                , .. }
 141
 142 runCountDocuments :: (HasDBid NodeType, HasNodeError err)
 143                   => CorpusId -> IsTrash -> Maybe Text -> Maybe Text -> Cmd err Int
 144 runCountDocuments cId t mQuery mYear = do
 145   listId <- defaultList cId
 146   runCountOpaQuery (sqlQuery listId)
 147   where
 148     sqlQuery lId = viewDocuments cId lId t (toDBid NodeDocument) mQuery mYear
 149
 150 viewDocuments :: CorpusId
 151                -> ListId
 152                -> IsTrash
 153                -> NodeTypeId
 154                -> Maybe Text
 155                -> Maybe Text
 156                -> Select FacetDocAgg
 157 viewDocuments cId lId t ntId mQuery mYear =
 158   aggregate (pFacetDoc FacetDoc { facetDoc_id         = OAgg.groupBy
 159                                 , facetDoc_created    = OAgg.groupBy
 160                                 , facetDoc_title      = OAgg.groupBy
 161                                 , facetDoc_hyperdata  = OAgg.groupBy
 162                                 , facetDoc_category   = OAgg.groupBy
 163                                 , facetDoc_ngramCount = OAgg.sumInt4
 164                                 , facetDoc_score      = OAgg.sumInt4 })
 165         (viewDocumentsAgg cId lId t ntId mQuery mYear)
 166
 167 viewDocumentsAgg :: CorpusId
 168                  -> ListId
 169                  -> IsTrash
 170                  -> NodeTypeId
 171                  -> Maybe Text
 172                  -> Maybe Text
 173                  -> Select FacetDocAggPart
 174 viewDocumentsAgg cId lId t ntId mQuery mYear = proc () -> do
 175   (c, nc) <- viewDocumentsQuery cId t ntId mQuery mYear -< ()
 176   cnng <- optionalRestrict queryContextNodeNgramsTable -<
 177     \cnng' -> (cnng' ^. cnng_node_id)    .== pgNodeId lId .&&  -- (nc ^. nc_node_id) .&&
 178               (cnng' ^. cnng_context_id) .== (c ^. cs_id)
 179   let ngramCount = fromMaybeFields 0 $ _cnng_doc_count <$> cnng
 180   returnA  -< FacetDoc { facetDoc_id         = _cs_id        c
 181                        , facetDoc_created    = _cs_date      c
 182                        , facetDoc_title      = _cs_name      c
 183                        , facetDoc_hyperdata  = _cs_hyperdata c
 184                        , facetDoc_category   = nc ^. nc_category
 185                        , facetDoc_ngramCount = ngramCount
 186                        -- NOTE This is a slight abuse of "score" but
 187                        -- currently it is all 0's in the DB and the
 188                        -- search functionality on the frontend orders
 189                        -- by Score.
 190                        , facetDoc_score      = ngramCount
 191                        }
 192
 193 -- TODO Join with context_node_ngrams at context_id/node_id and sum by
 194 -- doc_count.
 195 viewDocumentsQuery :: CorpusId
 196                    -> IsTrash
 197                    -> NodeTypeId
 198                    -> Maybe Text
 199                    -> Maybe Text
 200                    -> Select (ContextSearchRead, NodeContextRead)
 201 viewDocumentsQuery cId t ntId mQuery mYear = proc () -> do
 202   c  <- queryContextSearchTable -< ()
 203   nc <- queryNodeContextTable -< ()
 204   restrict -< (c^.cs_id)       .== (nc^.nc_context_id)
 205   restrict -< nc^.nc_node_id   .== pgNodeId cId
 206   restrict -< c^.cs_typename   .== sqlInt4 ntId
 207   restrict -< if t then nc^.nc_category .== sqlInt4 0
 208                    else nc^.nc_category .>= sqlInt4 1
 209
 210   let
 211     query         = (fromMaybe "" mQuery)
 212     year          = (fromMaybe "" mYear)
 213     iLikeQuery    = T.intercalate "" ["%", query, "%"]
 214     abstractLHS h = fromNullable (sqlStrictText "")
 215                   $ toNullable h .->> sqlStrictText "abstract"
 216     yearLHS h     = fromNullable (sqlStrictText "")
 217                   $ toNullable h .->> sqlStrictText "publication_year"
 218
 219   restrict -<
 220     if query == "" then sqlBool True
 221       else  ((c^.cs_name) `ilike` (sqlStrictText iLikeQuery))
 222         .|| ((abstractLHS (c^.cs_hyperdata)) `ilike` (sqlStrictText iLikeQuery))
 223   restrict -<
 224     if year == "" then sqlBool True
 225       else yearLHS (c ^. cs_hyperdata) .== sqlStrictText year
 226
 227   returnA -< (c, nc)
 228   -- returnA -< (c, nc, cnng)
 229
 230
 231 ------------------------------------------------------------------------
 232 filterWith :: (SqlOrd date, SqlOrd title, SqlOrd category, SqlOrd score, hyperdata ~ SqlJsonb) =>
 233         Maybe Gargantext.Core.Types.Offset
 234      -> Maybe Gargantext.Core.Types.Limit
 235      -> Maybe OrderBy
 236      -> Select (Facet id (Field date) (Field title) (Field hyperdata) (FieldNullable category) ngramCount (FieldNullable score))
 237      -> Select (Facet id (Field date) (Field title) (Field hyperdata)(FieldNullable category) ngramCount (FieldNullable score))
 238 filterWith o l order q = limit' l $ offset' o $ orderBy (orderWith order) q
 239
 240
 241 orderWith :: (SqlOrd b1, SqlOrd b2, SqlOrd b3, SqlOrd b4)
 242           => Maybe OrderBy
 243           -> Order (Facet id (Field b1) (Field b2) (Field SqlJsonb) (FieldNullable b3) ngramCount (FieldNullable b4))
 244 orderWith (Just DateAsc)   = asc  facetDoc_created
 245 orderWith (Just DateDesc)  = desc facetDoc_created
 246
 247 orderWith (Just TitleAsc)  = asc  facetDoc_title
 248 orderWith (Just TitleDesc) = desc facetDoc_title
 249
 250 orderWith (Just ScoreAsc)  = ascNullsLast  facetDoc_score
 251 orderWith (Just ScoreDesc) = descNullsLast facetDoc_score
 252
 253 orderWith (Just SourceAsc)  = ascNullsLast  facetDoc_source
 254 orderWith (Just SourceDesc) = descNullsLast facetDoc_source
 255
 256 orderWith (Just TagAsc)     = ascNullsLast  facetDoc_category
 257 orderWith (Just TagDesc)    = descNullsLast facetDoc_category
 258
 259 orderWith _                = asc facetDoc_created
 260
 261
 262
 263 filterWith' :: (SqlOrd date, SqlOrd title, SqlOrd category, SqlOrd score, hyperdata ~ SqlJsonb, SqlOrd ngramCount) =>
 264         Maybe Gargantext.Core.Types.Offset
 265      -> Maybe Gargantext.Core.Types.Limit
 266      -> Maybe OrderBy
 267      -> Select (Facet id (Field date) (Field title) (Field hyperdata) (Field category) (Field ngramCount) (Field score))
 268      -> Select (Facet id (Field date) (Field title) (Field hyperdata) (Field category) (Field ngramCount) (Field score))
 269 filterWith' o l order q = limit' l $ offset' o $ orderBy (orderWith' order) q
 270
 271
 272 orderWith' :: (SqlOrd date, SqlOrd title, SqlOrd category, SqlOrd ngramCount, SqlOrd score)
 273            => Maybe OrderBy
 274            -> Order (Facet id (Field date) (Field title) (Field SqlJsonb) (Field category) (Field ngramCount) (Field score))
 275 orderWith' (Just DateAsc)   = asc  facetDoc_created
 276 orderWith' (Just DateDesc)  = desc facetDoc_created
 277
 278 orderWith' (Just TitleAsc)  = asc  facetDoc_title
 279 orderWith' (Just TitleDesc) = desc facetDoc_title
 280
 281 orderWith' (Just NgramCountAsc)  = asc  facetDoc_ngramCount
 282 orderWith' (Just NgramCountDesc) = desc facetDoc_ngramCount
 283
 284 orderWith' (Just ScoreAsc)  = asc  facetDoc_score
 285 orderWith' (Just ScoreDesc) = desc facetDoc_score
 286
 287 orderWith' (Just SourceAsc)  = ascNullsLast  facetDoc_source
 288 orderWith' (Just SourceDesc) = descNullsLast facetDoc_source
 289
 290 orderWith' (Just TagAsc)     = asc  facetDoc_category
 291 orderWith' (Just TagDesc)    = desc facetDoc_category
 292
 293 orderWith' _                = asc facetDoc_created
 294
 295 facetDoc_source :: SqlIsJson a
 296                 => Facet id created title (Field a) favorite ngramCount score
 297                 -> FieldNullable SqlText
 298 facetDoc_source x = (toNullable $ facetDoc_hyperdata x) .->> sqlString "source"