add phylo export dot format

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

@@ -11,39 +11,27 @@ 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.Aeson
--- import Debug.Trace qualified as DT
 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.Core.Viz.Phylo.API.Tools
 import Gargantext.Core.Viz.Phylo.Example (phyloCleopatre)
-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.Database.Admin.Types.Node (PhyloId, NodeId,)
 import Gargantext.Prelude
--- import Paths_gargantext qualified as PG -- cabal magic build module
-import Servant --( addHeader, (:<|>)((:<|>)), Header, Headers(getResponse) )
+import Servant
 
 api :: NodeId
     -- ^ The ID of the target user
     -> PhyloId
     -> GargServer API
 api userNodeId dId = getPhylo userNodeId dId 
-                -- :<|> getTest2 userNodeId dId
+                :<|> getPhyloDot userNodeId dId
 
 getPhylo :: NodeId
           -- ^ The ID of the target user
-          -> PhyloId
-          -> GargNoServer (Headers '[Header "Content-Disposition" T.Text] Value)
+         -> PhyloId
+         -> GargNoServer (Headers '[Header "Content-Disposition" T.Text] Value)
 getPhylo _ pId = do
   maybePhyloData <- getPhyloData pId
   let phyloData = fromMaybe phyloCleopatre maybePhyloData
@@ -54,97 +42,16 @@ getPhylo _ pId = do
                                           , ".json" ])
                                           phyloJson
 
--- 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_Phylo-"
---                                           , 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="
+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" ])
-                                          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
+                                          phyloDot
\ No newline at end of file

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

@@ -98,19 +98,19 @@ instance ToParamSchema Phylo where
   toParamSchema _ = toParamSchema (Proxy :: Proxy TODO)
 
 --------------------------------------------------
-type APITest = Summary "Phylo Export"
+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] User)
+                 :> Get '[JSON] (Headers '[Servant.Header "Content-Disposition" Text] Text)
                 )
 
-type API = Summary "Phylo Export"
-            :> "export"
-            :> ( "json"
-                 :> Get '[JSON] (Headers '[Servant.Header "Content-Disposition" Text] Value)
-                )
+-- type API = Summary "Phylo Export"
+--             :> "export"
+--             :> ( "json"
+--                  :> Get '[JSON] (Headers '[Servant.Header "Content-Disposition" Text] Value)
+--                 )
 
 
 data User = User

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

@@ -54,6 +54,7 @@ import Prelude qualified
 import System.FilePath ((</>))
 import System.IO.Temp (withTempDirectory)
 import System.Process qualified as Shell
+-- import Debug.Trace qualified as DT
 
 --------------------------------------------------------------------
 getPhyloData :: HasNodeError err
@@ -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.phylo2dot2json] Error no file"
+      _   -> pure value
+
+
 flowPhyloAPI :: (HasNodeStory env err m, HasNodeError err, MonadLogger m)
              => PhyloConfig -> CorpusId -> m Phylo
 flowPhyloAPI config cId = do