src/Gargantext/API/Table.hs

   1 {-|
   2 Module      : Gargantext.API.Node
   3 Description : Server API
   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 -- TODO-ACCESS: CanGetNode
  12 -- TODO-EVENTS: No events as this is a read only query.
  13 Node API
  14
  15 -------------------------------------------------------------------
  16 -- TODO-ACCESS: access by admin only.
  17 --              At first let's just have an isAdmin check.
  18 --              Later: check userId CanDeleteNodes Nothing
  19 -- TODO-EVENTS: DeletedNodes [NodeId]
  20 --              {"tag": "DeletedNodes", "nodes": [Int*]}
  21
  22
  23 -}
  24
  25 {-# OPTIONS_GHC -fno-warn-orphans #-}
  26
  27 {-# LANGUAGE ScopedTypeVariables  #-}
  28 {-# LANGUAGE TemplateHaskell      #-}
  29 {-# LANGUAGE TypeOperators        #-}
  30
  31 module Gargantext.API.Table
  32   where
  33
  34 import Data.Aeson.TH (deriveJSON)
  35 import Data.Maybe
  36 import Data.Swagger
  37 import Data.Text (Text())
  38 import GHC.Generics (Generic)
  39 import Servant
  40 import Test.QuickCheck (elements)
  41 import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
  42
  43 import Gargantext.API.HashedResponse
  44 import Gargantext.API.Ngrams.Types (TabType(..))
  45 import Gargantext.API.Prelude (GargServer)
  46 import Gargantext.Core.Types (TableResult(..))
  47 import Gargantext.Core.Types.Query (Offset, Limit)
  48 import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
  49 import Gargantext.Database.Action.Learn (FavOrTrash(..), moreLike)
  50 import Gargantext.Database.Action.Search
  51 import Gargantext.Database.Admin.Types.Node
  52 import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
  53 import Gargantext.Database.Query.Facet (FacetDoc , runViewDocuments, runCountDocuments, OrderBy(..), runViewAuthorsDoc)
  54 import Gargantext.Database.Prelude -- (Cmd, CmdM)
  55 import Gargantext.Prelude
  56
  57 ------------------------------------------------------------------------
  58
  59 type TableApi = Summary "Table API"
  60               :> QueryParam "tabType" TabType
  61               :> QueryParam "list" ListId
  62               :> QueryParam "limit" Limit
  63               :> QueryParam "offset" Offset
  64               :> QueryParam "orderBy" OrderBy
  65               :> QueryParam "query" Text
  66               :> QueryParam "year" Text
  67               :> Get    '[JSON] (HashedResponse FacetTableResult)
  68             :<|> Summary "Table API (POST)"
  69               :> ReqBody '[JSON] TableQuery
  70               :> Post    '[JSON] FacetTableResult
  71             :<|> "hash" :>
  72                    Summary "Hash Table"
  73                 :> QueryParam "tabType" TabType
  74                 :> Get '[JSON] Text
  75
  76 data TableQuery = TableQuery
  77   { tq_offset  :: Offset
  78   , tq_limit   :: Limit
  79   , tq_orderBy :: OrderBy
  80   , tq_view    :: TabType
  81   , tq_query   :: Text
  82   } deriving (Generic)
  83
  84 type FacetTableResult = TableResult FacetDoc
  85
  86 $(deriveJSON (unPrefix "tq_") ''TableQuery)
  87
  88 instance ToSchema TableQuery where
  89   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "tq_")
  90
  91 instance Arbitrary TableQuery where
  92   arbitrary = elements [TableQuery { tq_offset = 0
  93                                    , tq_limit = 10
  94                                    , tq_orderBy = DateAsc
  95                                    , tq_view = Docs
  96                                    , tq_query = "electrodes" }]
  97
  98
  99 tableApi :: NodeId -> GargServer TableApi
 100 tableApi id' = getTableApi id'
 101           :<|> postTableApi id'
 102           :<|> getTableHashApi id'
 103
 104
 105 getTableApi :: HasNodeError err
 106             => NodeId
 107             -> Maybe TabType
 108             -> Maybe ListId
 109             -> Maybe Limit
 110             -> Maybe Offset
 111             -> Maybe OrderBy
 112             -> Maybe Text
 113             -> Maybe Text
 114             -> Cmd err (HashedResponse FacetTableResult)
 115 getTableApi cId tabType _mListId mLimit mOffset mOrderBy mQuery mYear = do
 116   -- printDebug "[getTableApi] mQuery" mQuery
 117   -- printDebug "[getTableApi] mYear" mYear
 118   t <- getTable cId tabType mOffset mLimit mOrderBy mQuery mYear
 119   pure $ constructHashedResponse t
 120
 121 postTableApi :: HasNodeError err
 122              => NodeId -> TableQuery -> Cmd err FacetTableResult
 123 postTableApi cId (TableQuery o l order ft "") = getTable cId (Just ft) (Just o) (Just l) (Just order) Nothing Nothing
 124 postTableApi cId (TableQuery o l order ft q) = case ft of
 125       Docs  -> searchInCorpus' cId False [q] (Just o) (Just l) (Just order)
 126       Trash -> searchInCorpus' cId True [q] (Just o) (Just l) (Just order)
 127       x     -> panic $ "not implemented in tableApi " <> (cs $ show x)
 128
 129 getTableHashApi :: HasNodeError err
 130                 => NodeId -> Maybe TabType -> Cmd err Text
 131 getTableHashApi cId tabType = do
 132   HashedResponse { hash = h } <- getTableApi cId tabType Nothing Nothing Nothing Nothing Nothing Nothing
 133   pure h
 134
 135 searchInCorpus' :: CorpusId
 136                 -> Bool
 137                 -> [Text]
 138                 -> Maybe Offset
 139                 -> Maybe Limit
 140                 -> Maybe OrderBy
 141                 -> Cmd err FacetTableResult
 142 searchInCorpus' cId t q o l order = do
 143   docs          <- searchInCorpus cId t q o l order
 144   countAllDocs  <- searchCountInCorpus cId t q
 145   pure $ TableResult { tr_docs = docs, tr_count = countAllDocs }
 146
 147
 148 getTable :: HasNodeError err
 149          => NodeId
 150          -> Maybe TabType
 151          -> Maybe Offset
 152          -> Maybe Limit
 153          -> Maybe OrderBy
 154          -> Maybe Text
 155          -> Maybe Text
 156          -> Cmd err FacetTableResult
 157 getTable cId ft o l order query year = do
 158   docs      <- getTable' cId ft o l order query year
 159   docsCount <- runCountDocuments cId (ft == Just Trash) query year
 160   pure $ TableResult { tr_docs = docs, tr_count = docsCount }
 161
 162 getTable' :: HasNodeError err
 163           => NodeId
 164           -> Maybe TabType
 165           -> Maybe Offset
 166           -> Maybe Limit
 167           -> Maybe OrderBy
 168           -> Maybe Text
 169           -> Maybe Text
 170           -> Cmd err [FacetDoc]
 171 getTable' cId ft o l order query year =
 172   case ft of
 173     (Just Docs)      -> runViewDocuments cId False o l order query year
 174     (Just Trash)     -> runViewDocuments cId True  o l order query year
 175     (Just MoreFav)   -> moreLike cId o l order IsFav
 176     (Just MoreTrash) -> moreLike cId o l order IsTrash
 177     x     -> panic $ "not implemented in getTable: " <> (cs $ show x)
 178
 179
 180 getPair :: ContactId -> Maybe TabType
 181          -> Maybe Offset  -> Maybe Limit
 182          -> Maybe OrderBy -> Cmd err [FacetDoc]
 183 getPair cId ft o l order =
 184   case ft of
 185     (Just Docs)  -> runViewAuthorsDoc cId False o l order
 186     (Just Trash) -> runViewAuthorsDoc cId True  o l order
 187     _     -> panic $ "not implemented: get Pairing" <> (cs $ show ft)