added dummy user data to test the new endpoint

gargantext.cabal

@@ -276,6 +276,8 @@ library
       Gargantext.API.Node.Corpus.Searx
       Gargantext.API.Node.Document.Export
       Gargantext.API.Node.Document.Export.Types
+      Gargantext.API.Node.Phylo.Export
+      Gargantext.API.Node.Phylo.Export.Types
       Gargantext.API.Node.DocumentUpload
       Gargantext.API.Node.DocumentsFromWriteNodes
       Gargantext.API.Node.FrameCalcUpload

src/Gargantext/API/Node/Phylo/Export.hs

+{-|
+Module      : Gargantext.API.Node.Phylo.Export
+Description : Phylo export
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+-}
+
+module Gargantext.API.Node.Phylo.Export
+  where
+
+-- import Control.Lens (view)
+-- import Data.ByteString.Lazy.Char8 qualified as BSC
+-- import Data.Csv (encodeDefaultOrderedByName)
+import Data.Text qualified as T
+-- import Data.Text.Encoding qualified as TE
+-- import Data.Version (showVersion)
+import Gargantext.API.Node.Phylo.Export.Types
+import Gargantext.API.Prelude (GargNoServer, GargServer)
+-- import Gargantext.Core (toDBid)
+import Gargantext.Database.Admin.Types.Node (PhyloId, NodeId,) -- NodeType(..))
+-- import Gargantext.Database.Query.Facet (runViewDocuments, Facet(..))
+-- import Gargantext.Database.Query.Table.Node (getClosestParentIdByType)
+-- import Gargantext.Database.Query.Table.Node.User ( getNodeUser )
+-- import Gargantext.Database.Schema.Node (NodePoly(..), node_user_id)
+import Gargantext.Prelude
+-- import Paths_gargantext qualified as PG -- cabal magic build module
+import Servant --( addHeader, (:<|>)((:<|>)), Header, Headers(getResponse) )
+
+api :: NodeId
+    -- ^ The ID of the target user
+    -> PhyloId
+    -> GargServer API
+api userNodeId dId = getTest userNodeId dId
+                :<|> getTest2 userNodeId dId
+
+getTest :: NodeId
+    -- ^ The ID of the target user
+    -> PhyloId
+    -> GargNoServer (Headers '[Header "Content-Disposition" T.Text] User)
+getTest _ pId = pure $ addHeader (T.concat [ "attachment; filename="
+                                          , "GarganText_DocsList-"
+                                          , T.pack (show pId)
+                                          , ".json" ])
+                                          User {
+                                              _us_name = "test"
+                                            , _us_age = 80
+                                            , _us_email = "mail"
+                                          }
+
+getTest2 :: NodeId
+    -- ^ The ID of the target user
+    -> PhyloId
+    -> GargNoServer (Headers '[Header "Content-Disposition" T.Text] User)
+getTest2 _ pId = pure $ addHeader (T.concat [ "attachment; filename="
+                                          , "GarganText_DocsList-"
+                                          , T.pack (show pId)
+                                          , ".json" ])
+                                          User {
+                                              _us_name = "test2"
+                                            , _us_age = 82
+                                            , _us_email = "mail2"
+                                          }
+
+-- api userNodeId dId = getDocumentsJSON userNodeId dId
+--                 :<|> getDocumentsJSONZip userNodeId dId
+--                 :<|> getDocumentsCSV userNodeId dId
+
+
+--------------------------------------------------
+-- | Hashes are ordered by Set
+-- getDocumentsJSON :: NodeId
+--                  -- ^ The ID of the target user
+--                  -> PhyloId
+--                  -> GargNoServer (Headers '[Header "Content-Disposition" T.Text] DocumentExport)
+-- getDocumentsJSON nodeUserId pId = do
+--   uId <- view node_user_id <$> getNodeUser nodeUserId
+--   mcId <- getClosestParentIdByType pId NodeCorpus
+--   let cId = maybe (panicTrace "[G.A.N.D.Export] Node has no parent") identity mcId
+--   docs <- runViewDocuments cId False Nothing Nothing Nothing Nothing Nothing
+--   let dexp = DocumentExport { _de_documents = mapFacetDoc uId <$> docs
+--                             , _de_garg_version = T.pack $ showVersion PG.version }
+--   pure $ addHeader (T.concat [ "attachment; filename="
+--                              , "GarganText_DocsList-"
+--                              , T.pack (show pId)
+--                              , ".json" ]) dexp
+--   where
+--     mapFacetDoc uId (FacetDoc { .. }) =
+--       Phylo { _d_document =
+--                  Node { _node_id = facetDoc_id
+--                       , _node_hash_id = Nothing
+--                       , _node_typename = toDBid NodeDocument
+--                       , _node_user_id = uId
+--                       , _node_parent_id = Nothing
+--                       , _node_name = facetDoc_title
+--                       , _node_date = facetDoc_created
+--                       , _node_hyperdata = facetDoc_hyperdata }
+--                , _d_ngrams = Ngrams { _ng_ngrams = []
+--                                     , _ng_hash = "" }
+--                , _d_hash = "" }
+--     _mapDoc d = Phylo { _d_document = d
+--                          , _d_ngrams   = Ngrams { _ng_ngrams = []
+--                                                 , _ng_hash = "" }
+--                          , _d_hash     = ""}
+
+-- getDocumentsJSONZip :: NodeId
+--                     -- ^ The Node ID of the target user
+--                     -> PhyloId
+--                     -> GargNoServer (Headers '[Header "Content-Disposition" T.Text] DocumentExportZIP) -- [Phylo]
+-- getDocumentsJSONZip userNodeId pId = do
+--   dJSON <- getDocumentsJSON userNodeId pId
+--   let dexp = getResponse dJSON
+--   let dexpz = DocumentExportZIP { _dez_dexp = dexp, _dez_doc_id = pId }
+--   pure $ addHeader (T.concat [ "attachment; filename="
+--                              , dezFileName dexpz
+--                              , ".zip" ]) dexpz
+
+-- getDocumentsCSV :: NodeId
+--                 -- ^ The Node ID of the target user
+--                 -> PhyloId
+--                 -> GargNoServer (Headers '[Header "Content-Disposition" T.Text] T.Text) -- [Phylo]
+-- getDocumentsCSV userNodeId pId = do
+--   dJSON <- getDocumentsJSON userNodeId pId
+--   let DocumentExport { _de_documents } = getResponse dJSON
+--   let ret = TE.decodeUtf8 $ BSC.toStrict $ encodeDefaultOrderedByName _de_documents
+
+--   pure $ addHeader (T.concat [ "attachment; filename=GarganText_DocsList-"
+--                              , T.pack $ show pId
+--                              , ".csv"])
+--     ret

src/Gargantext/API/Node/Phylo/Export/Types.hs

+{-|
+Module      : Gargantext.API.Node.Phylo.Export.Types
+Description : Types for Gargantext.API.Node.Phylo.Export
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+-}
+
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeOperators   #-}
+
+module Gargantext.API.Node.Phylo.Export.Types where
+
+import Data.Aeson (ToJSON, encode)
+import Data.Aeson.TH (deriveJSON)
+-- import Data.Csv (DefaultOrdered(..), ToNamedRecord(..), (.=), header, namedRecord)
+import Data.Swagger ( genericDeclareNamedSchema, ToParamSchema(..), ToSchema(..) )
+-- import Data.Text qualified as T
+-- import Data.Text.Encoding qualified as TE
+import Gargantext.Core.Types ( Node, TODO )
+import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
+import Gargantext.Database.Admin.Types.Hyperdata.Phylo ( HyperdataPhylo(..) )
+import Gargantext.Database.Admin.Types.Node (PhyloId)
+-- import Gargantext.Database.Schema.Node (NodePoly(..))
+-- import Gargantext.Utils.Servant (ZIP)
+-- import Gargantext.Utils.Zip (zipContentsPure)
+import Protolude
+import Servant ((:>), (:<|>), Get, Header, Headers(..), JSON, MimeRender(..), Summary) --, PlainText
+
+
+-- | Phylo Export
+data PhyloExport =
+  PhyloExport { _pe_phylos    :: [Phylo]
+              , _pe_garg_version :: Text
+              } deriving (Generic)
+
+-- | This is to represent a zipped phylo export. We want to have doc_id in zipped file name.
+data PhyloExportDOT =
+  PhyloExportDOT  { _ped_dexp   :: PhyloExport
+                  , _ped_doc_id :: PhyloId 
+                  } deriving (Generic)
+
+data PhyloExportJSON = 
+  PhyloExportJSON { _pej_pexp     :: PhyloExport
+                  , _pej_phy_id   :: PhyloId
+                  } deriving (Generic)
+    
+    
+data Phylo =
+  Phylo { _p_phylo    :: Node HyperdataPhylo
+        , _p_hash     :: Hash
+        } deriving (Generic)
+
+--instance Read Phylo where
+--  read "" = panic "not implemented"
+-- instance DefaultOrdered Phylo where
+--   headerOrder _ = header ["Publication Day"
+--                          , "Publication Month"
+--                          , "Publication Year"
+--                          , "Authors"
+--                          , "Title"
+--                          , "Source"
+--                          , "Abstract"]
+-- instance ToNamedRecord Phylo where
+--   toNamedRecord (Phylo { _p_phylo = Node { .. }}) =
+--     namedRecord
+--     [ "Publication Day" .= _hd_publication_day _node_hyperdata
+--     , "Publication Month" .= _hd_publication_month _node_hyperdata
+--     , "Publication Year" .= _hd_publication_year _node_hyperdata
+--     , "Authors" .= _hd_authors _node_hyperdata
+--     , "Title" .= _hd_title _node_hyperdata
+--     , "Source" .= (TE.encodeUtf8 <$> _hd_source _node_hyperdata)
+--     , "Abstract" .= (TE.encodeUtf8 <$> _hd_abstract _node_hyperdata) ]
+
+
+type Hash = Text
+-------
+instance ToSchema PhyloExport where
+  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_pe_")
+
+instance ToSchema PhyloExportDOT where
+  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_ped_")
+  
+instance ToSchema Phylo where
+  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_p_")
+
+
+-------
+instance ToParamSchema PhyloExport where
+  toParamSchema _ = toParamSchema (Proxy :: Proxy TODO)
+
+instance ToParamSchema PhyloExportDOT where
+  toParamSchema _ = toParamSchema (Proxy :: Proxy TODO)
+
+instance ToParamSchema Phylo where
+  toParamSchema _ = toParamSchema (Proxy :: Proxy TODO)
+
+--------------------------------------------------
+type API = Summary "Phylo Export"
+            :> "export"
+            :> ( "json"
+                 :> Get '[JSON] (Headers '[Servant.Header "Content-Disposition" Text] User)
+               :<|> "dot"
+                 :> Get '[JSON] (Headers '[Servant.Header "Content-Disposition" Text] User)
+                )
+
+data User = User
+  { _us_name :: Text
+  , _us_age :: Int
+  , _us_email :: Text
+  } deriving (Eq, Show, Generic)
+
+instance ToJSON User
+
+instance ToSchema User where
+  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_us_")
+
+instance ToParamSchema User where
+  toParamSchema _ = toParamSchema (Proxy :: Proxy TODO)
+
+instance MimeRender JSON User where
+  mimeRender _ = encode
+
+$(deriveJSON (unPrefix "_p_") ''Phylo)
+$(deriveJSON (unPrefix "_pe_") ''PhyloExport)
+
+
+------
+
+-- Needs to be here because of deriveJSON TH above
+
+-- pedFileName :: PhyloExportDOT -> Text
+-- pedFileName (PhyloExportDOT { .. }) = "GarganText_DocsList-" <> show _ped_doc_id <> ".dot"
+    
+-- instance MimeRender ZIP PhyloExportDOT where
+--   mimeRender _ dexpz@(PhyloExportDOT { .. }) =
+--     zipContentsPure (T.unpack $ pedFileName dexpz) (encode _ped_dexp)

src/Gargantext/API/Routes.hs

@@ -43,6 +43,8 @@ import Gargantext.API.Node.Corpus.Export.Types qualified as CorpusExport
 import Gargantext.API.Node.Corpus.New qualified as New
 import Gargantext.API.Node.Document.Export qualified as DocumentExport
 import Gargantext.API.Node.Document.Export.Types qualified as DocumentExport
+import Gargantext.API.Node.Phylo.Export qualified as PhyloExport
+import Gargantext.API.Node.Phylo.Export.Types qualified as PhyloExport
 import Gargantext.API.Node.ShareURL qualified as ShareURL
 import Gargantext.API.Prelude
 import Gargantext.API.Public qualified as Public
@@ -178,9 +180,20 @@ type GargPrivateAPI' =
                            :> "ngrams"
                            :> TableNgramsApi
 
-           :<|> "texts" :> Capture "node_id" DocId
+           :<|> "texts"    :> Capture "node_id" DocId
                            :> DocumentExport.API
 
+          --  :<|> "phylo"     :> Capture "node_id" DocId
+          --                   :> DocumentExport.API
+
+           :<|> "phylo"     :> Capture "node_id" DocId
+                            :> PhyloExport.API
+
+          -- :<|> "phylo"  :> Capture "phylo_id" PhyloId
+          --               :> Capture "action" Text
+          --               :> Capture "format" Text
+          --               :> Raw
+
         -- :<|> "counts" :> Stream GET NewLineFraming '[JSON] Count :> CountAPI
             -- TODO-SECURITY
            :<|> "count"    :> Summary "Count endpoint"
@@ -282,6 +295,8 @@ serverPrivateGargAPI' authenticatedUser@(AuthenticatedUser userNodeId userId)
 
      :<|> DocumentExport.api userNodeId
 
+     :<|> PhyloExport.api userNodeId
+
      :<|> count -- TODO: undefined
 
      -- :<|> withAccess (Proxy :: Proxy (Search.API Search.SearchResult)) Proxy uid