src/Gargantext/Viz/Graph/GEXF.hs

   1 {-|
   2 Module      : Gargantext.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 DataKinds         #-}
  16 {-# LANGUAGE DeriveGeneric     #-}
  17 {-# LANGUAGE FlexibleContexts  #-}
  18 {-# LANGUAGE FlexibleInstances #-}
  19 {-# LANGUAGE NoImplicitPrelude #-}
  20 {-# LANGUAGE OverloadedStrings #-}   -- allows to write Text literals
  21 {-# LANGUAGE OverloadedLists   #-}   -- allows to write Map and HashMap as lists
  22 {-# LANGUAGE RankNTypes        #-}
  23 {-# LANGUAGE TypeOperators     #-}
  24
  25 module Gargantext.Viz.Graph.GEXF
  26   where
  27
  28 import Gargantext.Prelude
  29 import Gargantext.Viz.Graph
  30 import qualified Data.HashMap.Lazy as HashMap
  31 import qualified Gargantext.Prelude as P
  32 import qualified Gargantext.Viz.Graph as G
  33 import qualified Xmlbf as Xmlbf
  34
  35 -- Converts to GEXF format
  36 -- See https://gephi.org/gexf/format/
  37 instance Xmlbf.ToXml Graph where
  38   toXml (Graph { _graph_nodes = graphNodes
  39                 , _graph_edges = graphEdges }) = root graphNodes graphEdges
  40     where
  41       root :: [G.Node] -> [G.Edge] -> [Xmlbf.Node]
  42       root gn ge =
  43         Xmlbf.element "gexf" params $ meta <> (graph gn ge)
  44         where
  45           params = HashMap.fromList [ ("xmlns", "http://www.gexf.net/1.2draft")
  46                                     , ("version", "1.2") ]
  47       meta = Xmlbf.element "meta" params $ creator <> desc
  48         where
  49           params = HashMap.fromList [ ("lastmodifieddate", "2020-03-13") ]
  50       creator = Xmlbf.element "creator" HashMap.empty $ Xmlbf.text "Gargantext.org"
  51       desc = Xmlbf.element "description" HashMap.empty $ Xmlbf.text "Gargantext gexf file"
  52       graph :: [G.Node] -> [G.Edge] -> [Xmlbf.Node]
  53       graph gn ge = Xmlbf.element "graph" params $ (nodes gn) <> (edges ge)
  54         where
  55           params = HashMap.fromList [ ("mode", "static")
  56                                     , ("defaultedgetype", "directed") ]
  57       nodes :: [G.Node] -> [Xmlbf.Node]
  58       nodes gn = Xmlbf.element "nodes" HashMap.empty $ P.concatMap node' gn
  59
  60       node' :: G.Node -> [Xmlbf.Node]
  61       node' (G.Node { node_id = nId, node_label = l }) =
  62         Xmlbf.element "node" params []
  63         where
  64           params = HashMap.fromList [ ("id", nId)
  65                                     , ("label", l) ]
  66       edges :: [G.Edge] -> [Xmlbf.Node]
  67       edges gn = Xmlbf.element "edges" HashMap.empty $ P.concatMap edge gn
  68       edge :: G.Edge -> [Xmlbf.Node]
  69       edge (G.Edge { edge_id = eId, edge_source = es, edge_target = et }) =
  70         Xmlbf.element "edge" params []
  71         where
  72           params = HashMap.fromList [ ("id", eId)
  73                                     , ("source", es)
  74                                     , ("target", et) ]