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