{-# OPTIONS_GHC -fno-warn-orphans #-}
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeOperators #-}
import Data.Swagger
import Data.Text (Text())
import GHC.Generics (Generic)
+import Servant
+import Test.QuickCheck (elements)
+import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
+
+import Gargantext.API.HashedResponse
import Gargantext.API.Ngrams (TabType(..))
+import Gargantext.API.Prelude (GargServer)
import Gargantext.Core.Types (Offset, Limit, TableResult(..))
import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
-import Gargantext.Database.Action.Query.Facet (FacetDoc , runViewDocuments, OrderBy(..), runViewAuthorsDoc)
+import Gargantext.Database.Query.Facet (FacetDoc , runViewDocuments, OrderBy(..), runViewAuthorsDoc)
import Gargantext.Database.Action.Learn (FavOrTrash(..), moreLike)
import Gargantext.Database.Action.Search
import Gargantext.Database.Admin.Types.Node
-import Gargantext.Database.Admin.Utils -- (Cmd, CmdM)
+import Gargantext.Database.Prelude -- (Cmd, CmdM)
import Gargantext.Prelude
-import Servant
-import Test.QuickCheck (elements)
-import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
------------------------------------------------------------------------
-type TableApi = Summary " Table API"
+type TableApi = Summary "Table API"
+ :> QueryParam "tabType" TabType
+ :> Get '[JSON] (HashedResponse FacetTableResult)
+ :<|> Summary "Table API (POST)"
:> ReqBody '[JSON] TableQuery
:> Post '[JSON] FacetTableResult
+ :<|> "hash" :>
+ Summary "Hash Table"
+ :> QueryParam "tabType" TabType
+ :> Get '[JSON] Text
data TableQuery = TableQuery
{ tq_offset :: Int
arbitrary = elements [TableQuery 0 10 DateAsc Docs "electrodes"]
-tableApi :: NodeId -> TableQuery -> Cmd err FacetTableResult
-tableApi cId (TableQuery o l order ft "") = getTable cId (Just ft) (Just o) (Just l) (Just order)
-tableApi cId (TableQuery o l order ft q) = case ft of
+tableApi :: NodeId -> GargServer TableApi
+tableApi id' = getTableApi id'
+ :<|> postTableApi id'
+ :<|> getTableHashApi id'
+
+
+getTableApi :: NodeId -> Maybe TabType -> Cmd err (HashedResponse FacetTableResult)
+getTableApi cId tabType = do
+ t <- getTable cId tabType Nothing Nothing Nothing
+ pure $ constructHashedResponse t
+
+
+postTableApi :: NodeId -> TableQuery -> Cmd err FacetTableResult
+postTableApi cId (TableQuery o l order ft "") = getTable cId (Just ft) (Just o) (Just l) (Just order)
+postTableApi cId (TableQuery o l order ft q) = case ft of
Docs -> searchInCorpus' cId False [q] (Just o) (Just l) (Just order)
Trash -> searchInCorpus' cId True [q] (Just o) (Just l) (Just order)
x -> panic $ "not implemented in tableApi " <> (cs $ show x)
+getTableHashApi :: NodeId -> Maybe TabType -> Cmd err Text
+getTableHashApi cId tabType = do
+ HashedResponse { hash = h } <- getTableApi cId tabType
+ pure h
+
searchInCorpus' :: CorpusId
-> Bool
-> [Text]