From a78b623286173135bee5df1a58dcdd894f902e0b Mon Sep 17 00:00:00 2001
From: Sjoerd Visscher <sjoerd@q42.nl>
Date: Fri, 22 Nov 2019 18:38:29 +0100
Subject: [PATCH 1/4] Generate kdmoncat diagrams from a list of edges

---
 stbx-lang/package.json                        |  1 +
 stbx-lang/spago.dhall                         |  3 +-
 .../Language/Statebox/Wiring/Generator.purs   | 36 +++++++
 .../Statebox/Wiring/Generator/Diagram.purs    | 29 ++----
 .../Statebox/Wiring/Generator/DiagramV2.purs  | 97 +++++++++++++++++++
 stbx-lang/test/Wiring.purs                    |  4 +
 6 files changed, 147 insertions(+), 23 deletions(-)
 create mode 100644 stbx-lang/src/Language/Statebox/Wiring/Generator.purs
 create mode 100644 stbx-lang/src/Language/Statebox/Wiring/Generator/DiagramV2.purs

diff --git a/stbx-lang/package.json b/stbx-lang/package.json
index f3f5b2d1..86a6af64 100644
--- a/stbx-lang/package.json
+++ b/stbx-lang/package.json
@@ -14,6 +14,7 @@
     "postinstall": "spago install",
     "start": "spago run",
     "build": "spago build",
+    "watch": "spago build --watch",
     "test": "spago test"
   },
   "license": "ISC",
diff --git a/stbx-lang/spago.dhall b/stbx-lang/spago.dhall
index 7d135650..94106299 100644
--- a/stbx-lang/spago.dhall
+++ b/stbx-lang/spago.dhall
@@ -5,6 +5,7 @@
     , "debug"
     , "effect"
     , "halogen-petrinet-editor"
+    , "memoize"
     , "parsing"
     , "psci-support"
     , "spec"
@@ -15,4 +16,4 @@
     ./../packages.dhall
 , sources =
     [ "src/**/*.purs", "test/**/*.purs" ]
-}
\ No newline at end of file
+}
diff --git a/stbx-lang/src/Language/Statebox/Wiring/Generator.purs b/stbx-lang/src/Language/Statebox/Wiring/Generator.purs
new file mode 100644
index 00000000..5932a8f0
--- /dev/null
+++ b/stbx-lang/src/Language/Statebox/Wiring/Generator.purs
@@ -0,0 +1,36 @@
+module Language.Statebox.Wiring.Generator where
+
+import Prelude
+import Data.Array (length, elemIndex)
+import Data.Maybe (maybe)
+import Data.Foldable (foldMap)
+import Data.Bitraversable (bitraverse)
+import Data.List (List)
+import Data.Traversable (traverse)
+import Data.Traversable.Accum.Internal (StateL(..), stateL)
+
+import Language.Statebox.Hypergraph (HyperEdgeF(..), GElemF(..))
+import Language.Statebox.Wiring.AST (GElem, stripSpan)
+
+
+toIndexedGraph :: List GElem -> { graph :: List (GElemF List Int Unit), names :: Array String }
+toIndexedGraph ast = { graph: acc.value, names: acc.accum }
+  where
+    acc = traverse (bitraverse (stripSpan >>> lookupOrAdd) idStateL) ast # (_ `stateL` [])
+
+lookupOrAdd :: ∀ v. Eq v => v -> StateL (Array v) Int
+lookupOrAdd v =
+  StateL $ \vs -> elemIndex v vs # maybe { accum: vs <> [v], value: length vs + 1 }
+                                          \i -> { accum: vs, value: i + 1 }
+
+idStateL :: ∀ a s. a -> StateL s a
+idStateL value = StateL $ \accum -> { accum, value }
+
+
+type Edges a = Array { src :: a, tgt :: a }
+
+getEdges :: ∀ a. List (GElemF List a Unit) -> Edges a
+getEdges = foldMap f
+  where
+    f (GHyperEdge (HyperEdge _ srcs tgts)) = foldMap (\src -> foldMap (\tgt -> [{ src, tgt }]) tgts) srcs
+    f _                                    = []
diff --git a/stbx-lang/src/Language/Statebox/Wiring/Generator/Diagram.purs b/stbx-lang/src/Language/Statebox/Wiring/Generator/Diagram.purs
index a0bbbefe..28153c60 100644
--- a/stbx-lang/src/Language/Statebox/Wiring/Generator/Diagram.purs
+++ b/stbx-lang/src/Language/Statebox/Wiring/Generator/Diagram.purs
@@ -1,33 +1,18 @@
 module Language.Statebox.Wiring.Generator.Diagram where
 
 import Prelude
