{-# 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)