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   , FacetPairedReadNull
  36   , FacetPairedReadNullAgg
  37   , OrderBy(..)
  38   )
  39   where
  40
  41 import Control.Arrow (returnA, (>>>))
  42 import Control.Lens ((^.))
  43 import qualified Data.Text as T
  44 import Opaleye
  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, (ContextNodeNgramsReadNull, (NgramsReadNull, (ContextNodeNgramsRead, NodeReadNull))))
  99 --queryAuthorsDoc = leftJoin5 queryNodeTable queryContextNodeNgramsTable queryNgramsTable queryContextNodeNgramsTable queryNodeTable cond12 cond23 cond34 cond45
 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     -- where
 118     --      cond12 :: (ContextNodeNgramsRead, NodeRead) -> Field SqlBool
 119     --      cond12 (nodeNgram, doc) =  _node_id doc
 120     --                             .== _cnng_context_id nodeNgram
 121
 122     --      cond23 :: (NgramsRead, (ContextNodeNgramsRead, NodeReadNull)) -> Field SqlBool
 123     --      cond23 (ngrams', (nodeNgram, _)) =  ngrams'^.ngrams_id
 124     --                                     .== _cnng_ngrams_id nodeNgram
 125
 126     --      cond34 :: (ContextNodeNgramsRead, (NgramsRead, (ContextNodeNgramsReadNull, NodeReadNull))) -> Field SqlBool
 127     --      cond34 (nodeNgram2, (ngrams', (_,_)))= ngrams'^.ngrams_id .== _cnng_ngrams_id       nodeNgram2
 128
 129     --      cond45 :: (NodeRead, (ContextNodeNgramsRead, (NgramsReadNull, (ContextNodeNgramsReadNull, NodeReadNull)))) -> Field SqlBool
 130     --      cond45 (contact', (nodeNgram2', (_, (_,_)))) = _node_id  contact'  .== _cnng_context_id         nodeNgram2'
 131
 132
 133 ------------------------------------------------------------------------
 134 -- TODO-SECURITY check
 135 runViewDocuments :: HasDBid NodeType
 136                  => CorpusId
 137                  -> IsTrash
 138                  -> Maybe Offset
 139                  -> Maybe Limit
 140                  -> Maybe OrderBy
 141                  -> Maybe Text
 142                  -> Maybe Text
 143                  -> Cmd err [FacetDoc]
 144 runViewDocuments cId t o l order query year = do
 145     printDebug "[runViewDocuments] sqlQuery" $ showSql sqlQuery
 146     runOpaQuery $ filterWith o l order sqlQuery
 147   where
 148     sqlQuery = viewDocuments cId t (toDBid NodeDocument) query year
 149
 150 runCountDocuments :: HasDBid NodeType => CorpusId -> IsTrash -> Maybe Text -> Maybe Text -> Cmd err Int
 151 runCountDocuments cId t mQuery mYear = do
 152   runCountOpaQuery sqlQuery
 153   where
 154     sqlQuery = viewDocuments cId t (toDBid NodeDocument) mQuery mYear
 155
 156
 157 viewDocuments :: CorpusId
 158               -> IsTrash
 159               -> NodeTypeId
 160               -> Maybe Text
 161               -> Maybe Text
 162               -> Select FacetDocRead
 163 viewDocuments cId t ntId mQuery mYear = viewDocumentsQuery cId t ntId mQuery mYear >>> proc (c, nc) -> do
 164   -- ngramCountAgg <- aggregate sumInt4 -< cnng
 165   returnA  -< FacetDoc { facetDoc_id         = _cs_id        c
 166                        , facetDoc_created    = _cs_date      c
 167                        , facetDoc_title      = _cs_name      c
 168                        , facetDoc_hyperdata  = _cs_hyperdata c
 169                        , facetDoc_category   = toNullable $ nc^.nc_category
 170                        , facetDoc_ngramCount = toNullable $ nc^.nc_score
 171                        , facetDoc_score      = toNullable $ nc^.nc_score
 172                        }
 173
 174 -- TODO Join with context_node_ngrams at context_id/node_id and sum by
 175 -- doc_count.
 176 viewDocumentsQuery :: CorpusId
 177                    -> IsTrash
 178                    -> NodeTypeId
 179                    -> Maybe Text
 180                    -> Maybe Text
 181                    -> Select (ContextSearchRead, NodeContextRead)
 182                    -- -> Select (ContextSearchRead, NodeContextRead, MaybeFields ContextNodeNgramsRead)
 183 viewDocumentsQuery cId t ntId mQuery mYear = proc () -> do
 184   c  <- queryContextSearchTable -< ()
 185   -- let joinCond (nc, cnn) = do
 186   --       restrict -< (nc ^. context_id) .== (cnn ^. context_id)
 187   --       restrict -< (nc ^. node_id)    .== (cnn ^. node_id)  -- :: (NodeContextRead, ContextNodeNgramsRead) -> Field SqlBool
 188   nc <- queryNodeContextTable -< ()
 189   restrict -< (c^.cs_id)       .== (nc^.nc_context_id)
 190   restrict -< nc^.nc_node_id   .== pgNodeId cId
 191   restrict -< c^.cs_typename   .== sqlInt4 ntId
 192   -- cnng <- optionalRestrict queryContextNodeNgramsTable -<
 193   --   (\cnng' -> (nc ^. nc_context_id) .== (cnng' ^. cnng_context_id) .&&
 194   --              (nc ^. nc_node_id)    .== (cnng' ^. cnng_node_id))
 195   restrict -< if t then nc^.nc_category .== sqlInt4 0
 196                    else nc^.nc_category .>= sqlInt4 1
 197
 198   let
 199     query         = (fromMaybe "" mQuery)
 200     year          = (fromMaybe "" mYear)
 201     iLikeQuery    = T.intercalate "" ["%", query, "%"]
 202     abstractLHS h = fromNullable (sqlStrictText "")
 203                   $ toNullable h .->> sqlStrictText "abstract"
 204     yearLHS h     = fromNullable (sqlStrictText "")
 205                   $ toNullable h .->> sqlStrictText "publication_year"
 206
 207   restrict -<
 208     if query == "" then sqlBool True
 209       else  ((c^.cs_name) `ilike` (sqlStrictText iLikeQuery))
 210         .|| ((abstractLHS (c^.cs_hyperdata)) `ilike` (sqlStrictText iLikeQuery))
 211   restrict -<
 212     if year == "" then sqlBool True
 213       else yearLHS (c ^. cs_hyperdata) .== sqlStrictText year
 214
 215   returnA -< (c, nc)
 216   -- returnA -< (c, nc, cnng)
 217
 218
 219 ------------------------------------------------------------------------
 220 filterWith :: (SqlOrd date, SqlOrd title, SqlOrd category, SqlOrd score, hyperdata ~ SqlJsonb) =>
 221         Maybe Gargantext.Core.Types.Offset
 222      -> Maybe Gargantext.Core.Types.Limit
 223      -> Maybe OrderBy
 224      -> Select (Facet id (Field date) (Field title) (Field hyperdata) (FieldNullable category) ngramCount (FieldNullable score))
 225      -> Select (Facet id (Field date) (Field title) (Field hyperdata)(FieldNullable category) ngramCount (FieldNullable score))
 226 filterWith o l order q = limit' l $ offset' o $ orderBy (orderWith order) q
 227
 228
 229 orderWith :: (SqlOrd b1, SqlOrd b2, SqlOrd b3, SqlOrd b4)
 230           => Maybe OrderBy
 231           -> Order (Facet id (Field b1) (Field b2) (Field SqlJsonb) (FieldNullable b3) ngramCount (FieldNullable b4))
 232 orderWith (Just DateAsc)   = asc  facetDoc_created
 233 orderWith (Just DateDesc)  = desc facetDoc_created
 234
 235 orderWith (Just TitleAsc)  = asc  facetDoc_title
 236 orderWith (Just TitleDesc) = desc facetDoc_title
 237
 238 orderWith (Just ScoreAsc)  = ascNullsLast  facetDoc_score
 239 orderWith (Just ScoreDesc) = descNullsLast facetDoc_score
 240
 241 orderWith (Just SourceAsc)  = ascNullsLast  facetDoc_source
 242 orderWith (Just SourceDesc) = descNullsLast facetDoc_source
 243
 244 orderWith (Just TagAsc)     = ascNullsLast  facetDoc_category
 245 orderWith (Just TagDesc)    = descNullsLast facetDoc_category
 246
 247 orderWith _                = asc facetDoc_created
 248
 249 facetDoc_source :: SqlIsJson a
 250                 => Facet id created title (Field a) favorite ngramCount score
 251                 -> FieldNullable SqlText
 252 facetDoc_source x = (toNullable $ facetDoc_hyperdata x) .->> sqlString "source"