Merge remote-tracking branch...

Merge remote-tracking branch 'origin/337-node-phylo-export-the-phylo-in-json-and-dot-format' into dev

gargantext.cabal

@@ -296,6 +296,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 Data.Aeson
+import Data.Text qualified as T
+import Gargantext.API.Node.Phylo.Export.Types
+import Gargantext.API.Prelude (GargNoServer, GargServer)
+import Gargantext.Core.Viz.Phylo.API.Tools
+import Gargantext.Core.Viz.Phylo.Example (phyloCleopatre)
+import Gargantext.Database.Admin.Types.Node (PhyloId, NodeId,)
+import Gargantext.Prelude
+import Servant
+
+api :: NodeId
+    -- ^ The ID of the target user
+    -> PhyloId
+    -> GargServer API
+api userNodeId dId = getPhyloJson userNodeId dId 
+                :<|> getPhyloDot userNodeId dId
+
+getPhyloJson  :: NodeId
+                -- ^ The ID of the target user
+              -> PhyloId
+              -> GargNoServer (Headers '[Header "Content-Disposition" T.Text] Value)
+getPhyloJson _ pId = do
+  maybePhyloData <- getPhyloData pId
+  let phyloData = fromMaybe phyloCleopatre maybePhyloData
+  phyloJson <- liftBase $ phylo2dot2json phyloData
+  pure $ addHeader (T.concat [ "attachment; filename="
+                                          , "GarganText_Phylo-"
+                                          , T.pack (show pId)
+                                          , ".json" ])
+                                          phyloJson
+
+
+getPhyloDot :: NodeId
+            -> PhyloId
+            -> GargNoServer (Headers '[Header "Content-Disposition" T.Text] T.Text)
+getPhyloDot _ pId = do
+  maybePhyloData <- getPhyloData pId
+  let phyloData = fromMaybe phyloCleopatre maybePhyloData
+  phyloDot <- liftBase $ phylo2dot phyloData
+  pure $ addHeader (T.concat [ "attachment; filename="
+                                          , "GarganText_Phylo-"
+                                          , T.pack (show pId)
+                                          , ".dot" ])
+                                          phyloDot
\ No newline at end of file

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
+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, Summary) --, PlainText, MimeRender(..)
+
+
+-- | Phylo Export
+data PhyloExport =
+  PhyloExport { _pe_phylos    :: [Phylo]
+              , _pe_garg_version :: Text
+              } deriving (Generic)
+
+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] Value)
+               :<|> "dot"
+                 :> Get '[JSON] (Headers '[Servant.Header "Content-Disposition" Text] Text)
+                )
+
+-- type API = Summary "Phylo Export"
+--             :> "export"
+--                  :> Get '[JSON,DOT] (Headers '[Servant.Header "Content-Disposition" Text] Value)
+
+
+
+
+$(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

@@ -42,6 +42,8 @@ import Gargantext.API.Node.Corpus.Export 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
@@ -154,9 +156,12 @@ type GargPrivateAPI' =
                            :> "ngrams"
                            :> TableNgramsApi
 
-           :<|> "texts" :> Capture "node_id" DocId
+           :<|> "texts"    :> Capture "node_id" DocId
                            :> DocumentExport.API
 
+           :<|> "phylo"     :> Capture "node_id" DocId
+                            :> PhyloExport.API
+
         -- :<|> "counts" :> Stream GET NewLineFraming '[JSON] Count :> CountAPI
             -- TODO-SECURITY
            :<|> "count"    :> Summary "Count endpoint"
@@ -172,6 +177,10 @@ type GargPrivateAPI' =
                            :> Capture "graph_id" NodeId
                            :> GraphAPI
 
+          --  :<|> "phylo"    :> Summary "Phylo endpoint"
+          --                  :> Capture "pylo_id" NodeId
+          --                  :> 
+
            -- TODO move to NodeAPI?
            -- Tree endpoint
            :<|> "tree"    :> Summary "Tree endpoint"
@@ -258,6 +267,8 @@ serverPrivateGargAPI' authenticatedUser@(AuthenticatedUser userNodeId userId)
 
      :<|> DocumentExport.api userNodeId
 
+     :<|> PhyloExport.api userNodeId
+
      :<|> count -- TODO: undefined
 
      -- :<|> withAccess (Proxy :: Proxy (Search.API Search.SearchResult)) Proxy uid

src/Gargantext/Core/Viz/Phylo/API/Tools.hs

@@ -76,7 +76,8 @@ phylo2dot2json phylo = do
         fileDot  = dirPath </> "phylo.dot"
         fileToJson = dirPath </> "output.json"
 
-    dotToFile fileFrom (toPhyloExport phylo)
+    phyloContent <- phylo2dot phylo
+    writeFile fileFrom phyloContent
 
     -- parsing a file can be done with:
     -- runParser' (Data.GraphViz.Parsing.parse :: Parse (Data.GraphViz.DotGraph Text)) $ TL.fromStrict f
@@ -91,6 +92,20 @@ phylo2dot2json phylo = do
       Just v  -> pure v
 
 
+phylo2dot :: Phylo -> IO Text
+phylo2dot phylo = do
+  withTempDirectory "/tmp" "phylo" $ \dirPath -> do
+    let fileFrom = dirPath </> "phyloFrom.dot"
+
+    dotToFile fileFrom (toPhyloExport phylo)
+
+    value <- readFile fileFrom
+
+    case value of
+      ""  -> panic "[G.C.V.Phylo.API.phylo2dot] Error no file"
+      _   -> pure value
+
+
 flowPhyloAPI :: (HasNodeStory env err m, HasNodeError err, MonadLogger m)
              => PhyloConfig -> CorpusId -> m Phylo
 flowPhyloAPI config cId = do