-import Data.Array (length, elemIndex)
-import Data.Maybe (maybe)
-import Data.Foldable (foldMap)
-import Data.Bitraversable (bitraverse)
-import Data.Traversable (traverse)
-import Data.Traversable.Accum.Internal (StateL(..), stateL)
+import Data.Array (length)
 import Data.List (List)
 
-import Language.Statebox.Hypergraph (HyperEdgeF(..), GElemF(..))
-import Language.Statebox.Wiring.AST (GElem, stripSpan)
+import Language.Statebox.Wiring.Generator (toIndexedGraph, getEdges)
+import Language.Statebox.Wiring.AST (GElem)
 import Statebox.Core.Types (Diagram)
 
 toDiagramWithName :: String -> List GElem -> Diagram
 toDiagramWithName name ast =
-  { name, width, pixels, names: acc.accum }
+  { name, width, pixels, names }
   where
-    acc = traverse (bitraverse (stripSpan >>> lookupOrAdd) idStateL) ast # (_ `stateL` [])
-    getEdges (GHyperEdge (HyperEdge _ srcs targs)) = foldMap (\src -> foldMap (\targ -> [{ src, targ }]) targs) srcs
-    getEdges _                                     = []
-    edges = foldMap getEdges acc.value
+    { graph, names } = toIndexedGraph ast
+    edges = getEdges graph
     width = length edges
