From ad2da00a28bd908c9bfa3a33f0d79a82af63f20f Mon Sep 17 00:00:00 2001
From: Gregory Gerasev <uhbif19@gmail.com>
Date: Thu, 18 Apr 2024 23:31:25 +0700
Subject: [PATCH] Add basic state graph rendering support

---
 cem-script.cabal                   |  1 +
 docs/catalyst_milestone_reports.md | 32 ++++++++++++++++++++++
 src/Cardano/CEM/Documentation.hs   | 44 ++++++++++++++++++++++++++++++
 3 files changed, 77 insertions(+)
 create mode 100644 docs/catalyst_milestone_reports.md
 create mode 100644 src/Cardano/CEM/Documentation.hs

diff --git a/cem-script.cabal b/cem-script.cabal
index 22630fe..39b2a4f 100644
--- a/cem-script.cabal
+++ b/cem-script.cabal
@@ -164,6 +164,7 @@ library
   hs-source-dirs:  src/
   exposed-modules:
     Cardano.CEM
+    Cardano.CEM.Documentaiton
     Cardano.CEM.Examples.Auction
     Cardano.CEM.Examples.Compilation
     Cardano.CEM.Examples.Voting
diff --git a/docs/catalyst_milestone_reports.md b/docs/catalyst_milestone_reports.md
new file mode 100644
index 0000000..e75a0ab
--- /dev/null
+++ b/docs/catalyst_milestone_reports.md
@@ -0,0 +1,32 @@
+# Milestone 3
+
+## Summary
+
+Changes:
+
+* Running in emulated environment by CLB
+* Rendering CEMScript state graphs
+
+## State graph examples
+
+```graphviz
+digraph Creator {
+rankdir=LR;
+node [shape="dot",fontsize=14,fixedsize=true,width=1.5];
+edge [fontsize=11];"Void In" [color="orange"];"Void Out" [color="orange"];"Void In" -> NotStarted [label="Create (stage Open)"];
+NotStarted -> CurrentBid [label="Start (stage Open)"];
+CurrentBid -> CurrentBid [label="MakeBid (stage Open)"];
+CurrentBid -> Winner [label="Close (stage Closed)"];
+Winner -> "Void Out" [label="Buyout (stage Closed)"];
+}
+```
+
+```graphviz
+digraph Creator {
+rankdir=LR;
+node [shape="dot",fontsize=14,fixedsize=true,width=1.5];
+edge [fontsize=11];"Void In" [color="orange"];"Void Out" [color="orange"];"Void In" -> Spawning [label="Create (stage Always)"];
+Spawning -> Spawning [label="Spawn (stage Always)"];
+Spawning -> "Void Out" [label="Finalize (stage Always)"];
+}
+```
diff --git a/src/Cardano/CEM/Documentation.hs b/src/Cardano/CEM/Documentation.hs
new file mode 100644
index 0000000..6af844e
--- /dev/null
+++ b/src/Cardano/CEM/Documentation.hs
@@ -0,0 +1,44 @@
+module Cardano.CEM.Documentation where
+
+import Prelude
+
+import Data.Map qualified as Map
+import Data.Proxy
+
+import Cardano.CEM
+import Data.List (stripPrefix)
+
+dotStyling =
+  "rankdir=LR;\n"
+    <> "node [shape=\"dot\",fontsize=14,fixedsize=true,width=1.5];\n"
+    <> "edge [fontsize=11];"
+    <> "\"Void In\" [color=\"orange\"];"
+    <> "\"Void Out\" [color=\"orange\"];"
+
+cemDotGraphString :: (CEMScript script) => String -> Proxy script -> String
+cemDotGraphString name proxy =
+  "digraph "
+    <> name
+    <> " {\n"
+    <> dotStyling
+    <> edges
+    <> "}"
+  where
+    showSpine :: (Show s) => s -> String
+    showSpine = stripSpineSuffix . show
+    stripSpineSuffix = reverse . drop 5 . reverse
+    edges =
+      foldMap id $
+        [ ( maybe "\"Void In\"" showSpine from
+              <> " -> "
+              <> (maybe "\"Void Out\"" showSpine to)
+              <> " [label=\""
+              <> showSpine transition
+              <> " (stage "
+              <> show stage
+              <> ")"
+              <> "\"]; \n"
+          )
+        | (transition, (stage, from, to)) <-
+            Map.assocs $ transitionStage proxy
+        ]