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