[phylo] working on file naming function. Now OK2 but branch length is still missing
[gargantext.git] / src / Gargantext / API / Table.hs
index 933bc3f921b3779508047da97daf85e15e186b9f..d8949007f51daea8cc15b91480cbc71e43993945 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,25 +36,35 @@ import Data.Maybe
 import Data.Swagger
 import Data.Text (Text())
 import GHC.Generics (Generic)
-import Gargantext.API.Ngrams (TabType(..))
-import Gargantext.Core.Types (Offset, Limit)
-import Gargantext.Core.Utils.Prefix (unPrefix)
-import Gargantext.Database.Facet (FacetDoc , runViewDocuments, OrderBy(..),runViewAuthorsDoc)
-import Gargantext.Database.Learn (FavOrTrash(..), moreLike)
-import Gargantext.Database.TextSearch
-import Gargantext.Database.Types.Node
-import Gargantext.Database.Utils -- (Cmd, CmdM)
-import Gargantext.Prelude
 import Servant
 import Test.QuickCheck (elements)
 import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
 
+import Gargantext.API.HashedResponse
+import Gargantext.API.Ngrams.Types (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, runCountDocuments, OrderBy(..), runViewAuthorsDoc)
+import Gargantext.Database.Action.Learn (FavOrTrash(..), moreLike)
+import Gargantext.Database.Action.Search
+import Gargantext.Database.Admin.Types.Node
+import Gargantext.Database.Prelude -- (Cmd, CmdM)
+import Gargantext.Prelude
+
 ------------------------------------------------------------------------
-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] [FacetDoc]
+              :> Post    '[JSON] FacetTableResult
+            :<|> "hash" :>
+                   Summary "Hash Table"
+                :> QueryParam "tabType" TabType
+                :> Get '[JSON] Text
 
---{-
 data TableQuery = TableQuery
   { tq_offset  :: Int
   , tq_limit   :: Int
@@ -70,42 +73,80 @@ data TableQuery = TableQuery
   , tq_query  :: Text
   } deriving (Generic)
 
+type FacetTableResult = TableResult FacetDoc
+
 $(deriveJSON (unPrefix "tq_") ''TableQuery)
 
 instance ToSchema TableQuery where
-  declareNamedSchema =
-    genericDeclareNamedSchema
-      defaultSchemaOptions {fieldLabelModifier = drop 3}
+  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "tq_")
 
 instance Arbitrary TableQuery where
   arbitrary = elements [TableQuery 0 10 DateAsc Docs "electrodes"]
 
 
-tableApi :: NodeId -> TableQuery -> Cmd err [FacetDoc]
-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
-      Docs  -> searchInCorpus cId False [q] (Just o) (Just l) (Just order)
-      Trash -> searchInCorpus cId True [q] (Just o) (Just l) (Just order)
+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]
+                -> Maybe Offset
+                -> Maybe Limit
+                -> Maybe OrderBy
+                -> Cmd err FacetTableResult
+searchInCorpus' cId t q o l order = do
+  docs          <- searchInCorpus cId t q o l order
+  countAllDocs  <- searchCountInCorpus cId t q
+  pure $ TableResult { tr_docs = docs, tr_count = countAllDocs }
+
+
 getTable :: NodeId -> Maybe TabType
+         -> Maybe Offset  -> Maybe Limit
+         -> Maybe OrderBy -> Cmd err FacetTableResult
+getTable cId ft o l order = do
+  docs      <- getTable' cId ft o l order
+  docsCount <- runCountDocuments cId (if ft == Just Trash then True else False)
+  pure $ TableResult { tr_docs = docs, tr_count = docsCount }
+
+getTable' :: NodeId -> Maybe TabType
          -> Maybe Offset  -> Maybe Limit
          -> Maybe OrderBy -> Cmd err [FacetDoc]
-getTable cId ft o l order =
+getTable' cId ft o l order =
   case ft of
-    (Just Docs)  -> runViewDocuments cId False o l order
-    (Just Trash) -> runViewDocuments cId True  o l order
+    (Just Docs)      -> runViewDocuments cId False o l order
+    (Just Trash)     -> runViewDocuments cId True  o l order
     (Just MoreFav)   -> moreLike cId o l order IsFav
     (Just MoreTrash) -> moreLike cId o l order IsTrash
     x     -> panic $ "not implemented in getTable: " <> (cs $ show x)
 
-getPairing :: ContactId -> Maybe TabType
+
+getPair :: ContactId -> Maybe TabType
          -> Maybe Offset  -> Maybe Limit
          -> Maybe OrderBy -> Cmd err [FacetDoc]
-getPairing cId ft o l order =
+getPair cId ft o l order =
   case ft of
     (Just Docs)  -> runViewAuthorsDoc cId False o l order
     (Just Trash) -> runViewAuthorsDoc cId True  o l order
     _     -> panic $ "not implemented: get Pairing" <> (cs $ show ft)
 
-