{-# 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 :: ByteString
ex0 =
  [i|
graph {}
|]

-- |
-- ![Example](other/ex1.svg)
ex1 :: ByteString
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 :: 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 :: ByteString
ex3 =
  [i|
digraph D {
  A -> {B, C, D} -> {F}
}
|]

-- |
--
-- ![Example](other/ex4.svg)
ex4 :: ByteString
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 :: 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 :: 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};

}
|]

-- |
--
-- ![Example](other/ex7.svg)
ex7 :: ByteString
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 :: 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 :: 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 :: 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>

  >];

}|]

-- |
--
-- ![Example](other/ex11.svg)
ex11 :: ByteString
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>

    >];

}
|]

-- |
--
-- ![Example](other/ex12.svg)
ex12 :: ByteString
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>>
  ];
}
|]

-- |
--
-- ![Example](other/ex13.svg)
ex13 :: ByteString
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>

  >];

}
|]

-- |
--
-- ![Example](other/ex14.svg)
ex14 :: ByteString
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;

}
|]

-- |
--
-- ![Example](other/ex15.svg)
ex15 :: ByteString
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 :: IO ()
testAll =
  forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m ()
zipWithM_
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
(>>)
    ( String -> IO ()
putStrLn
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ String
"ex0",
              String
"ex1",
              String
"ex2",
              String
"ex3",
              String
"ex4",
              String
"ex5",
              String
"ex6",
              String
"ex7",
              String
"ex8",
              String
"ex9",
              String
"ex10",
              String
"ex11",
              String
"ex12",
              String
"ex13",
              String
"ex14",
              String
"ex15"
            ]
    )
    ( forall a. DotParse a => Proxy a -> DotConfig -> ByteString -> IO ()
testDotParser (forall {k} (t :: k). Proxy t
Proxy :: Proxy Graph) DotConfig
defaultDotConfig
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ByteString
ex0, ByteString
ex1, ByteString
ex2, ByteString
ex3, ByteString
ex4, ByteString
ex5, ByteString
ex6, ByteString
ex7, ByteString
ex8, ByteString
ex9, ByteString
ex10, ByteString
ex11, ByteString
ex12, ByteString
ex13, ByteString
ex14, ByteString
ex15]
    )

-- | Render all the examples
svgAll :: IO ()
svgAll :: IO ()
svgAll =
  forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m ()
zipWithM_
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
(>>)
    ( String -> IO ()
putStrLn
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ String
"ex0",
              String
"ex1",
              String
"ex2",
              String
"ex3",
              String
"ex4",
              String
"ex5",
              String
"ex6",
              String
"ex7",
              String
"ex8",
              String
"ex9",
              String
"ex10",
              String
"ex11",
              String
"ex12",
              String
"ex13",
              String
"ex14",
              String
"ex15"
            ]
    )
    ( forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith
        (\ByteString
b String
f -> Directed -> [String] -> ByteString -> IO ByteString
processDotWith Directed
Directed [String
"-Tsvg", String
"-oother/" forall a. Semigroup a => a -> a -> a
<> String
f forall a. Semigroup a => a -> a -> a
<> String
".svg"] ByteString
b)
        [ByteString
ex0, ByteString
ex1, ByteString
ex2, ByteString
ex3, ByteString
ex4, ByteString
ex5, ByteString
ex6, ByteString
ex7, ByteString
ex8, ByteString
ex9, ByteString
ex10, ByteString
ex11, ByteString
ex12, ByteString
ex13, ByteString
ex14, ByteString
ex15]
        [ String
"ex0",
          String
"ex1",
          String
"ex2",
          String
"ex3",
          String
"ex4",
          String
"ex5",
          String
"ex6",
          String
"ex7",
          String
"ex8",
          String
"ex9",
          String
"ex10",
          String
"ex11",
          String
"ex12",
          String
"ex13",
          String
"ex14",
          String
"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 :: Graph Int
exAGraph =
  forall a. [(a, a)] -> Graph a
G.edges forall a b. (a -> b) -> a -> b
$
    [(Int
v, (Int
v forall a. Num a => a -> a -> a
+ Int
1) forall a. Integral a => a -> a -> a
`mod` Int
6) | Int
v <- [Int
0 .. Int
5]]
      forall a. Semigroup a => a -> a -> a
<> [(Int
v, Int
v forall a. Num a => a -> a -> a
+ Int
k) | Int
v <- [Int
0 .. Int
5], Int
k <- [Int
6, Int
12]]
      forall a. Semigroup a => a -> a -> a
<> [(Int
2, Int
18), (Int
2, Int
19), (Int
15, Int
18), (Int
15, Int
19), (Int
18, Int
3), (Int
19, Int
3)]