Merge branch 'dev-doc-annotation-issue' of https://gitlab.iscpif.fr/gargantext/haskel...
[gargantext.git] / src / Gargantext / API / Table.hs
index d5fa8e4bc22bd50c1d573664f66dbfb529aed3a9..4e69bdbc55eff2ad28ff5a268bc3dfb43b8d88f8 100644 (file)
@@ -24,13 +24,6 @@ Node API
 
 {-# 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        #-}
@@ -43,24 +36,34 @@ import Data.Maybe
 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.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
@@ -81,13 +84,30 @@ instance Arbitrary TableQuery where
   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]