{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} {-# OPTIONS_GHC -Wno-name-shadowing #-} -- | Examples of conversion from dot ByteStrings -- -- Most examples from https://renenyffenegger.ch/notes/tools/Graphviz/examples/index module DotParse.Examples where import Algebra.Graph qualified as G import Control.Monad (zipWithM_) import Data.ByteString (ByteString) import Data.Proxy (Proxy (..)) import Data.String.Interpolate import DotParse import Prelude hiding (replicate) -- $setup -- >>> import DotParse -- >>> import Data.Proxy -- >>> :set -XOverloadedStrings -- >>> import Data.String.Interpolate -- >>> import qualified Data.ByteString.Char8 as Char8 -- >>> import Optics.Core -- >>> import Chart -- * examples -- | minimal definition -- -- >>> runDotParser ex0 :: Graph -- Graph {strict = Last {getLast = Just NoMergeEdges}, directed = Last {getLast = Just UnDirected}, graphid = Last {getLast = Nothing}, nodeAttributes = fromList [], graphAttributes = fromList [], edgeAttributes = fromList [], globalAttributes = fromList [], nodes = [], edges = [], subgraphs = []} -- -- >>> testDotParser (Proxy :: Proxy Graph) defaultDotConfig ex0 ex0 :: ByteString ex0 = [i| graph {} |] -- | --  ex1 :: ByteString ex1 = [i| digraph D { A [shape=diamond] B [shape=box] C [shape=circle] A -> B [style=dashed, color=grey] A -> C [color="black:invis:black"] A -> D [penwidth=5, arrowhead=none] } |] -- | --  ex2 :: ByteString ex2 = [i| digraph D { node [fontname="Arial"]; node_A [shape=record label="shape=record|{above|middle|below}|right"]; node_B [shape=plaintext label="shape=plaintext|{curly|braces and|bars without}|effect"]; } |] -- | --  ex3 :: ByteString ex3 = [i| digraph D { A -> {B, C, D} -> {F} } |] -- | -- --  ex4 :: ByteString ex4 = [i| digraph L { node [shape=record fontname=Arial]; a [label="one\ntwo three\nfour five six seven\n"] b [label="one\ntwo three\nfour five six seven"] c [label="one\rtwo three\rfour five six seven\r"] a -> b -> c } |] -- | -- --  ex5 :: ByteString ex5 = [i| digraph D { label = "The foo, the bar and the baz"; labelloc = "t"; // place the label at the top (b seems to be default) node [shape=plaintext] FOO -> {BAR, BAZ}; } |] -- | -- --  ex6 :: ByteString ex6 = [i| digraph D { label = <The <font color='red'><b>foo</b></font>,<br/> the <font point-size='20'>bar</font> and<br/> the <i>baz</i>>; labelloc = "t"; // place the label at the top (b seems to be default) node [shape=plaintext] FOO -> {BAR, BAZ}; } |] -- | -- --  ex7 :: ByteString ex7 = [i| digraph R { { rank=same rA sA tA } { rank=same uB vB wB } rA -> sA; sA -> vB; t -> rA; uB -> vB; wB -> u; wB -> tA; } |] -- | -- --  ex8 :: ByteString ex8 = [i| digraph Q { nd_1 [label = "Node 1"]; nd_2 [label = "Node 2"]; nd_3_a [label = "Above Right Node 3"]; nd_3_l [label = "Left of Node 3"]; nd_3 [label = "Node 3"]; nd_3_r [label = "Right of Node 3"]; nd_4 [label = "Node 4"]; nd_3_a -> nd_3_r; nd_1 -> nd_2 -> nd_3 -> nd_4; subgraph cluster_R { {rank=same nd_3_l nd_3 nd_3_r} nd_3_l -> nd_3 -> nd_3_r [color=grey arrowhead=none]; } } |] -- | -- --  ex9 :: ByteString ex9 = [i| digraph D { subgraph cluster_p { label = "Parent"; subgraph cluster_c1 { label = "Child one"; a; subgraph cluster_gc_1 { label = "Grand-Child one"; b; } subgraph cluster_gc_2 { label = "Grand-Child two"; c; d; } } subgraph cluster_c2 { label = "Child two"; e; } } } |] -- | -- --  ex10 :: ByteString ex10 = [i| digraph H { aHtmlTable [ shape=plaintext color=blue // The color of the border of the table label=< <table border='1' cellborder='0'> <tr><td>col 1</td><td>foo</td></tr> <tr><td>COL 2</td><td>bar</td></tr> </table> >]; }|] -- | -- --  ex11 :: ByteString ex11 = [i| digraph { tbl [ shape=plaintext label=< <table border='0' cellborder='1' color='blue' cellspacing='0'> <tr><td>foo</td><td>bar</td><td>baz</td></tr> <tr><td cellpadding='4'> <table color='orange' cellspacing='0'> <tr><td>one </td><td>two </td><td>three</td></tr> <tr><td>four </td><td>five </td><td>six </td></tr> <tr><td>seven</td><td>eight</td><td>nine </td></tr> </table> </td> <td colspan='2' rowspan='2'> <table color='pink' border='0' cellborder='1' cellpadding='10' cellspacing='0'> <tr><td>eins</td><td>zwei</td><td rowspan='2'>drei<br/>sechs</td></tr> <tr><td>vier</td><td>fünf</td> </tr> </table> </td> </tr> <tr><td>abc</td></tr> </table> >]; } |] -- | -- --  ex12 :: ByteString ex12 = [i| digraph D { node [shape=plaintext] some_node [ label=< <table border="0" cellborder="1" cellspacing="0"> <tr><td bgcolor="yellow">Foo</td></tr> <tr><td bgcolor="lightblue"><font color="\#0000ff">Bar</font></td></tr> <tr><td bgcolor="\#f0e3ff"><font color="\#ff1020">Baz</font></td></tr> </table>> ]; } |] -- | -- --  ex13 :: ByteString ex13 = [i| digraph H { aHtmlTable [ shape=plaintext label=< <table border='1' cellborder='0' style='rounded'> <tr><td>col 1</td><td>foo</td></tr> <tr><td>COL 2</td><td>bar</td></tr> </table> >]; } |] -- | -- --  ex14 :: ByteString ex14 = [i| digraph H { parent [ shape=plaintext label=< <table border='1' cellborder='1'> <tr><td colspan="3">The foo, the bar and the baz</td></tr> <tr><td port='port_one'>First port</td><td port='port_two'>Second port</td><td port='port_three'>Third port</td></tr> </table> >]; child_one [ shape=plaintext label=< <table border='1' cellborder='0'> <tr><td>1</td></tr> </table> >]; child_two [ shape=plaintext label=< <table border='1' cellborder='0'> <tr><td>2</td></tr> </table> >]; child_three [ shape=plaintext label=< <table border='1' cellborder='0'> <tr><td>3</td></tr> </table> >]; parent:port_one -> child_one; parent:port_two -> child_two; parent:port_three -> child_three; } |] -- | -- --  ex15 :: ByteString ex15 = [i| digraph D { node [shape=plaintext fontname="Sans serif" fontsize="8"]; task_menu [ label=< <table border="1" cellborder="0" cellspacing="1"> <tr><td align="left"><b>Task 1</b></td></tr> <tr><td align="left">Choose Menu</td></tr> <tr><td align="left"><font color="darkgreen">done</font></td></tr> </table>>]; task_ingredients [ label=< <table border="1" cellborder="0" cellspacing="1"> <tr><td align="left"><b>Task 2</b></td></tr> <tr><td align="left">Buy ingredients</td></tr> <tr><td align="left"><font color="darkgreen">done</font></td></tr> </table>>]; task_invitation [ label=< <table border="1" cellborder="0" cellspacing="1"> <tr><td align="left"><b>Task 4</b></td></tr> <tr><td align="left">Send invitation</td></tr> <tr><td align="left"><font color="darkgreen">done</font></td></tr> </table>>]; task_cook [ label=< <table border="1" cellborder="0" cellspacing="1"> <tr><td align="left"><b>Task 5</b></td></tr> <tr><td align="left">Cook</td></tr> <tr><td align="left"><font color="red">todo</font></td></tr> </table>>]; task_table[ label=< <table border="1" cellborder="0" cellspacing="1"> <tr><td align="left"><b>Task 3</b></td></tr> <tr><td align="left">Lay table</td></tr> <tr><td align="left"><font color="red">todo</font></td></tr> </table>>]; task_eat[ label=< <table border="1" cellborder="0" cellspacing="1"> <tr><td align="left"><b>Task 6</b></td></tr> <tr><td align="left">Eat</td></tr> <tr><td align="left"><font color="red">todo</font></td></tr> </table>>]; task_menu -> task_ingredients; task_ingredients -> task_cook; task_invitation -> task_cook; task_table -> task_eat; task_cook -> task_eat; } |] -- | Test all the examples testAll :: IO () testAll = zipWithM_ (>>) ( putStrLn <$> [ "ex0", "ex1", "ex2", "ex3", "ex4", "ex5", "ex6", "ex7", "ex8", "ex9", "ex10", "ex11", "ex12", "ex13", "ex14", "ex15" ] ) ( testDotParser (Proxy :: Proxy Graph) defaultDotConfig <$> [ex0, ex1, ex2, ex3, ex4, ex5, ex6, ex7, ex8, ex9, ex10, ex11, ex12, ex13, ex14, ex15] ) -- | Render all the examples svgAll :: IO () svgAll = zipWithM_ (>>) ( putStrLn <$> [ "ex0", "ex1", "ex2", "ex3", "ex4", "ex5", "ex6", "ex7", "ex8", "ex9", "ex10", "ex11", "ex12", "ex13", "ex14", "ex15" ] ) ( zipWith (\b f -> processDotWith Directed ["-Tsvg", "-oother/" <> f <> ".svg"] b) [ex0, ex1, ex2, ex3, ex4, ex5, ex6, ex7, ex8, ex9, ex10, ex11, ex12, ex13, ex14, ex15] [ "ex0", "ex1", "ex2", "ex3", "ex4", "ex5", "ex6", "ex7", "ex8", "ex9", "ex10", "ex11", "ex12", "ex13", "ex14", "ex15" ] ) -- | algebraic graph example -- -- > exGraph = defaultGraph & addStatements (toStatements Directed (Char8.pack . show <$> exAGraph)) -- > exGraphAugmented <- processGraph exGraph -- > writeChartOptions "other/exga.svg" (graphToChart exGraphAugmented) -- --  exAGraph :: G.Graph Int exAGraph = G.edges $ [(v, (v + 1) `mod` 6) | v <- [0 .. 5]] <> [(v, v + k) | v <- [0 .. 5], k <- [6, 12]] <> [(2, 18), (2, 19), (15, 18), (15, 19), (18, 3), (19, 3)]