{-# LANGUAGE OverloadedStrings #-}
module Pangraph.Gml.Writer (writeGml, pangraphToGml, write, encodeStrings) where
import HTMLEntities.Text (text)
import Data.ByteString (ByteString, concat)
import Data.ByteString.Char8 (unpack, pack)
import Data.Text.Encoding (encodeUtf8, decodeUtf8)
import Prelude hiding (concat)
import Pangraph
import Pangraph.Gml.Ast
write :: Pangraph -> ByteString
write graph = let
gml = pangraphToGml graph
Just bs = writeGml gml
in bs
pangraphToGml :: Pangraph -> Gml ByteString
pangraphToGml graph = let
vertices = vertexList graph
edges = edgeList graph
gmlVertices = map gmlVertex vertices
gmlEdges = map gmlEdge edges
in encodeStrings (Object [("graph", Object (gmlVertices ++ gmlEdges))])
encodeStrings :: Gml ByteString -> Gml ByteString
encodeStrings = mapStrings (encodeUtf8 . text . decodeUtf8)
gmlVertex :: Vertex -> (ByteString, Gml ByteString)
gmlVertex vertex = let
vId = read (unpack (vertexID vertex))
filteredAttrs = filter (\(key, _) -> key /= "id") (vertexAttributes vertex)
attrs = map (\(x, y) -> (x, String y)) filteredAttrs
in ("node", Object (("id", Integer vId):attrs))
gmlEdge :: Edge -> (ByteString, Gml ByteString)
gmlEdge edge = let
(source, target) = edgeEndpoints edge
sId = read (unpack source)
tId = read (unpack target)
filteredAttrs = filter (\(key, _) -> (key `notElem` ["source", "target"]))
(edgeAttributes edge)
attrs = map (\(x, y) -> (x, String y)) filteredAttrs
in ("edge", Object (("source", Integer sId):("target", Integer tId):attrs))
writeGml :: Gml ByteString -> Maybe ByteString
writeGml (Object values) = Just $ concat (
(map (\(key, value) -> concat [key, " ", writeGml' value]) values))
writeGml _ = Nothing
writeGml' :: Gml ByteString -> ByteString
writeGml' (Object values) = concat ( ["["] ++
(map (\(key, value) -> concat [" ", key, " ", writeGml' value]) values) ++ ["]"])
writeGml' (String s) = concat ["\"", s , "\""]
writeGml' (Float d) = pack (show d)
writeGml' (Integer i) = pack (show i)