{-# 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 {} |] -- | -- ![Example](other/ex1.svg) 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] } |] -- | -- ![Example](other/ex2.svg) 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"]; } |] -- | -- ![Example](other/ex3.svg) ex3 :: ByteString ex3 = [i| digraph D { A -> {B, C, D} -> {F} } |] -- | -- -- ![Example](other/ex4.svg) 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 } |] -- | -- -- ![Example](other/ex5.svg) 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}; } |] -- | -- -- ![Example](other/ex6.svg) ex6 :: ByteString ex6 = [i| digraph D { label = 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}; } |] -- | -- -- ![Example](other/ex7.svg) 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; } |] -- | -- -- ![Example](other/ex8.svg) 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]; } } |] -- | -- -- ![Example](other/ex9.svg) 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; } } } |] -- | -- -- ![Example](other/ex10.svg) ex10 :: ByteString ex10 = [i| digraph H { aHtmlTable [ shape=plaintext color=blue // The color of the border of the table label=<
col 1foo
COL 2bar
>]; }|] -- | -- -- ![Example](other/ex11.svg) ex11 :: ByteString ex11 = [i| digraph { tbl [ shape=plaintext label=<
foobarbaz
one two three
four five six
seveneightnine
einszweidrei
sechs
vierfünf
abc
>]; } |] -- | -- -- ![Example](other/ex12.svg) ex12 :: ByteString ex12 = [i| digraph D { node [shape=plaintext] some_node [ label=<
Foo
Bar
Baz
> ]; } |] -- | -- -- ![Example](other/ex13.svg) ex13 :: ByteString ex13 = [i| digraph H { aHtmlTable [ shape=plaintext label=<
col 1foo
COL 2bar
>]; } |] -- | -- -- ![Example](other/ex14.svg) ex14 :: ByteString ex14 = [i| digraph H { parent [ shape=plaintext label=<
The foo, the bar and the baz
First portSecond portThird port
>]; child_one [ shape=plaintext label=<
1
>]; child_two [ shape=plaintext label=<
2
>]; child_three [ shape=plaintext label=<
3
>]; parent:port_one -> child_one; parent:port_two -> child_two; parent:port_three -> child_three; } |] -- | -- -- ![Example](other/ex15.svg) ex15 :: ByteString ex15 = [i| digraph D { node [shape=plaintext fontname="Sans serif" fontsize="8"]; task_menu [ label=<
Task 1
Choose Menu
done
>]; task_ingredients [ label=<
Task 2
Buy ingredients
done
>]; task_invitation [ label=<
Task 4
Send invitation
done
>]; task_cook [ label=<
Task 5
Cook
todo
>]; task_table[ label=<
Task 3
Lay table
todo
>]; task_eat[ label=<
Task 6
Eat
todo
>]; 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) -- -- ![augmentation example](other/exga.svg) 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)]