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 (Offset, Limit, TableResult(..))
  47 import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
  48 import Gargantext.Database.Action.Learn (FavOrTrash(..), moreLike)
  49 import Gargantext.Database.Action.Search
  50 import Gargantext.Database.Admin.Types.Node
  51 import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
  52 import Gargantext.Database.Query.Facet (FacetDoc , runViewDocuments, runCountDocuments, OrderBy(..), runViewAuthorsDoc)
  53 import Gargantext.Database.Prelude -- (Cmd, CmdM)
  54 import Gargantext.Prelude
  55
  56 ------------------------------------------------------------------------
  57
  58 type TableApi = Summary "Table API"
  59               :> QueryParam "tabType" TabType
  60               :> QueryParam "list" ListId
  61               :> QueryParam "limit" Int
  62               :> QueryParam "offset" Int
  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  :: Int
  77   , tq_limit   :: Int
  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 ListId
 108             -> Maybe Int
 109             -> Maybe Int
 110             -> Maybe OrderBy
 111             -> Maybe Text
 112             -> Maybe Text
 113             -> Cmd err (HashedResponse FacetTableResult)
 114 getTableApi cId tabType _mListId mLimit mOffset mOrderBy mQuery mYear = do
 115   -- printDebug "[getTableApi] mQuery" mQuery
 116   -- printDebug "[getTableApi] mYear" mYear
 117   t <- getTable cId tabType mOffset mLimit mOrderBy mQuery mYear
 118   pure $ constructHashedResponse t
 119
 120 postTableApi :: HasNodeError err
 121              => NodeId -> TableQuery -> Cmd err FacetTableResult
 122 postTableApi cId (TableQuery o l order ft "") = getTable cId (Just ft) (Just o) (Just l) (Just order) Nothing Nothing
 123 postTableApi cId (TableQuery o l order ft q) = case ft of
 124       Docs  -> searchInCorpus' cId False [q] (Just o) (Just l) (Just order)
 125       Trash -> searchInCorpus' cId True [q] (Just o) (Just l) (Just order)
 126       x     -> panic $ "not implemented in tableApi " <> (cs $ show x)
 127
 128 getTableHashApi :: HasNodeError err
 129                 => NodeId -> Maybe TabType -> Cmd err Text
 130 getTableHashApi cId tabType = do
 131   HashedResponse { hash = h } <- getTableApi cId tabType Nothing Nothing Nothing Nothing Nothing Nothing
 132   pure h
 133
 134 searchInCorpus' :: CorpusId
 135                 -> Bool
 136                 -> [Text]
 137                 -> Maybe Offset
 138                 -> Maybe Limit
 139                 -> Maybe OrderBy
 140                 -> Cmd err FacetTableResult
 141 searchInCorpus' cId t q o l order = do
 142   docs          <- searchInCorpus cId t q o l order
 143   countAllDocs  <- searchCountInCorpus cId t q
 144   pure $ TableResult { tr_docs = docs, tr_count = countAllDocs }
 145
 146
 147 getTable :: HasNodeError err
 148          => NodeId
 149          -> Maybe TabType
 150          -> Maybe Offset
 151          -> Maybe Limit
 152          -> Maybe OrderBy
 153          -> Maybe Text
 154          -> Maybe Text
 155          -> Cmd err FacetTableResult
 156 getTable cId ft o l order query year = do
 157   docs      <- getTable' cId ft o l order query year
 158   docsCount <- runCountDocuments cId (ft == Just Trash) query year
 159   pure $ TableResult { tr_docs = docs, tr_count = docsCount }
 160
 161 getTable' :: HasNodeError err
 162           => NodeId
 163           -> Maybe TabType
 164           -> Maybe Offset
 165           -> Maybe Limit
 166           -> Maybe OrderBy
 167           -> Maybe Text
 168           -> Maybe Text
 169           -> Cmd err [FacetDoc]
 170 getTable' cId ft o l order query year =
 171   case ft of
 172     (Just Docs)      -> runViewDocuments cId False o l order query year
 173     (Just Trash)     -> runViewDocuments cId True  o l order query year
 174     (Just MoreFav)   -> moreLike cId o l order IsFav
 175     (Just MoreTrash) -> moreLike cId o l order IsTrash
 176     x     -> panic $ "not implemented in getTable: " <> (cs $ show x)
 177
 178
 179 getPair :: ContactId -> Maybe TabType
 180          -> Maybe Offset  -> Maybe Limit
 181          -> Maybe OrderBy -> Cmd err [FacetDoc]
 182 getPair cId ft o l order =
 183   case ft of
 184     (Just Docs)  -> runViewAuthorsDoc cId False o l order
 185     (Just Trash) -> runViewAuthorsDoc cId True  o l order
 186     _     -> panic $ "not implemented: get Pairing" <> (cs $ show ft)