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 "limit" Limit
  62               :> QueryParam "offset" Offset
  63               :> QueryParam "orderBy" OrderBy
  64               :> QueryParam "query" Text
  65               :> QueryParam "year" Text
  66               :> Get    '[JSON] (HashedResponse FacetTableResult)
  67             :<|> Summary "Table API (POST)"
  68               :> ReqBody '[JSON] TableQuery
  69               :> Post    '[JSON] FacetTableResult
  70             :<|> "hash" :>
  71                    Summary "Hash Table"
  72                 :> QueryParam "tabType" TabType
  73                 :> Get '[JSON] Text
  74
  75 data TableQuery = TableQuery
  76   { tq_offset       :: Offset
  77   , tq_limit        :: Limit
  78   , tq_orderBy      :: OrderBy
  79   , tq_view         :: TabType
  80   , tq_query        :: Text
  81   } deriving (Generic)
  82
  83 type FacetTableResult = TableResult FacetDoc
  84
  85 $(deriveJSON (unPrefix "tq_") ''TableQuery)
  86
  87 instance ToSchema TableQuery where
  88   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "tq_")
  89
  90 instance Arbitrary TableQuery where
  91   arbitrary = elements [TableQuery { tq_offset = 0
  92                                    , tq_limit = 10
  93                                    , tq_orderBy = DateAsc
  94                                    , tq_view = Docs
  95                                    , tq_query = "electrodes" }]
  96
  97
  98 tableApi :: NodeId -> GargServer TableApi
  99 tableApi id' = getTableApi id'
 100           :<|> postTableApi id'
 101           :<|> getTableHashApi id'
 102
 103
 104 getTableApi :: HasNodeError err
 105             => NodeId
 106             -> Maybe TabType
 107             -> Maybe Limit
 108             -> Maybe Offset
 109             -> Maybe OrderBy
 110             -> Maybe Text
 111             -> Maybe Text
 112             -> Cmd err (HashedResponse FacetTableResult)
 113 getTableApi cId tabType mLimit mOffset mOrderBy mQuery mYear = do
 114   -- printDebug "[getTableApi] mQuery" mQuery
 115   -- printDebug "[getTableApi] mYear" mYear
 116   t <- getTable cId tabType mOffset mLimit mOrderBy mQuery mYear
 117   pure $ constructHashedResponse t
 118
 119 postTableApi :: HasNodeError err
 120              => NodeId -> TableQuery -> Cmd err FacetTableResult
 121 postTableApi cId (TableQuery o l order ft "") = getTable cId (Just ft) (Just o) (Just l) (Just order) Nothing Nothing
 122 postTableApi cId (TableQuery o l order ft q) = case ft of
 123       Docs  -> searchInCorpus' cId False [q] (Just o) (Just l) (Just order)
 124       Trash -> searchInCorpus' cId True [q] (Just o) (Just l) (Just order)
 125       x     -> panic $ "not implemented in tableApi " <> (cs $ show x)
 126
 127 getTableHashApi :: HasNodeError err
 128                 => NodeId -> Maybe TabType -> Cmd err Text
 129 getTableHashApi cId tabType = do
 130   HashedResponse { hash = h } <- getTableApi cId tabType Nothing Nothing Nothing Nothing Nothing
 131   pure h
 132
 133 searchInCorpus' :: CorpusId
 134                 -> Bool
 135                 -> [Text]
 136                 -> Maybe Offset
 137                 -> Maybe Limit
 138                 -> Maybe OrderBy
 139                 -> Cmd err FacetTableResult
 140 searchInCorpus' cId t q o l order = do
 141   docs          <- searchInCorpus cId t q o l order
 142   countAllDocs  <- searchCountInCorpus cId t q
 143   pure $ TableResult { tr_docs = docs, tr_count = countAllDocs }
 144
 145
 146 getTable :: HasNodeError err
 147          => NodeId
 148          -> Maybe TabType
 149          -> Maybe Offset
 150          -> Maybe Limit
 151          -> Maybe OrderBy
 152          -> Maybe Text
 153          -> Maybe Text
 154          -> Cmd err FacetTableResult
 155 getTable cId ft o l order query year = do
 156   docs      <- getTable' cId ft o l order query year
 157   docsCount <- runCountDocuments cId (ft == Just Trash) query year
 158   pure $ TableResult { tr_docs = docs, tr_count = docsCount }
 159
 160 getTable' :: HasNodeError err
 161           => NodeId
 162           -> Maybe TabType
 163           -> Maybe Offset
 164           -> Maybe Limit
 165           -> Maybe OrderBy
 166           -> Maybe Text
 167           -> Maybe Text
 168           -> Cmd err [FacetDoc]
 169 getTable' cId ft o l order query year =
 170   case ft of
 171     (Just Docs)      -> runViewDocuments cId False o l order query year
 172     (Just Trash)     -> runViewDocuments cId True  o l order query year
 173     (Just MoreFav)   -> moreLike cId o l order IsFav
 174     (Just MoreTrash) -> moreLike cId o l order IsTrash
 175     x     -> panic $ "not implemented in getTable: " <> (cs $ show x)
 176
 177
 178 getPair :: ContactId -> Maybe TabType
 179          -> Maybe Offset  -> Maybe Limit
 180          -> Maybe OrderBy -> Cmd err [FacetDoc]
 181 getPair cId ft o l order =
 182   case ft of
 183     (Just Docs)  -> runViewAuthorsDoc cId False o l order
 184     (Just Trash) -> runViewAuthorsDoc cId True  o l order
 185     _     -> panic $ "not implemented: get Pairing" <> (cs $ show ft)