-    pixels = (edges <#> _.src) <> (edges <#> _.targ)
-
-lookupOrAdd :: ∀ v. Eq v => v -> StateL (Array v) Int
-lookupOrAdd v =
-  StateL $ \vs -> elemIndex v vs # maybe { accum: vs <> [v], value: length vs + 1 }
-                                         \i -> { accum: vs, value: i + 1 }
-
-idStateL :: ∀ a s. a -> StateL s a
-idStateL value = StateL $ \accum -> { accum, value }
+    pixels = (edges <#> _.src) <> (edges <#> _.tgt)
diff --git a/stbx-lang/src/Language/Statebox/Wiring/Generator/DiagramV2.purs b/stbx-lang/src/Language/Statebox/Wiring/Generator/DiagramV2.purs
new file mode 100644
index 00000000..c9501812
--- /dev/null
+++ b/stbx-lang/src/Language/Statebox/Wiring/Generator/DiagramV2.purs
@@ -0,0 +1,97 @@
+module Language.Statebox.Wiring.Generator.DiagramV2 where
+
+import Prelude
+import Data.Array (zipWith, take, drop, concat, length, (..), (!!), uncons, elemIndex, filter)
+import Data.Char (fromCharCode, toCharCode)
+import Data.Foldable (class Foldable, maximum, intercalate, foldMap, fold, notElem)
+import Data.FoldableWithIndex (foldMapWithIndex)
+import Data.FunctorWithIndex (mapWithIndex)
+import Data.List (List)
+import Data.Map (Map, fromFoldableWith, lookup, union, toUnfoldable)
+import Data.Map.Internal (keys)
+import Data.Maybe (maybe, fromMaybe)
+import Data.String.CodeUnits (singleton)
+import Data.TraversableWithIndex (mapAccumLWithIndex)
+import Data.Tuple (snd)
+import Data.Tuple.Nested ((/\), type (/\))
+import Data.Function.Memoize (memoize, class Tabulate)
+import Statebox.Core.Types (Diagram)
+
+import Language.Statebox.Wiring.Generator (Edges)
+
+type DiagramV2 =
+  { pixels :: String
+  , context :: String
+  }
+
+fromEdges :: ∀ a. Ord a => Tabulate a => Show a => Edges a -> DiagramV2
+fromEdges edges = { pixels, context }
+  where
+    pixels = (0 .. height) <#> row # intercalate "\n"
+    context = [nodeTypes, swapTypes] # intercalate "\n"
+
+    predecessors :: Map a (Array a)
+    predecessors = edges <#> (\{ src, tgt } -> tgt /\ [src]) # mfromFoldable
+    successors :: Map a (Array a)
+    successors = edges <#> (\{ src, tgt } -> src /\ [tgt]) # mfromFoldable
+    inputs :: Map a (Array Int)
+    inputs = edges # mapWithIndex (\i { tgt } -> tgt /\ [i]) # mfromFoldable
+    outputs :: Map a (Array Int)
+    outputs = edges # mapWithIndex (\i { src } -> src /\ [i]) # mfromFoldable
+    level :: a -> Int
+    level = memoize \a -> mlookup a predecessors <#> level # maximum # maybe 0 (_ + 1)
+    nodes :: List a
+    nodes = (successors `union` predecessors) # keys
+    grouped :: Array (Array a)
+    grouped = nodes <#> (\id -> level id /\ [id]) # mfromFoldable # toUnfoldable <#> snd
+    width = length grouped
+    height = grouped <#> length # maximum # fromMaybe 0
+    typeStr :: a -> Map a (Array a) -> (a -> String) -> String
+    typeStr a m f = mlookup a m <#> f # intercalate " "
+    nodeType :: a -> String
+    nodeType a = show a <> ": " <> typeStr a predecessors (\b -> show b <> "-" <> show a)
+                      <> " -> " <> typeStr a successors (\b -> show a <> "-" <> show b)
+    nodeTypes :: String
+    nodeTypes = map nodeType nodes # intercalate "\n"
+    row :: Int -> String
+    row y = grouped # foldMapWithIndex \x g ->
+      ((g !! y) # maybe (if x > 0 && x < width - 1 then nextChar 'A' (x - 1) else " ") show) <>
+      if x < width - 1 then nextChar 'a' x else ""
+    swapTypes :: String
+    swapTypes = grouped
+              # uncons
+             <#> (\{ head, tail } -> mapAccumLWithIndex mkSwap (levelOutputs head) tail)
+              # maybe "" (_.value >>> intercalate "\n")
+    mkSwap :: Int -> Array Int -> Array a -> { accum :: Array Int, value :: String }
+    mkSwap i edgeIds as = { accum: levelOutputs as <> rest, value }
+      where
+        value = nextChar 'a' i <> ": [" <> intercalate " " order <> "]\n" <>
+                nextChar 'A' i <> ": [" <> intercalate " " ((1 ..< (length rest + 1)) <#> show) <> "]"
+        ids = foldMap (\a -> mlookup a inputs) as
+        order = (ids <> rest) <#> \id -> elemIndex id edgeIds # maybe "?" ((_ + 1) >>> show)
+        rest = filter (\id -> id `notElem` ids) edgeIds
+    levelOutputs :: Array a -> Array Int
+    levelOutputs = foldMap (\a -> mlookup a outputs)
+
+mfromFoldable :: ∀ f k v. Foldable f => Ord k => Monoid v => f (k /\ v) -> Map k v
+mfromFoldable = fromFoldableWith (flip (<>))
+
+mlookup :: ∀ k v. Ord k => Monoid v => k -> Map k v -> v
+mlookup k = lookup k >>> fold
+
+nextChar :: Char -> Int -> String
+nextChar c i = fromCharCode (toCharCode c + i) # maybe "?" singleton
+
+rangeEx :: Int -> Int -> Array Int
+rangeEx x y = if y > x then x .. (y - 1) else []
+
+infix 8 rangeEx as ..<
+
+diagramEdges :: Diagram -> Edges Int
+diagramEdges { width, pixels } = concat $ zipWith (zipWith (\src tgt -> { src, tgt })) rows (drop 1 rows)
+  where
+    rows = chunks width pixels
+
+chunks :: ∀ a. Int -> Array a -> Array (Array a)
+chunks _ [] = []
+chunks n xs = [take n xs] <> (chunks n $ drop n xs)
diff --git a/stbx-lang/test/Wiring.purs b/stbx-lang/test/Wiring.purs
index aa39a6f7..773cefcf 100644
--- a/stbx-lang/test/Wiring.purs
+++ b/stbx-lang/test/Wiring.purs
@@ -9,16 +9,20 @@ import Language.Statebox as Statebox
 import Language.Statebox.Hypergraph (HyperEdgeF(..), GElemF(..))
 import Language.Statebox.Wiring.AST (Label, stripSpan)
 import Language.Statebox.Wiring.Generator.Diagram (toDiagramWithName)
+import Language.Statebox.Wiring.Generator.DiagramV2 (diagramEdges, fromEdges)
 import Statebox.Core.Types (Diagram)
 import Test.Spec                  (Spec, describe, it)
 import Test.Spec.Assertions       (shouldEqual)
 
+import Debug.Trace (spy)
+
 spec :: Spec Unit
 spec = do
   describe "Statebox wiring compiler" do
     it "should parse wirings correctly" do
       let ast = Statebox.parseWiring wiring1src
       let diagram1 = toDiagramWithName "dummy" <$> ast
+      let diagramv2 = diagram1 <#> diagramEdges <#> fromEdges <#> \{pixels, context} -> spy pixels (spy context "newline hack")
       (ast # map (map (lmap stripSpan))) `shouldEqual` pure wiring1expected
       diagram1 `shouldEqual` pure diagram1expected
 

From 862e4fa73a7eb668eb7e8560dd859d7055740cae Mon Sep 17 00:00:00 2001
From: Sjoerd Visscher <sjoerd@q42.nl>
Date: Tue, 26 Nov 2019 17:18:57 +0100
Subject: [PATCH 2/4] Generate DiagramV2s from Wirings directly

---
 .../Statebox/Wiring/Generator/DiagramV2.purs  | 38 +++++++++++++------
 stbx-lang/test/Wiring.purs                    |  7 +++-
 2 files changed, 31 insertions(+), 14 deletions(-)

diff --git a/stbx-lang/src/Language/Statebox/Wiring/Generator/DiagramV2.purs b/stbx-lang/src/Language/Statebox/Wiring/Generator/DiagramV2.purs
index c9501812..3bbf8657 100644
--- a/stbx-lang/src/Language/Statebox/Wiring/Generator/DiagramV2.purs
+++ b/stbx-lang/src/Language/Statebox/Wiring/Generator/DiagramV2.purs
@@ -17,15 +17,32 @@ import Data.Tuple.Nested ((/\), type (/\))
 import Data.Function.Memoize (memoize, class Tabulate)
 import Statebox.Core.Types (Diagram)
 
-import Language.Statebox.Wiring.Generator (Edges)
+import Language.Statebox.Wiring.Generator (Edges, toIndexedGraph, getEdges)
+import Language.Statebox.Wiring.AST (GElem)
 
 type DiagramV2 =
   { pixels :: String
   , context :: String
   }
 
-fromEdges :: ∀ a. Ord a => Tabulate a => Show a => Edges a -> DiagramV2
-fromEdges edges = { pixels, context }
+
+fromWiring :: List GElem -> DiagramV2
+fromWiring ast = fromEdges (_ - 1) name edges
+  where
+    { graph, names } = toIndexedGraph ast
+    edges = getEdges graph
+    name id = names !! (id - 1) # fromMaybe "?"
+
+fromDiagram :: Diagram -> DiagramV2
+fromDiagram { width, pixels, names } = fromEdges (_ - 1) name edges
+  where
+    rows = chunks width pixels
+    edges = concat $ zipWith (zipWith (\src tgt -> { src, tgt })) rows (drop 1 rows)
+    name id = names !! (id - 1) # fromMaybe "?"
+
+
+fromEdges :: ∀ a. Ord a => Tabulate a => (a -> Int) -> (a -> String) -> Edges a -> DiagramV2
+fromEdges fromEnum name edges = { pixels, context }
   where
     pixels = (0 .. height) <#> row # intercalate "\n"
     context = [nodeTypes, swapTypes] # intercalate "\n"
@@ -48,14 +65,16 @@ fromEdges edges = { pixels, context }
     height = grouped <#> length # maximum # fromMaybe 0
     typeStr :: a -> Map a (Array a) -> (a -> String) -> String
     typeStr a m f = mlookup a m <#> f # intercalate " "
+    pixel :: a -> String
+    pixel a = nextChar 'A' (fromEnum a)
     nodeType :: a -> String
-    nodeType a = show a <> ": " <> typeStr a predecessors (\b -> show b <> "-" <> show a)
-                      <> " -> " <> typeStr a successors (\b -> show a <> "-" <> show b)
+    nodeType a = name a <> "@" <> pixel a <> ": " <> typeStr a predecessors (\b -> name b <> "_" <> name a)
+                                        <> " -> " <> typeStr a successors   (\b -> name a <> "_" <> name b)
     nodeTypes :: String
     nodeTypes = map nodeType nodes # intercalate "\n"
     row :: Int -> String
     row y = grouped # foldMapWithIndex \x g ->
-      ((g !! y) # maybe (if x > 0 && x < width - 1 then nextChar 'A' (x - 1) else " ") show) <>
+      ((g !! y) # maybe (if x > 0 && x < width - 1 then nextChar 'n' (x - 1) else " ") pixel) <>
       if x < width - 1 then nextChar 'a' x else ""
     swapTypes :: String
     swapTypes = grouped
@@ -66,7 +85,7 @@ fromEdges edges = { pixels, context }
     mkSwap i edgeIds as = { accum: levelOutputs as <> rest, value }
       where
         value = nextChar 'a' i <> ": [" <> intercalate " " order <> "]\n" <>
-                nextChar 'A' i <> ": [" <> intercalate " " ((1 ..< (length rest + 1)) <#> show) <> "]"
+                nextChar 'n' i <> ": [" <> intercalate " " ((1 ..< (length rest + 1)) <#> show) <> "]"
         ids = foldMap (\a -> mlookup a inputs) as
         order = (ids <> rest) <#> \id -> elemIndex id edgeIds # maybe "?" ((_ + 1) >>> show)
         rest = filter (\id -> id `notElem` ids) edgeIds
@@ -87,11 +106,6 @@ rangeEx x y = if y > x then x .. (y - 1) else []
 
 infix 8 rangeEx as ..<
 
-diagramEdges :: Diagram -> Edges Int
-diagramEdges { width, pixels } = concat $ zipWith (zipWith (\src tgt -> { src, tgt })) rows (drop 1 rows)
-  where
-    rows = chunks width pixels
-
 chunks :: ∀ a. Int -> Array a -> Array (Array a)
 chunks _ [] = []
 chunks n xs = [take n xs] <> (chunks n $ drop n xs)
diff --git a/stbx-lang/test/Wiring.purs b/stbx-lang/test/Wiring.purs
index 773cefcf..04fac6a2 100644
--- a/stbx-lang/test/Wiring.purs
+++ b/stbx-lang/test/Wiring.purs
@@ -9,7 +9,7 @@ import Language.Statebox as Statebox
 import Language.Statebox.Hypergraph (HyperEdgeF(..), GElemF(..))
 import Language.Statebox.Wiring.AST (Label, stripSpan)
 import Language.Statebox.Wiring.Generator.Diagram (toDiagramWithName)
-import Language.Statebox.Wiring.Generator.DiagramV2 (diagramEdges, fromEdges)
+import Language.Statebox.Wiring.Generator.DiagramV2 (fromDiagram, fromWiring)
 import Statebox.Core.Types (Diagram)
 import Test.Spec                  (Spec, describe, it)
 import Test.Spec.Assertions       (shouldEqual)
@@ -22,9 +22,12 @@ spec = do
     it "should parse wirings correctly" do
       let ast = Statebox.parseWiring wiring1src
       let diagram1 = toDiagramWithName "dummy" <$> ast
-      let diagramv2 = diagram1 <#> diagramEdges <#> fromEdges <#> \{pixels, context} -> spy pixels (spy context "newline hack")
+      let diagramv2 = diagram1 <#> fromDiagram
+      let diagramv2' = ast <#> fromWiring
+      let dummy = diagramv2 <#> \{pixels, context} -> spy pixels (spy context "newline hack")
       (ast # map (map (lmap stripSpan))) `shouldEqual` pure wiring1expected
       diagram1 `shouldEqual` pure diagram1expected
+      diagramv2 `shouldEqual` diagramv2'
 
 wiring1src :: String
 wiring1src = trim """

From 224a99786e6b3c19d4fd80e637653824d02cacc4 Mon Sep 17 00:00:00 2001
From: Erik Post <erik@shinsetsu.nl>
Date: Fri, 29 Nov 2019 02:20:25 +0100
Subject: [PATCH 3/4] Rename Wiring and Diagram-related functions and rearrange
 tests. #278

---
 stbx-lang/src/Language/Statebox.purs          |  6 +-
 .../src/Language/Statebox/Net/Parser.purs     |  4 +-
 .../Statebox/Wiring/Generator/DiagramV2.purs  |  9 +-
 .../src/Language/Statebox/Wiring/Parser.purs  |  4 +-
 stbx-lang/test/Wiring.purs                    | 86 +++++++++++--------
 5 files changed, 59 insertions(+), 50 deletions(-)

diff --git a/stbx-lang/src/Language/Statebox.purs b/stbx-lang/src/Language/Statebox.purs
index 3393dea1..8d06e101 100644
--- a/stbx-lang/src/Language/Statebox.purs
+++ b/stbx-lang/src/Language/Statebox.purs
@@ -11,7 +11,7 @@ import Language.Statebox.Wiring.AST (GElem(..)) as Wiring
 import Language.Statebox.Wiring.Parser as WiringParser
 
 parseNet :: String -> Either ParseError (List Net.GElem)
-parseNet src = runParser src NetParser.graph1
+parseNet src = runParser src NetParser.net
 
-parseWiring :: String -> Either ParseError (List Wiring.GElem)
-parseWiring src = runParser src WiringParser.graph1
+parseDiagram :: String -> Either ParseError (List Wiring.GElem)
+parseDiagram src = runParser src WiringParser.diagram
diff --git a/stbx-lang/src/Language/Statebox/Net/Parser.purs b/stbx-lang/src/Language/Statebox/Net/Parser.purs
index 73c3b97e..b12405d7 100644
--- a/stbx-lang/src/Language/Statebox/Net/Parser.purs
+++ b/stbx-lang/src/Language/Statebox/Net/Parser.purs
@@ -18,8 +18,8 @@ import Language.Statebox.Hypergraph (NodeF(..), HyperEdgeF(..), GElemF(..))
 import Language.Statebox.Net.AST (Node(..), HyperEdge(..), LabelWithSpan, LabelWithSpanWithType, GElem(..))
 import Language.Statebox.Parser.Util (getPosition, hspaces, inside, isAlphaNum, someOf)
 
-graph1 :: Parser String (List GElem)
-graph1 = (gElem `inside` hspaces) `sepEndBy` (semicolon <|> newlines)
+net :: Parser String (List GElem)
+net = (gElem `inside` hspaces) `sepEndBy` (semicolon <|> newlines)
   where
     newlines = skipMany1 (char '\n')
     semicolon = const unit <$> char ';'
diff --git a/stbx-lang/src/Language/Statebox/Wiring/Generator/DiagramV2.purs b/stbx-lang/src/Language/Statebox/Wiring/Generator/DiagramV2.purs
index 3bbf8657..11780286 100644
--- a/stbx-lang/src/Language/Statebox/Wiring/Generator/DiagramV2.purs
+++ b/stbx-lang/src/Language/Statebox/Wiring/Generator/DiagramV2.purs
@@ -20,14 +20,14 @@ import Statebox.Core.Types (Diagram)
 import Language.Statebox.Wiring.Generator (Edges, toIndexedGraph, getEdges)
 import Language.Statebox.Wiring.AST (GElem)
 
+-- | A kdmoncat-compatible diagram in source code representation.
 type DiagramV2 =
-  { pixels :: String
+  { pixels  :: String
   , context :: String
   }
 
-
-fromWiring :: List GElem -> DiagramV2
-fromWiring ast = fromEdges (_ - 1) name edges
+fromDiagramAst :: List GElem -> DiagramV2
+fromDiagramAst ast = fromEdges (_ - 1) name edges
   where
     { graph, names } = toIndexedGraph ast
     edges = getEdges graph
@@ -40,7 +40,6 @@ fromDiagram { width, pixels, names } = fromEdges (_ - 1) name edges
     edges = concat $ zipWith (zipWith (\src tgt -> { src, tgt })) rows (drop 1 rows)
     name id = names !! (id - 1) # fromMaybe "?"
 
-
 fromEdges :: ∀ a. Ord a => Tabulate a => (a -> Int) -> (a -> String) -> Edges a -> DiagramV2
 fromEdges fromEnum name edges = { pixels, context }
   where
diff --git a/stbx-lang/src/Language/Statebox/Wiring/Parser.purs b/stbx-lang/src/Language/Statebox/Wiring/Parser.purs
index d999d08f..646c316b 100644
--- a/stbx-lang/src/Language/Statebox/Wiring/Parser.purs
+++ b/stbx-lang/src/Language/Statebox/Wiring/Parser.purs
@@ -18,8 +18,8 @@ import Language.Statebox.Hypergraph (NodeF(..), HyperEdgeF(..), GElemF(..))
 import Language.Statebox.Wiring.AST (Node(..), HyperEdge(..), LabelWithSpan, GElem(..))
 import Language.Statebox.Parser.Util (getPosition, hspaces, inside, isAlphaNum, someOf)
 
-graph1 :: Parser String (List GElem)
-graph1 = (gElem `inside` hspaces) `sepEndBy` (semicolon <|> newlines)
+diagram :: Parser String (List GElem)
+diagram = (gElem `inside` hspaces) `sepEndBy` (semicolon <|> newlines)
   where
     newlines = skipMany1 (char '\n')
     semicolon = const unit <$> char ';'
diff --git a/stbx-lang/test/Wiring.purs b/stbx-lang/test/Wiring.purs
index 04fac6a2..4803da70 100644
--- a/stbx-lang/test/Wiring.purs
+++ b/stbx-lang/test/Wiring.purs
@@ -5,53 +5,63 @@ import Data.Bifunctor (lmap)
 import Data.List as List
 import Data.List (List)
 import Data.String (trim)
-import Language.Statebox as Statebox
+import Language.Statebox as Stbx
 import Language.Statebox.Hypergraph (HyperEdgeF(..), GElemF(..))
 import Language.Statebox.Wiring.AST (Label, stripSpan)
-import Language.Statebox.Wiring.Generator.Diagram (toDiagramWithName)
-import Language.Statebox.Wiring.Generator.DiagramV2 (fromDiagram, fromWiring)
+import Language.Statebox.Wiring.Generator.Diagram (toDiagramWithName) as DiagramV1
+import Language.Statebox.Wiring.Generator.DiagramV2 as DiagramV2
 import Statebox.Core.Types (Diagram)
-import Test.Spec                  (Spec, describe, it)
-import Test.Spec.Assertions       (shouldEqual)
+import Test.Spec (Spec, describe, it)
+import Test.Spec.Assertions (shouldEqual)
 
 import Debug.Trace (spy)
 
 spec :: Spec Unit
 spec = do
   describe "Statebox wiring compiler" do
-    it "should parse wirings correctly" do
-      let ast = Statebox.parseWiring wiring1src
-      let diagram1 = toDiagramWithName "dummy" <$> ast
-      let diagramv2 = diagram1 <#> fromDiagram
-      let diagramv2' = ast <#> fromWiring
-      let dummy = diagramv2 <#> \{pixels, context} -> spy pixels (spy context "newline hack")
-      (ast # map (map (lmap stripSpan))) `shouldEqual` pure wiring1expected
-      diagram1 `shouldEqual` pure diagram1expected
-      diagramv2 `shouldEqual` diagramv2'
-
-wiring1src :: String
-wiring1src = trim """
-a1 -> b1, b2
-b1 -> d1
-b2 -> c1
-c1 -> d1
-"""
-
-wiring1expected :: List (GElemF List Label Unit)
-wiring1expected = mkAst
-  [ mkEdge ["a1"] ["b1", "b2"]
-  , mkEdge ["b1"] ["d1"]
-  , mkEdge ["b2"] ["c1"]
-  , mkEdge ["c1"] ["d1"]
-  ]
-
-diagram1expected :: Diagram
-diagram1expected =
-  { name: "dummy"
-  , width: 5
-  , pixels: [ 1, 1, 2, 3, 5, 2, 3, 4, 5, 4 ]
-  , names: [ "a1", "b1", "b2", "d1", "c1" ]
-  }
+    let
+      diagramSrc :: String
+      diagramSrc = trim """
+        a1 -> b1, b2
+        b1 -> d1
+        b2 -> c1
+        c1 -> d1
+        """
+
+      diagramAstExpected :: List (GElemF List Label Unit)
+      diagramAstExpected = mkAst
+        [ mkEdge ["a1"] ["b1", "b2"]
+        , mkEdge ["b1"] ["d1"]
+        , mkEdge ["b2"] ["c1"]
+        , mkEdge ["c1"] ["d1"]
+        ]
+
+      diagramV1Expected :: Diagram
+      diagramV1Expected =
+        { name: "diagramV1"
+        , width: 5
+        , pixels: [ 1, 1, 2, 3, 5, 2, 3, 4, 5, 4 ]
+        , names: [ "a1", "b1", "b2", "d1", "c1" ]
+        }
+
+    it "should parse a diagram correctly" do
+      let
+        diagramAstWithSpans = Stbx.parseDiagram diagramSrc
+        diagramAst = diagramAstWithSpans # map (map (lmap stripSpan))
+      diagramAst `shouldEqual` pure diagramAstExpected
+
+    it "should compile a diagram AST to the corresponding Diagram (v1)" do
+      let
+        diagramAstWithSpans = Stbx.parseDiagram diagramSrc -- TODO we don't want spans here
+        diagramV1 = DiagramV1.toDiagramWithName "diagramV1" <$> diagramAstWithSpans
+      diagramV1 `shouldEqual` pure diagramV1Expected
+
+    it "should convert a Diagram (v1) to its correspondingDiagramV2 (kdmoncat)" do
+      let
+        diagramAstWithSpans = Stbx.parseDiagram diagramSrc -- TODO we don't want spans here
+        diagramV2  = DiagramV2.fromDiagram     $  diagramV1Expected
+        diagramV2' = DiagramV2.fromDiagramAst <$> diagramAstWithSpans
+      pure diagramV2 `shouldEqual` diagramV2'
 
 --------------------------------------------------------------------------------
 -- graph DSL

From cc4cc1bf43ecca9621908366259d0559c4c6fd85 Mon Sep 17 00:00:00 2001
From: Erik Post <erik@shinsetsu.nl>
Date: Mon, 2 Dec 2019 20:42:38 +0100
Subject: [PATCH 4/4] Add a bunch of newlines. #278

---
 .../Statebox/Wiring/Generator/DiagramV2.purs       | 14 ++++++++++++++
 1 file changed, 14 insertions(+)

diff --git a/stbx-lang/src/Language/Statebox/Wiring/Generator/DiagramV2.purs b/stbx-lang/src/Language/Statebox/Wiring/Generator/DiagramV2.purs
index 11780286..81dbbb7e 100644
--- a/stbx-lang/src/Language/Statebox/Wiring/Generator/DiagramV2.purs
+++ b/stbx-lang/src/Language/Statebox/Wiring/Generator/DiagramV2.purs
@@ -48,38 +48,51 @@ fromEdges fromEnum name edges = { pixels, context }
 
     predecessors :: Map a (Array a)
     predecessors = edges <#> (\{ src, tgt } -> tgt /\ [src]) # mfromFoldable
+
     successors :: Map a (Array a)
     successors = edges <#> (\{ src, tgt } -> src /\ [tgt]) # mfromFoldable
+
     inputs :: Map a (Array Int)
     inputs = edges # mapWithIndex (\i { tgt } -> tgt /\ [i]) # mfromFoldable
+
     outputs :: Map a (Array Int)
     outputs = edges # mapWithIndex (\i { src } -> src /\ [i]) # mfromFoldable
+
     level :: a -> Int
     level = memoize \a -> mlookup a predecessors <#> level # maximum # maybe 0 (_ + 1)
+
     nodes :: List a
     nodes = (successors `union` predecessors) # keys
+
     grouped :: Array (Array a)
     grouped = nodes <#> (\id -> level id /\ [id]) # mfromFoldable # toUnfoldable <#> snd
+
     width = length grouped
     height = grouped <#> length # maximum # fromMaybe 0
+
     typeStr :: a -> Map a (Array a) -> (a -> String) -> String
     typeStr a m f = mlookup a m <#> f # intercalate " "
+
     pixel :: a -> String
     pixel a = nextChar 'A' (fromEnum a)
+
     nodeType :: a -> String
     nodeType a = name a <> "@" <> pixel a <> ": " <> typeStr a predecessors (\b -> name b <> "_" <> name a)
                                         <> " -> " <> typeStr a successors   (\b -> name a <> "_" <> name b)
     nodeTypes :: String
     nodeTypes = map nodeType nodes # intercalate "\n"
+
     row :: Int -> String
     row y = grouped # foldMapWithIndex \x g ->
       ((g !! y) # maybe (if x > 0 && x < width - 1 then nextChar 'n' (x - 1) else " ") pixel) <>
       if x < width - 1 then nextChar 'a' x else ""
+
     swapTypes :: String
     swapTypes = grouped
               # uncons
              <#> (\{ head, tail } -> mapAccumLWithIndex mkSwap (levelOutputs head) tail)
               # maybe "" (_.value >>> intercalate "\n")
+
     mkSwap :: Int -> Array Int -> Array a -> { accum :: Array Int, value :: String }
     mkSwap i edgeIds as = { accum: levelOutputs as <> rest, value }
       where
@@ -88,6 +101,7 @@ fromEdges fromEnum name edges = { pixels, context }
         ids = foldMap (\a -> mlookup a inputs) as
         order = (ids <> rest) <#> \id -> elemIndex id edgeIds # maybe "?" ((_ + 1) >>> show)
         rest = filter (\id -> id `notElem` ids) edgeIds
+
     levelOutputs :: Array a -> Array Int
     levelOutputs = foldMap (\a -> mlookup a outputs)