module HGraph.Directed.Output
  ( toDot
  , DotStyle(..)
  , defaultDotStyle
  )
where

import HGraph.Directed
import Data.List
import qualified Data.Map as M

data DotStyle a = 
  DotStyle
  { DotStyle a -> String
graphName :: String
  , DotStyle a -> [(String, String)]
everyNode :: [(String, String)]
  , DotStyle a -> [(String, String)]
everyEdge :: [(String, String)]
  , DotStyle a -> Map a [(String, String)]
nodeAttributes :: M.Map a [(String, String)]
  , DotStyle a -> Map (a, a) [(String, String)]
edgeAttributes :: M.Map (a, a) [(String, String)]
  }

defaultDotStyle :: DotStyle a
defaultDotStyle = DotStyle :: forall a.
String
-> [(String, String)]
-> [(String, String)]
-> Map a [(String, String)]
-> Map (a, a) [(String, String)]
-> DotStyle a
DotStyle
  { graphName :: String
graphName = String
""
  , everyNode :: [(String, String)]
everyNode = []
  , everyEdge :: [(String, String)]
everyEdge = []
  , nodeAttributes :: Map a [(String, String)]
nodeAttributes = Map a [(String, String)]
forall k a. Map k a
M.empty
  , edgeAttributes :: Map (a, a) [(String, String)]
edgeAttributes = Map (a, a) [(String, String)]
forall k a. Map k a
M.empty
  }

toDot :: t a -> DotStyle a -> String
toDot t a
d DotStyle a
style = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
  [ String
"digraph ", (DotStyle a -> String
forall a. DotStyle a -> String
graphName DotStyle a
style), String
"{\n  "
  , if [(String, String)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([(String, String)] -> Bool) -> [(String, String)] -> Bool
forall a b. (a -> b) -> a -> b
$ DotStyle a -> [(String, String)]
forall a. DotStyle a -> [(String, String)]
everyNode DotStyle a
style then String
"" else String
"node [" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [(String, String)] -> String
attStr (DotStyle a -> [(String, String)]
forall a. DotStyle a -> [(String, String)]
everyNode DotStyle a
style) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"];\n  "
  , if [(String, String)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([(String, String)] -> Bool) -> [(String, String)] -> Bool
forall a b. (a -> b) -> a -> b
$ DotStyle a -> [(String, String)]
forall a. DotStyle a -> [(String, String)]
everyEdge DotStyle a
style then String
"" else String
"edge [" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [(String, String)] -> String
attStr (DotStyle a -> [(String, String)]
forall a. DotStyle a -> [(String, String)]
everyEdge DotStyle a
style) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"];\n  "
  , String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
";\n  " ((a -> String) -> [a] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map a -> String
showV ([a] -> [String]) -> [a] -> [String]
forall a b. (a -> b) -> a -> b
$ t a -> [a]
forall (t :: * -> *) a. DirectedGraph t => t a -> [a]
vertices t a
d),  String
";\n  "
  , String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
";\n  " (((a, a) -> String) -> [(a, a)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (a, a) -> String
showA ([(a, a)] -> [String]) -> [(a, a)] -> [String]
forall a b. (a -> b) -> a -> b
$ t a -> [(a, a)]
forall (t :: * -> *) a. DirectedGraph t => t a -> [(a, a)]
arcs t a
d) , String
";\n}"
  ]
  where
    attStr :: [(String, String)] -> String
attStr [(String, String)]
xs = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"," ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ ((String, String) -> String) -> [(String, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\(String
var,String
val) -> String
var String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"=\"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
val String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\"") [(String, String)]
xs
    showV :: a -> String
showV a
v
      | a
v a -> Map a [(String, String)] -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`M.member` (DotStyle a -> Map a [(String, String)]
forall a. DotStyle a -> Map a [(String, String)]
nodeAttributes DotStyle a
style) = a -> String
forall a. Show a => a -> String
show a
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" [" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [(String, String)] -> String
attStr ((DotStyle a -> Map a [(String, String)]
forall a. DotStyle a -> Map a [(String, String)]
nodeAttributes DotStyle a
style) Map a [(String, String)] -> a -> [(String, String)]
forall k a. Ord k => Map k a -> k -> a
M.! a
v) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]"
      | Bool
otherwise = a -> String
forall a. Show a => a -> String
show a
v
    showA :: (a, a) -> String
showA (a
v,a
u)
      | (a
v,a
u) (a, a) -> Map (a, a) [(String, String)] -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`M.member` (DotStyle a -> Map (a, a) [(String, String)]
forall a. DotStyle a -> Map (a, a) [(String, String)]
edgeAttributes DotStyle a
style) = a -> String
forall a. Show a => a -> String
show a
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" -> " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
u String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" [" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [(String, String)] -> String
attStr ((DotStyle a -> Map (a, a) [(String, String)]
forall a. DotStyle a -> Map (a, a) [(String, String)]
edgeAttributes DotStyle a
style) Map (a, a) [(String, String)] -> (a, a) -> [(String, String)]
forall k a. Ord k => Map k a -> k -> a
M.! (a
v,a
u)) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]"
      | Bool
otherwise = a -> String
forall a. Show a => a -> String
show a
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" -> " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
u