[Graph] add gexf exporter to graph endpoint

src/Gargantext/Prelude.hs

@@ -52,6 +52,7 @@ import Protolude ( Bool(True, False), Int, Int64, Double, Integer
                  , (+), (*), (/), (-), (.), ($), (&), (**), (^), (<), (>), log
                  , Eq, (==), (>=), (<=), (<>), (/=)
                  , (&&), (||), not, any, all
+                 , concatMap
                  , fst, snd, toS
                  , elem, die, mod, div, const, either
                  , curry, uncurry, repeat

src/Gargantext/Viz/Graph/API.hs

@@ -28,7 +28,13 @@ module Gargantext.Viz.Graph.API
 import Control.Concurrent -- (forkIO)
 import Control.Lens (set, (^.), _Just, (^?))
 import Control.Monad.IO.Class (liftIO)
+import qualified Data.HashMap.Lazy as HashMap
+import qualified Data.Map as Map
 import Data.Maybe (Maybe(..))
+import Servant
+import Servant.XML
+import qualified Xmlbf as Xmlbf
+
 import Gargantext.API.Ngrams (NgramsRepo, r_version)
 import Gargantext.API.Ngrams.Tools
 import Gargantext.API.Types
@@ -42,10 +48,48 @@ import Gargantext.Database.Types.Node hiding (node_id) -- (GraphId, ListId, Corp
 import Gargantext.Database.Node.UpdateOpaleye (updateHyperdata)
 import Gargantext.Database.Utils (Cmd)
 import Gargantext.Prelude
+import qualified Gargantext.Prelude as P
 import Gargantext.Viz.Graph
+import qualified Gargantext.Viz.Graph as G
 import Gargantext.Viz.Graph.Tools -- (cooc2graph)
-import Servant
-import qualified Data.Map as Map
+
+instance Xmlbf.ToXml Graph where
+  toXml (Graph { _graph_nodes = graphNodes
+                , _graph_edges = graphEdges }) = root graphNodes graphEdges
+    where
+      root :: [G.Node] -> [G.Edge] -> [Xmlbf.Node]
+      root gn ge =
+        Xmlbf.element "gexf" params $ meta <> (graph gn ge)
+        where
+          params = HashMap.fromList [ ("xmlns", "http://www.gexf.net/1.2draft")
+                                    , ("version", "1.2") ]
+      meta = Xmlbf.element "meta" params $ creator <> description
+        where
+          params = HashMap.fromList [ ("lastmodifieddate", "2020-03-13") ]
+      creator = Xmlbf.element "Gargantext.org" HashMap.empty []
+      description = Xmlbf.element "Gargantext gexf file" HashMap.empty []
+      graph :: [G.Node] -> [G.Edge] -> [Xmlbf.Node]
+      graph gn ge = Xmlbf.element "graph" params $ (nodes gn) <> (edges ge)
+        where
+          params = HashMap.fromList [ ("mode", "static")
+                                    , ("defaultedgetype", "directed") ]
+      nodes :: [G.Node] -> [Xmlbf.Node]
+      nodes gn = Xmlbf.element "nodes" HashMap.empty $ P.concatMap node gn
+      node :: G.Node -> [Xmlbf.Node]
+      node (G.Node { node_id = nId, node_label = l }) =
+        Xmlbf.element "node" params []
+        where
+          params = HashMap.fromList [ ("id", nId)
+                                    , ("label", l) ]
+      edges :: [G.Edge] -> [Xmlbf.Node]
+      edges gn = Xmlbf.element "edges" HashMap.empty $ P.concatMap edge gn
+      edge :: G.Edge -> [Xmlbf.Node]
+      edge (G.Edge { edge_id = eId, edge_source = es, edge_target = et }) =
+        Xmlbf.element "edge" params []
+        where
+          params = HashMap.fromList [ ("id", eId)
+                                    , ("source", es)
+                                    , ("target", et) ]
 
 ------------------------------------------------------------------------
 
@@ -54,12 +98,14 @@ import qualified Data.Map as Map
 type GraphAPI   =  Get  '[JSON] Graph
               :<|> Post '[JSON] [GraphId]
               :<|> Put  '[JSON] Int
+              :<|> "gexf" :> Get '[XML] Graph
 
 
 graphAPI :: UserId -> NodeId -> GargServer GraphAPI
 graphAPI u n =  getGraph  u n
          :<|> postGraph n
          :<|> putGraph  n
+         :<|> getGraphGexf u n
 
 ------------------------------------------------------------------------
 
@@ -146,3 +192,8 @@ postGraph = undefined
 putGraph :: NodeId -> GargServer (Put '[JSON] Int)
 putGraph = undefined
 
+
+getGraphGexf :: UserId -> NodeId -> GargNoServer Graph
+getGraphGexf uId nId = do
+  graph <- getGraph uId nId
+  pure graph

stack.yaml

@@ -75,6 +75,7 @@ extra-deps:
 - servant-flatten-0.2
   #- servant-multipart-0.11.2
 - servant-server-0.16
+- servant-xml-1.0.1.4
 - stemmer-0.5.2
 - time-units-1.0.0
 - validity-0.9.0.0 # patches-{map,class}