src/Gargantext/Core/Viz/Graph/GEXF.hs

   1 {-|
   2 Module      : Gargantext.Core.Viz.Graph
   3 Description :
   4 Copyright   : (c) CNRS, 2017-Present
   5 License     : AGPL + CECILL v3
   6 Maintainer  : team@gargantext.org
   7 Stability   : experimental
   8 Portability : POSIX
   9
  10 -}
  11
  12
  13 {-# OPTIONS_GHC -fno-warn-orphans #-}
  14
  15 {-# LANGUAGE OverloadedLists   #-}   -- allows to write Map and HashMap as lists
  16 {-# LANGUAGE TypeOperators     #-}
  17
  18 module Gargantext.Core.Viz.Graph.GEXF
  19   where
  20
  21 import Gargantext.Prelude
  22 import Gargantext.Core.Viz.Graph
  23 import qualified Data.HashMap.Lazy as HashMap
  24 import qualified Gargantext.Prelude as P
  25 import qualified Gargantext.Core.Viz.Graph as G
  26 import qualified Xmlbf as Xmlbf
  27 import Prelude (error)
  28
  29 -- Converts to GEXF format
  30 -- See https://gephi.org/gexf/format/
  31 instance Xmlbf.ToXml Graph where
  32   toXml (Graph { _graph_nodes = graphNodes
  33                 , _graph_edges = graphEdges }) = root graphNodes graphEdges
  34     where
  35       root :: [G.Node] -> [G.Edge] -> [Xmlbf.Node]
  36       root gn ge =
  37         Xmlbf.element "gexf" params $ meta <> (graph gn ge)
  38         where
  39           params = HashMap.fromList [ ("xmlns", "http://www.gexf.net/1.3")
  40                                     , ("xmlns:viz", "http://gexf.net/1.3/viz")
  41                                     , ("xmlns:xsi", "http://www.w3.org/2001/XMLSchema-instance")
  42                                     , ("xsi:schemaLocation", "http://gexf.net/1.3 http://gexf.net/1.3/gexf.xsd")
  43                                     , ("version", "1.3") ]
  44       meta = Xmlbf.element "meta" params $ creator <> desc
  45         where
  46           params = HashMap.fromList [ ("lastmodifieddate", "2020-03-13") ]
  47       creator = Xmlbf.element "creator" HashMap.empty $ Xmlbf.text "Gargantext.org"
  48       desc = Xmlbf.element "description" HashMap.empty $ Xmlbf.text "Gargantext gexf file"
  49       graph :: [G.Node] -> [G.Edge] -> [Xmlbf.Node]
  50       graph gn ge = Xmlbf.element "graph" params $ (nodes gn) <> (edges ge)
  51         where
  52           params = HashMap.fromList [ ("mode", "static")
  53                                     , ("defaultedgetype", "directed") ]
  54       nodes :: [G.Node] -> [Xmlbf.Node]
  55       nodes gn = Xmlbf.element "nodes" HashMap.empty $ P.concatMap node' gn
  56
  57       node' :: G.Node -> [Xmlbf.Node]
  58       node' (G.Node { node_id = nId, node_label = l, node_size = w}) =
  59         Xmlbf.element "node" params (Xmlbf.element "viz:size" sizeParams [])
  60         where
  61           params = HashMap.fromList [ ("id", nId)
  62                                     , ("label", l) ]
  63           sizeParams = HashMap.fromList [ ("value", (cs . show) w) ]
  64       edges :: [G.Edge] -> [Xmlbf.Node]
  65       edges gn = Xmlbf.element "edges" HashMap.empty $ P.concatMap edge gn
  66       edge :: G.Edge -> [Xmlbf.Node]
  67       edge (G.Edge { edge_id = eId
  68                    , edge_source = es
  69                    , edge_target = et
  70                    , edge_weight = ew }) =
  71         Xmlbf.element "edge" params []
  72         where
  73           params = HashMap.fromList [ ("id", eId)
  74                                     , ("source", es)
  75                                     , ("target", et)
  76                                     , ("weight", (cs . show) ew)]
  77
  78 -- just to be able to derive a client for the entire gargantext API,
  79 -- we however want to avoid sollicitating this instance
  80 instance Xmlbf.FromXml Graph where
  81   fromXml = error "FromXml Graph: not defined, just a placeholder"