{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE TypeOperators #-}
module Gargantext.Core.Viz.Graph.GEXF
where
import Gargantext.Prelude
import Gargantext.Core.Viz.Graph
import qualified Data.HashMap.Lazy as HashMap
import qualified Gargantext.Prelude as P
import qualified Gargantext.Core.Viz.Graph as G
import qualified Xmlbf as Xmlbf
instance Xmlbf.ToXml Graph where
toXml :: Graph -> [Node]
toXml (Graph { _graph_nodes :: Graph -> [Node]
_graph_nodes = [Node]
graphNodes
, _graph_edges :: Graph -> [Edge]
_graph_edges = [Edge]
graphEdges }) = [Node] -> [Edge] -> [Node]
root [Node]
graphNodes [Edge]
graphEdges
where
root :: [G.Node] -> [G.Edge] -> [Xmlbf.Node]
root :: [Node] -> [Edge] -> [Node]
root [Node]
gn [Edge]
ge =
Text -> HashMap Text Text -> [Node] -> [Node]
Xmlbf.element Text
"gexf" HashMap Text Text
params ([Node] -> [Node]) -> [Node] -> [Node]
forall a b. (a -> b) -> a -> b
$ [Node]
meta [Node] -> [Node] -> [Node]
forall a. Semigroup a => a -> a -> a
<> ([Node] -> [Edge] -> [Node]
graph [Node]
gn [Edge]
ge)
where
params :: HashMap Text Text
params = [(Text, Text)] -> HashMap Text Text
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList [ (Text
"xmlns", Text
"http://www.gexf.net/1.2draft")
, (Text
"version", Text
"1.2") ]
meta :: [Node]
meta = Text -> HashMap Text Text -> [Node] -> [Node]
Xmlbf.element Text
"meta" HashMap Text Text
params ([Node] -> [Node]) -> [Node] -> [Node]
forall a b. (a -> b) -> a -> b
$ [Node]
creator [Node] -> [Node] -> [Node]
forall a. Semigroup a => a -> a -> a
<> [Node]
desc
where
params :: HashMap Text Text
params = [(Text, Text)] -> HashMap Text Text
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList [ (Text
"lastmodifieddate", Text
"2020-03-13") ]
creator :: [Node]
creator = Text -> HashMap Text Text -> [Node] -> [Node]
Xmlbf.element Text
"creator" HashMap Text Text
forall k v. HashMap k v
HashMap.empty ([Node] -> [Node]) -> [Node] -> [Node]
forall a b. (a -> b) -> a -> b
$ Text -> [Node]
Xmlbf.text Text
"Gargantext.org"
desc :: [Node]
desc = Text -> HashMap Text Text -> [Node] -> [Node]
Xmlbf.element Text
"description" HashMap Text Text
forall k v. HashMap k v
HashMap.empty ([Node] -> [Node]) -> [Node] -> [Node]
forall a b. (a -> b) -> a -> b
$ Text -> [Node]
Xmlbf.text Text
"Gargantext gexf file"
graph :: [G.Node] -> [G.Edge] -> [Xmlbf.Node]
graph :: [Node] -> [Edge] -> [Node]
graph [Node]
gn [Edge]
ge = Text -> HashMap Text Text -> [Node] -> [Node]
Xmlbf.element Text
"graph" HashMap Text Text
params ([Node] -> [Node]) -> [Node] -> [Node]
forall a b. (a -> b) -> a -> b
$ ([Node] -> [Node]
nodes [Node]
gn) [Node] -> [Node] -> [Node]
forall a. Semigroup a => a -> a -> a
<> ([Edge] -> [Node]
edges [Edge]
ge)
where
params :: HashMap Text Text
params = [(Text, Text)] -> HashMap Text Text
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList [ (Text
"mode", Text
"static")
, (Text
"defaultedgetype", Text
"directed") ]
nodes :: [G.Node] -> [Xmlbf.Node]
nodes :: [Node] -> [Node]
nodes [Node]
gn = Text -> HashMap Text Text -> [Node] -> [Node]
Xmlbf.element Text
"nodes" HashMap Text Text
forall k v. HashMap k v
HashMap.empty ([Node] -> [Node]) -> [Node] -> [Node]
forall a b. (a -> b) -> a -> b
$ (Node -> [Node]) -> [Node] -> [Node]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
P.concatMap Node -> [Node]
node' [Node]
gn
node' :: G.Node -> [Xmlbf.Node]
node' :: Node -> [Node]
node' (G.Node { node_id :: Node -> Text
node_id = Text
nId, node_label :: Node -> Text
node_label = Text
l }) =
Text -> HashMap Text Text -> [Node] -> [Node]
Xmlbf.element Text
"node" HashMap Text Text
params []
where
params :: HashMap Text Text
params = [(Text, Text)] -> HashMap Text Text
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList [ (Text
"id", Text
nId)
, (Text
"label", Text
l) ]
edges :: [G.Edge] -> [Xmlbf.Node]
edges :: [Edge] -> [Node]
edges [Edge]
gn = Text -> HashMap Text Text -> [Node] -> [Node]
Xmlbf.element Text
"edges" HashMap Text Text
forall k v. HashMap k v
HashMap.empty ([Node] -> [Node]) -> [Node] -> [Node]
forall a b. (a -> b) -> a -> b
$ (Edge -> [Node]) -> [Edge] -> [Node]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
P.concatMap Edge -> [Node]
edge [Edge]
gn
edge :: G.Edge -> [Xmlbf.Node]
edge :: Edge -> [Node]
edge (G.Edge { edge_id :: Edge -> Text
edge_id = Text
eId, edge_source :: Edge -> Text
edge_source = Text
es, edge_target :: Edge -> Text
edge_target = Text
et }) =
Text -> HashMap Text Text -> [Node] -> [Node]
Xmlbf.element Text
"edge" HashMap Text Text
params []
where
params :: HashMap Text Text
params = [(Text, Text)] -> HashMap Text Text
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList [ (Text
"id", Text
eId)
, (Text
"source", Text
es)
, (Text
"target", Text
et) ]