diff --git a/CHANGELOG.md b/CHANGELOG.md
new file mode 100644
--- /dev/null
+++ b/CHANGELOG.md
@@ -0,0 +1,3 @@
+## [0.3.0.6](https://github.com/PiotrJustyna/wyvern/tree/0.3.0.6) (2026-01-14)
+
+- Producing wyvern release candidate for hackage.
diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,11 @@
+Copyright (c) 2026, Piotr Justyna
+
+Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:
+
+1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.
+
+2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution.
+
+3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/diagrams/bubble-sort-clash-example-1.txt b/diagrams/bubble-sort-clash-example-1.txt
new file mode 100644
--- /dev/null
+++ b/diagrams/bubble-sort-clash-example-1.txt
@@ -0,0 +1,91 @@
+1 "question 1"
+{
+ a "question a"
+ {
+ b "action b"
+ }
+ {
+ c "action c"
+ d "question d"
+ {
+ e "action e"
+ }
+ {
+ f "question f"
+ {
+ g "action g"
+ }
+ {
+ h "action h"
+ f
+ }
+ d
+ }
+ a
+ }
+ y "action y"
+ z "question z"
+ {
+ "hello"
+ }
+ {
+ "world"
+ z1 "action z1"
+ z1a "question z1a"
+ {
+ z1b "action z1b"
+ }
+ {
+ z1c "question z1c"
+ {
+ z1d "action z1d"
+ }
+ {
+ z1e "action z1e"
+ z1f "question z1f"
+ {
+ z1g "action z1g"
+ }
+ {
+ z1h "action z1h"
+ a
+ }
+ a
+ }
+ a
+ }
+ z2 "question z2"
+ {
+ z3 "action z3"
+ z4 "action z4"
+ }
+ {
+ z5 "action z5"
+ a
+ }
+ a
+ }
+}
+{
+ "action 2"
+ 2 "question 2"
+ {
+ "action 3"
+ "action 4"
+ }
+ {
+ "action 5"
+ 6 "action 6"
+ 1
+ }
+ "action 7"
+ 1
+}
+3 "question 3"
+{
+ "action 8"
+}
+{
+ "action 9"
+ 1
+}
diff --git a/diagrams/cover-diagram.svg b/diagrams/cover-diagram.svg
new file mode 100644
--- /dev/null
+++ b/diagrams/cover-diagram.svg
@@ -0,0 +1,3 @@
+
+
diff --git a/diagrams/development-environment-old.svg b/diagrams/development-environment-old.svg
new file mode 100644
--- /dev/null
+++ b/diagrams/development-environment-old.svg
@@ -0,0 +1,3 @@
+
+
diff --git a/diagrams/development-environment.svg b/diagrams/development-environment.svg
new file mode 100644
--- /dev/null
+++ b/diagrams/development-environment.svg
@@ -0,0 +1,3 @@
+
+
diff --git a/diagrams/development-environment.txt b/diagrams/development-environment.txt
new file mode 100644
--- /dev/null
+++ b/diagrams/development-environment.txt
@@ -0,0 +1,45 @@
+0 "using containers?"
+ {
+ 0l1 "./start-development-environment.sh"
+ 0l2 "change code"
+ 0l3 "build needed?"
+ {
+ 0l3l1 "./build.sh"
+ }
+ {
+ }
+ 0l4 "run the program?"
+ {
+ 0l4l1 "./run.sh"
+ }
+ {
+ }
+ 0l5 "exit?"
+ {
+ 0l5l1 "exit"
+ }
+ {
+ 0l2
+ }
+ }
+ {
+ 0r2 "change code"
+ 0r3 "build needed?"
+ {
+ 0r3l1 "./build.sh"
+ }
+ {
+ }
+ 0r4 "run the program?"
+ {
+ 0l4l1 "./run.sh"
+ }
+ {
+ }
+ 0r5 "exit?"
+ {
+ }
+ {
+ 0r2
+ }
+ }
diff --git a/diagrams/simple-diagram-1.svg b/diagrams/simple-diagram-1.svg
new file mode 100644
--- /dev/null
+++ b/diagrams/simple-diagram-1.svg
@@ -0,0 +1,3 @@
+
+
diff --git a/diagrams/simple-diagram-1.txt b/diagrams/simple-diagram-1.txt
new file mode 100644
--- /dev/null
+++ b/diagrams/simple-diagram-1.txt
@@ -0,0 +1,3 @@
+1 "action 1"
+2 "action 2"
+3 "action 3"
diff --git a/diagrams/simple-diagram-2.svg b/diagrams/simple-diagram-2.svg
new file mode 100644
--- /dev/null
+++ b/diagrams/simple-diagram-2.svg
@@ -0,0 +1,3 @@
+
+
diff --git a/diagrams/simple-diagram-2.txt b/diagrams/simple-diagram-2.txt
new file mode 100644
--- /dev/null
+++ b/diagrams/simple-diagram-2.txt
@@ -0,0 +1,9 @@
+1 "action 1"
+2 "question 2"
+{
+ 3 "action 3"
+}
+{
+ 4 "action 4"
+}
+5 "action 5"
diff --git a/diagrams/simple-diagram-3.svg b/diagrams/simple-diagram-3.svg
new file mode 100644
--- /dev/null
+++ b/diagrams/simple-diagram-3.svg
@@ -0,0 +1,3 @@
+
+
diff --git a/diagrams/simple-diagram-3.txt b/diagrams/simple-diagram-3.txt
new file mode 100644
--- /dev/null
+++ b/diagrams/simple-diagram-3.txt
@@ -0,0 +1,10 @@
+1 "action 1"
+2 "question 2"
+{
+ 3 "action 3"
+}
+{
+ 4 "action 4"
+ 2
+}
+5 "action 5"
diff --git a/diagrams/simple-diagram-4.svg b/diagrams/simple-diagram-4.svg
new file mode 100644
--- /dev/null
+++ b/diagrams/simple-diagram-4.svg
@@ -0,0 +1,3 @@
+
+
diff --git a/diagrams/simple-diagram-4.txt b/diagrams/simple-diagram-4.txt
new file mode 100644
--- /dev/null
+++ b/diagrams/simple-diagram-4.txt
@@ -0,0 +1,29 @@
+1 "action 1"
+2 "question 2"
+{
+ 21 "question 21"
+ {
+ 211 "action 211"
+ 212 "action 212"
+ 213 "action 213"
+ }
+ {
+ 214 "action 214"
+ 21
+ }
+}
+{
+ 22 "question 22"
+ {
+ 221 "action 221"
+ 222 "action 222"
+ 223 "action 223"
+ 224 "action 224"
+ }
+ {
+ 225 "action 225"
+ 22
+ }
+ 2
+}
+5 "action 5"
diff --git a/diagrams/simple-diagram-5.svg b/diagrams/simple-diagram-5.svg
new file mode 100644
--- /dev/null
+++ b/diagrams/simple-diagram-5.svg
@@ -0,0 +1,3 @@
+
+
diff --git a/diagrams/simple-diagram-5.txt b/diagrams/simple-diagram-5.txt
new file mode 100644
--- /dev/null
+++ b/diagrams/simple-diagram-5.txt
@@ -0,0 +1,100 @@
+1 "question 1"
+{
+ a "question a"
+ {
+ b "action b"
+ }
+ {
+ c "action c"
+ d "question d"
+ {
+ e "action e"
+ }
+ {
+ f "question f"
+ {
+ g "action g"
+ }
+ {
+ h "action h"
+ f
+ }
+ d
+ }
+ a
+ }
+ y "action y"
+ z "question z"
+ {
+ "hello"
+ }
+ {
+ "world"
+ z1 "action z1"
+ z1a "question z1a"
+ {
+ z1b "action z1b"
+ "action z1b1"
+ }
+ {
+ z1c "question z1c"
+ {
+ z1d "action z1d"
+ }
+ {
+ z1e "action z1e"
+ z1f "question z1f"
+ {
+ z1g "action z1g"
+ }
+ {
+ z1h "action z1h"
+ a
+ }
+ a
+ }
+ a
+ }
+ z2 "question z2"
+ {
+ z3 "action z3"
+ z4 "action z4"
+ }
+ {
+ z5 "action z5"
+ a
+ }
+ oi1 "question oi1"
+ {
+ oi2 "action oi2"
+ }
+ {
+ oi3 "action oi3"
+ a
+ }
+ a
+ }
+}
+{
+ "action 2"
+ 2 "question 2"
+ {
+ "action 3"
+ "action 4"
+ }
+ {
+ "action 5"
+ 6 "action 6"
+ 1
+ }
+ 7 "action 7"
+ 1
+}
+3 "question 3"
+{
+ "action 8"
+}
+{
+ 9 "action 9"
+ 1
+}
diff --git a/diagrams/simple-diagram-6.svg b/diagrams/simple-diagram-6.svg
new file mode 100644
--- /dev/null
+++ b/diagrams/simple-diagram-6.svg
@@ -0,0 +1,3 @@
+
+
diff --git a/diagrams/simple-diagram-6.txt b/diagrams/simple-diagram-6.txt
new file mode 100644
--- /dev/null
+++ b/diagrams/simple-diagram-6.txt
@@ -0,0 +1,118 @@
+1 "question 1"
+{
+ a "question a"
+ {
+ b "action b"
+ }
+ {
+ c "action c"
+ d "question d"
+ {
+ e "action e"
+ }
+ {
+ f "question f"
+ {
+ g "action g"
+ }
+ {
+ f
+ }
+ d
+ }
+ a
+ }
+ y "action y"
+ z "question z"
+ {
+ "hello"
+ }
+ {
+ "world"
+ z1 "action z1"
+ z1a "question z1a"
+ {
+ z1b "action z1b"
+ }
+ {
+ z1c "question z1c"
+ {
+ z1d "action z1d"
+ }
+ {
+ z1e "action z1e"
+ z1f "question z1f"
+ {
+ z1g "action z1g"
+ }
+ {
+ z1h "action z1h"
+ a
+ }
+ a
+ }
+ a
+ }
+ z2 "question z2"
+ {
+ z3 "action z3"
+ z4 "action z4"
+ }
+ {
+ z5 "action z5"
+ a
+ }
+ oi1 "question oi1"
+ {
+ oi2 "action oi2"
+ }
+ {
+ oi3 "action oi3"
+ a
+ }
+ a
+ }
+}
+{
+ "action 2"
+ 2 "question 2"
+ {
+ "action 3"
+ "action 4"
+ }
+ {
+ "action 5"
+ 6 "action 6"
+ 1
+ }
+ 7 "action 7"
+ 8 "question 8"
+ {
+ "action 9"
+ "action 10"
+ "action 11"
+ "action 12"
+ }
+ {
+ "action 9"
+ 10 "action 10"
+ 12 "question 12"
+ {
+ "action 13 a"
+ "action 13 b"
+ }
+ {
+ "action 13"
+ }
+ 10
+ }
+ 1
+}
+3 "question 3"
+{
+ "action 8"
+}
+{
+ 9 "action 9"
+ 1
+}
diff --git a/diagrams/simple-diagram-7.svg b/diagrams/simple-diagram-7.svg
new file mode 100644
--- /dev/null
+++ b/diagrams/simple-diagram-7.svg
@@ -0,0 +1,3 @@
+
+
diff --git a/diagrams/simple-diagram-7.txt b/diagrams/simple-diagram-7.txt
new file mode 100644
--- /dev/null
+++ b/diagrams/simple-diagram-7.txt
@@ -0,0 +1,261 @@
+h1 "headline 1"
+{
+ 0a "action 0"
+ 1a "question 1"
+ {
+ aa "question a"
+ {
+ ba "action b"
+ }
+ {
+ ca "action c"
+ da "question d"
+ {
+ ea "action e"
+ }
+ {
+ fa "question f"
+ {
+ ga "action g"
+ }
+ {
+ fa
+ }
+ da
+ }
+ aa
+ }
+ ya "action y"
+ za "question z"
+ {
+ "hello"
+ }
+ {
+ "world"
+ z1a "action z1"
+ z1aa "question z1a"
+ {
+ z1ba "action z1b"
+ }
+ {
+ z1ca "question z1c"
+ {
+ z1da "action z1d"
+ }
+ {
+ z1ea "action z1e"
+ z1fa "question z1f"
+ {
+ z1ga "action z1g"
+ }
+ {
+ z1ha "action z1h"
+ aa
+ }
+ aa
+ }
+ aa
+ }
+ z2a "question z2"
+ {
+ z3a "action z3"
+ z4a "action z4"
+ }
+ {
+ z5a "action z5"
+ aa
+ }
+ oi1a "question oi1"
+ {
+ oi2a "action oi2"
+ }
+ {
+ oi3a "action oi3"
+ aa
+ }
+ aa
+ }
+ }
+ {
+ "action 2"
+ 2a "question 2"
+ {
+ "action 3"
+ "action 4"
+ }
+ {
+ "action 5"
+ 6a "action 6"
+ 1a
+ }
+ 7a "action 7"
+ 8a "question 8"
+ {
+ "action 9"
+ "action 10"
+ "action 11"
+ "action 12"
+ }
+ {
+ "action 9"
+ 10a "action 10"
+ 12a "question 12"
+ {
+ "action 13"
+ }
+ {
+ "action 13"
+ }
+ 10a
+ }
+ 1a
+ }
+ 3a "question 3"
+ {
+ "action 8"
+ }
+ {
+ 9a "action 9"
+ 1a
+ }
+ "final action"
+ h2
+}
+h2 "headline 2"
+{
+ 0b "action 0"
+ 1b "question 1"
+ {
+ ab "question a"
+ {
+ bb "action b"
+ }
+ {
+ cb "action c"
+ db "question d"
+ {
+ eb "action e"
+ }
+ {
+ fb "question f"
+ {
+ gb "action g"
+ }
+ {
+ fb
+ }
+ db
+ }
+ ab
+ }
+ yb "action y"
+ zb "question z"
+ {
+ "hello"
+ }
+ {
+ "world"
+ z1b "action z1"
+ z1ab "question z1a"
+ {
+ z1bb "action z1b"
+ }
+ {
+ z1cb "question z1c"
+ {
+ z1db "action z1d"
+ }
+ {
+ z1eb "action z1e"
+ z1fb "question z1f"
+ {
+ z1gb "action z1g"
+ "question x"
+ {
+ "hello"
+ }
+ {
+ "world"
+ z1gba "another"
+ {
+ "hello"
+ }
+ {
+ "world"
+ z1gba
+ }
+ z1gb
+ }
+ }
+ {
+ z1hb "action z1h"
+ ab
+ }
+ ab
+ }
+ ab
+ }
+ z2b "question z2"
+ {
+ z3b "action z3"
+ z4b "action z4"
+ }
+ {
+ z5b "action z5"
+ ab
+ }
+ oi1b "question oi1"
+ {
+ oi2b "action oi2"
+ }
+ {
+ oi3b "action oi3"
+ ab
+ }
+ ab
+ }
+ }
+ {
+ "action 2"
+ 2b "question 2"
+ {
+ "action 3"
+ "action 4"
+ }
+ {
+ "action 5"
+ 6b "action 6"
+ 1b
+ }
+ 7b "action 7"
+ 8b "question 8"
+ {
+ "action 9"
+ "action 10"
+ "action 11"
+ "action 12"
+ }
+ {
+ "action 9"
+ 10b "action 10"
+ 12b "question 12"
+ {
+ "action 13"
+ }
+ {
+ "action 13"
+ }
+ 10b
+ }
+ 1b
+ }
+ 3b "question 3"
+ {
+ "action 8"
+ }
+ {
+ 9b "action 9"
+ 1b
+ }
+ "final action"
+}
diff --git a/diagrams/simple-diagram-8.svg b/diagrams/simple-diagram-8.svg
new file mode 100644
--- /dev/null
+++ b/diagrams/simple-diagram-8.svg
@@ -0,0 +1,3 @@
+
+
diff --git a/diagrams/simple-diagram-8.txt b/diagrams/simple-diagram-8.txt
new file mode 100644
--- /dev/null
+++ b/diagrams/simple-diagram-8.txt
@@ -0,0 +1,33 @@
+h1 "headline 1"
+{
+ "action 1"
+ "action 1 a"
+ "action 1 b"
+ h2
+}
+h2 "headline 2"
+{
+ "action 2"
+ "action 2a"
+ "action 2b"
+ h3
+}
+h3 "headline 3"
+{
+ "action 3"
+ "action 3a"
+ "action 3b"
+ "action 3c"
+ "action 3d"
+ h4
+}
+h4 "headline 4"
+{
+ "action 4"
+ "action 4a"
+ h5
+}
+h5 "headline 5"
+{
+ "action 5"
+}
diff --git a/diagrams/simple-diagram-9.svg b/diagrams/simple-diagram-9.svg
new file mode 100644
--- /dev/null
+++ b/diagrams/simple-diagram-9.svg
@@ -0,0 +1,3 @@
+
+
diff --git a/diagrams/simple-diagram-9.txt b/diagrams/simple-diagram-9.txt
new file mode 100644
--- /dev/null
+++ b/diagrams/simple-diagram-9.txt
@@ -0,0 +1,266 @@
+h1 "headline 1"
+{
+ 0a "action 0"
+ 1a "question 1"
+ {
+ aa "question a"
+ {
+ ba "action b"
+ }
+ {
+ ca "action c"
+ da "question d"
+ {
+ ea "action e"
+ }
+ {
+ fa "question f"
+ {
+ ga "action g"
+ }
+ {
+ fa
+ }
+ da
+ }
+ aa
+ }
+ ya "action y"
+ za "question z"
+ {
+ "hello"
+ }
+ {
+ "world"
+ z1a "action z1"
+ z1aa "question z1a"
+ {
+ z1ba "action z1b"
+ }
+ {
+ z1ca "question z1c"
+ {
+ z1da "action z1d"
+ }
+ {
+ z1ea "action z1e"
+ z1fa "question z1f"
+ {
+ z1ga "action z1g"
+ }
+ {
+ z1ha "action z1h"
+ aa
+ }
+ aa
+ }
+ aa
+ }
+ z2a "question z2"
+ {
+ z3a "action z3"
+ z4a "action z4"
+ }
+ {
+ z5a "action z5"
+ aa
+ }
+ oi1a "question oi1"
+ {
+ oi2a "action oi2"
+ }
+ {
+ oi3a "action oi3"
+ aa
+ }
+ aa
+ }
+ }
+ {
+ "action 2"
+ 2a "question 2"
+ {
+ "action 3"
+ "action 4"
+ }
+ {
+ "action 5"
+ 6a "action 6"
+ 1a
+ }
+ 7a "action 7"
+ 8a "question 8"
+ {
+ "action 9"
+ "action 10"
+ "action 11"
+ "action 12"
+ }
+ {
+ "action 9"
+ 10a "action 10"
+ 12a "question 12"
+ {
+ "action 13"
+ }
+ {
+ "action 13"
+ }
+ 10a
+ }
+ 1a
+ }
+ 3a "question 3"
+ {
+ "action 8"
+ }
+ {
+ 9a "action 9"
+ 1a
+ }
+ "final action"
+ h2
+}
+h2 "headline 2"
+{
+ "Hello, World!"
+ h3
+}
+h3 "headline 3"
+{
+ 0b "action 0"
+ 1b "question 1"
+ {
+ ab "question a"
+ {
+ bb "action b"
+ }
+ {
+ cb "action c"
+ db "question d"
+ {
+ eb "action e"
+ }
+ {
+ fb "question f"
+ {
+ gb "action g"
+ }
+ {
+ fb
+ }
+ db
+ }
+ ab
+ }
+ yb "action y"
+ zb "question z"
+ {
+ "hello"
+ }
+ {
+ "world"
+ z1b "action z1"
+ z1ab "question z1a"
+ {
+ z1bb "action z1b"
+ }
+ {
+ z1cb "question z1c"
+ {
+ z1db "action z1d"
+ }
+ {
+ z1eb "action z1e"
+ z1fb "question z1f"
+ {
+ z1gb "action z1g"
+ "question x"
+ {
+ "hello"
+ }
+ {
+ "world"
+ z1gba "another"
+ {
+ "hello"
+ }
+ {
+ "world"
+ z1gba
+ }
+ z1gb
+ }
+ }
+ {
+ z1hb "action z1h"
+ ab
+ }
+ ab
+ }
+ ab
+ }
+ z2b "question z2"
+ {
+ z3b "action z3"
+ z4b "action z4"
+ }
+ {
+ z5b "action z5"
+ ab
+ }
+ oi1b "question oi1"
+ {
+ oi2b "action oi2"
+ }
+ {
+ oi3b "action oi3"
+ ab
+ }
+ ab
+ }
+ }
+ {
+ "action 2"
+ 2b "question 2"
+ {
+ "action 3"
+ "action 4"
+ }
+ {
+ "action 5"
+ 6b "action 6"
+ 1b
+ }
+ 7b "action 7"
+ 8b "question 8"
+ {
+ "action 9"
+ "action 10"
+ "action 11"
+ "action 12"
+ }
+ {
+ "action 9"
+ 10b "action 10"
+ 12b "question 12"
+ {
+ "action 13"
+ }
+ {
+ "action 13"
+ }
+ 10b
+ }
+ 1b
+ }
+ 3b "question 3"
+ {
+ "action 8"
+ }
+ {
+ 9b "action 9"
+ 1b
+ }
+ "final action"
+}
diff --git a/diagrams/temp.svg b/diagrams/temp.svg
new file mode 100644
--- /dev/null
+++ b/diagrams/temp.svg
@@ -0,0 +1,3 @@
+
+
diff --git a/diagrams/temp.txt b/diagrams/temp.txt
new file mode 100644
--- /dev/null
+++ b/diagrams/temp.txt
@@ -0,0 +1,29 @@
+"n = length of input"
+"swapped = false"
+1 "swapped"
+{
+}
+{
+ "i = 1"
+ 2 "i < n"
+ {
+ "input[i - 1] < input[i]"
+ {
+ }
+ {
+ "swap(input[i - 1], input[i])"
+ "swapped = true"
+ }
+ "i++"
+ 2
+ }
+ {
+ "a"
+ {
+ "1"
+ }
+ {
+ "2"
+ }
+ }
+}
diff --git a/src/app/Main.hs b/src/app/Main.hs
new file mode 100644
--- /dev/null
+++ b/src/app/Main.hs
@@ -0,0 +1,24 @@
+module Main where
+
+import Blocks (render)
+import Constants (svgOptions)
+import Diagrams.Backend.SVG (renderSVG')
+import InputArguments (inputPath, outputPath, parseInput)
+import Lexer (alexScanTokens)
+import Options.Applicative (execParser, fullDesc, header, helper, info, (<**>))
+import Parser (ParseResult (..), diagram)
+
+main :: IO ()
+main = do
+ input <- execParser options
+ print input
+ fileContent <- readFile $ inputPath input
+ let tokens = alexScanTokens fileContent
+ case diagram tokens 1 of
+ ParseOk d -> renderSVG' (outputPath input) svgOptions (Blocks.render d)
+ ParseFail s -> error s
+ where
+ options =
+ info
+ (parseInput <**> helper)
+ (fullDesc <> header "Wyvern")
diff --git a/src/lib/Blocks.hs b/src/lib/Blocks.hs
new file mode 100644
--- /dev/null
+++ b/src/lib/Blocks.hs
@@ -0,0 +1,179 @@
+module Blocks where
+
+import Constants (defaultBoundingBoxHeight, defaultBoundingBoxWidth, heightRatio, widthRatio)
+import Data.HashSet (HashSet, insert, member)
+import Data.List (groupBy, sortBy, sortOn)
+import Data.Map (Map, empty, insert, lookup)
+import Data.Ord (comparing)
+import Diagrams.Backend.SVG (B)
+import Diagrams.Prelude (Diagram, Point (..), V2 (..), p2, position, r2, translate, (#))
+import GHC.Float
+import HelperDiagrams (renderConnection, renderGammaConnection, renderLowerBetaConnections, renderSideBetaConnection, renderText, renderUpperBetaConnections, wyvernAddress, wyvernHeadline, wyvernQuestion, wyvernRect, wyvernRoundedRect)
+import ID
+
+data Block
+ = StartTerminator
+ | Action (Maybe ID) String
+ | Headline (Maybe ID) String
+ | Address (Maybe ID) String
+ | Fork (Maybe ID) String [Block] [Block] (Maybe ID)
+ | EndTerminator
+ deriving (Show)
+
+reverse' :: [Block] -> [Block]
+reverse' =
+ foldl
+ ( \accu x ->
+ case x of
+ Fork id content l r rId -> Fork id content (reverse' l) (reverse' r) rId : accu
+ _ -> x : accu
+ )
+ []
+
+reverse :: [[Block]] -> [[Block]]
+reverse = foldl (\accu x -> reverse' x : accu) []
+
+updateDestinations :: Maybe ID -> Point V2 Double -> Map ID (Point V2 Double) -> Map ID (Point V2 Double)
+updateDestinations i o origins =
+ case i of
+ Nothing -> origins
+ Just i' -> Data.Map.insert i' o origins
+
+getContent :: Block -> String
+getContent StartTerminator = "start"
+getContent EndTerminator = "end"
+getContent (Action _ c) = c
+getContent (Headline _ c) = c
+getContent (Address _ c) = c
+getContent (Fork _ c _ _ _) = c
+
+getIdentifier :: Block -> Maybe ID
+getIdentifier StartTerminator = Nothing
+getIdentifier EndTerminator = Nothing
+getIdentifier (Action i _) = i
+getIdentifier (Headline i _) = i
+getIdentifier (Address i _) = i
+getIdentifier (Fork i _ _ _ _) = i
+
+renderSingleBlock ::
+ Block ->
+ Point V2 Double ->
+ Map ID (Point V2 Double) ->
+ [(Point V2 Double, Double, Double, ID)] ->
+ Double ->
+ (Diagram B, Map ID (Point V2 Double), [(Point V2 Double, Double, Double, ID)], Double, Double, Double, Double)
+renderSingleBlock fork@(Fork i c l r gCId) o@(P (V2 oX oY)) ds gCs globalMaxWidth =
+ let (gCW, gCH) = case gCId of
+ Nothing -> (0.0, 0.0)
+ Just _ -> (0.1, 0.1)
+ (dQ, wQ, hQ) = (position [(o, wyvernQuestion c)], oX + defaultBoundingBoxWidth, oY - defaultBoundingBoxHeight)
+ lX = oX
+ lY = hQ
+ rX = maxWL
+ rY = hQ
+ (dL, dsL, gCsL, wL, hL, maxWL, minHL) = renderSingleSkewer l (p2 (lX, lY)) ds gCs 0.0
+ (dR, dsR, gCsR, wR, hR, maxWR, minHR) = renderSingleSkewer r (p2 (rX, if null r then oY else rY)) dsL gCsL globalMaxWidth
+ newMaxW = maxWR + gCW
+ newMaxW' = max newMaxW globalMaxWidth
+ newMinH = min minHL minHR - gCH
+ gCs' = case gCId of
+ Nothing -> gCsR
+ Just gCId' -> (p2 (wR, oY), newMaxW', if null r then hR else newMinH + defaultBoundingBoxHeight * 0.5, gCId') : gCsR
+ in ( dQ
+ <> dL
+ <> dR
+ <> (if null l then mempty else renderConnection [p2 (oX, hQ), o]) -- question -> left branch connection
+ <> renderConnection (if null r then [p2 (rX, oY), o] else [p2 (rX, rY), p2 (rX, oY), o]) -- question -> right branch connection
+ <> ( case gCId of
+ Nothing -> renderConnection [p2 (lX, newMinH + defaultBoundingBoxHeight * 0.5), p2 (rX, newMinH + defaultBoundingBoxHeight * 0.5), p2 (rX, hR)] -- right branch -> bottom of the fork connection
+ _ -> mempty
+ ),
+ dsR,
+ gCs',
+ wR,
+ hR,
+ newMaxW',
+ newMinH
+ )
+renderSingleBlock StartTerminator o@(P (V2 oX oY)) ds gCs abc = (position [(o, wyvernRoundedRect $ getContent StartTerminator)], ds, gCs, oX, oY, oX + defaultBoundingBoxWidth, oY - defaultBoundingBoxHeight)
+renderSingleBlock EndTerminator o@(P (V2 oX oY)) ds gCs abc = (position [(o, wyvernRoundedRect $ getContent EndTerminator)], ds, gCs, oX, oY, oX + defaultBoundingBoxWidth, oY - defaultBoundingBoxHeight)
+renderSingleBlock (Headline _i c) o@(P (V2 oX oY)) ds gCs abc = (position [(o, wyvernHeadline c)], ds, gCs, oX, oY, oX + defaultBoundingBoxWidth, oY - defaultBoundingBoxHeight)
+renderSingleBlock (Address _i c) o@(P (V2 oX oY)) ds gCs abc = (position [(o, wyvernAddress c)], ds, gCs, oX, oY, oX + defaultBoundingBoxWidth, oY - defaultBoundingBoxHeight)
+renderSingleBlock b o@(P (V2 oX oY)) ds gCs abc = (position [(o, wyvernRect $ getContent b)], ds, gCs, oX, oY, oX + defaultBoundingBoxWidth, oY - defaultBoundingBoxHeight)
+
+renderSingleSkewer ::
+ [Block] ->
+ Point V2 Double ->
+ Map ID (Point V2 Double) ->
+ [(Point V2 Double, Double, Double, ID)] ->
+ Double ->
+ (Diagram B, Map ID (Point V2 Double), [(Point V2 Double, Double, Double, ID)], Double, Double, Double, Double)
+renderSingleSkewer [] o@(P (V2 oX oY)) ds gCs globalWidth =
+ let w = oX
+ minD = oY
+ localWidth = w + defaultBoundingBoxWidth
+ localWidth' = max globalWidth localWidth
+ in (mempty, ds, gCs, w, minD, localWidth', minD)
+renderSingleSkewer [b] o@(P (V2 oX oY)) ds gCs globalWidth =
+ let ds' = updateDestinations (getIdentifier b) o ds
+ (d, ds'', gCs', w, h, maxW, minH) = renderSingleBlock b o ds' gCs globalWidth
+ in (d, ds'', gCs', oX, h, maxW, minH)
+renderSingleSkewer (b : bs) o@(P (V2 oX oY)) ds gCs globalWidth =
+ let ds' = updateDestinations (getIdentifier b) o ds
+ (d, ds'', gCs', w, h, maxW, minH) = renderSingleBlock b o ds' gCs globalWidth
+ (d', ds''', gCs'', w', h', maxW', minH') = renderSingleSkewer bs (p2 (oX, minH)) ds'' gCs' (maxW + 0.1)
+ in (d <> d' <> renderConnection [p2 (oX, minH), p2 (oX, oY)], ds''', gCs'', w', h', max maxW maxW', minH')
+
+renderAllSkewers' ::
+ Diagram B ->
+ Map ID (Point V2 Double) ->
+ ([(Double, Double)], [(Double, Double, Double)], Double) ->
+ [(Point V2 Double, Double, Double, ID)] ->
+ Double ->
+ Double ->
+ Double ->
+ [[Block]] ->
+ (Diagram B, Map ID (Point V2 Double), ([(Double, Double)], [(Double, Double, Double)], Double), [(Point V2 Double, Double, Double, ID)], Double, Double, Double, [[Block]])
+renderAllSkewers' rD ds bCs gCs w h maxH [] = (rD, ds, bCs, gCs, w, h, maxH, [])
+renderAllSkewers' accuRD accuDs accuBCs@(uBCs, lBCs, minD) accuGCs accuW accuH accuMaxH [b] =
+ let (rD, ds, gCs, w, h, maxW, maxH) = renderSingleSkewer b (p2 (accuW, accuH)) accuDs accuGCs accuW
+ in renderAllSkewers' (accuRD <> rD) ds (uBCs, lBCs, min minD maxH) gCs maxW accuH (min minD maxH) []
+renderAllSkewers' accuRD accuDs (uBCs, lBCs, minD) accuGCs accuW accuH accuMaxH (b : bs) =
+ let (rD, ds, gCs, w, h, maxW, maxH) = renderSingleSkewer b (p2 (accuW, accuH)) accuDs accuGCs accuW
+ in renderAllSkewers' (accuRD <> rD) ds ((accuW, maxW) : uBCs, (accuW, maxW, h) : lBCs, min minD maxH) gCs maxW accuH (min minD maxH) bs
+
+renderAllSkewers :: [[Block]] -> (Diagram B, Map ID (Point V2 Double), ([(Double, Double)], [(Double, Double, Double)], Double), [(Point V2 Double, Double, Double, ID)], Double, Double, Double, [[Block]])
+renderAllSkewers blocks@(b : bs) =
+ let manyBlocks = length blocks > 2
+ (rD, ds, (uBCs, lBCs, minD), gCs, w, h, maxH, _) = renderAllSkewers' mempty Data.Map.empty ([], [], 0.0) [] 0.0 0.0 0.0 [b]
+ uBCs' = if null bs then uBCs else (0.0, w) : uBCs
+ lBCs' = if null bs then lBCs else (0.0, w, maxH) : lBCs
+ (rD', ds', (uBCs'', lBCs'', minD'), gCs', w', h', maxH', _) = renderAllSkewers' rD ds (uBCs', lBCs', minD) gCs w (negate defaultBoundingBoxHeight) maxH bs
+ in (rD', ds', (uBCs'', lBCs'', minD'), gCs', w', h', if manyBlocks then maxH' else maxH, b : bs)
+
+render' :: [[Block]] -> Diagram B
+render' [] = mempty
+render' bs =
+ let (rD', ds', (uBCs, lBCs, minD), gCs', w', h', maxH', _) = renderAllSkewers bs
+ bCs = case length bs of
+ 1 -> mempty
+ _ ->
+ let rUBCs = renderUpperBetaConnections uBCs (negate defaultBoundingBoxHeight)
+ rSBC = renderSideBetaConnection (p2 (0.0, maxH' + defaultBoundingBoxHeight * 0.5)) (p2 (0.0, 0.0 + defaultBoundingBoxHeight * 0.5 - defaultBoundingBoxHeight))
+ rLBCs = renderLowerBetaConnections lBCs (maxH' + defaultBoundingBoxHeight * 0.5)
+ in rUBCs <> rSBC <> rLBCs
+ in foldl
+ ( \accu (gCO, maxX, maxY, i) ->
+ case Data.Map.lookup i ds' of
+ Nothing -> error $ "gamma connection destination " <> show i <> "not found in the collection of destinations: " <> show ds'
+ Just gCD -> accu <> renderGammaConnection gCO gCD maxX maxY
+ )
+ (rD' <> bCs)
+ gCs'
+
+render :: [[Block]] -> Diagram B
+render [] = mempty
+render [b] = render' $ Blocks.reverse [(EndTerminator : b) <> [StartTerminator]]
+render bs =
+ let bs' = tail bs
+ in render' . Blocks.reverse $ ((EndTerminator : head bs) : init bs') <> [last bs' <> [StartTerminator]]
diff --git a/src/lib/Constants.hs b/src/lib/Constants.hs
new file mode 100644
--- /dev/null
+++ b/src/lib/Constants.hs
@@ -0,0 +1,57 @@
+module Constants where
+
+import Data.Colour.SRGB (sRGB)
+import Data.Text (empty)
+import Diagrams.Backend.SVG
+ ( B,
+ Options (SVGOptions),
+ SVG,
+ _generateDoctype,
+ _idPrefix,
+ _size,
+ _svgAttributes,
+ _svgDefinitions,
+ )
+import Diagrams.Prelude (Colour, Diagram, V2 (..), fc, lc, lw, mkSizeSpec, veryThin, (#))
+
+defaultBoundingBoxWidth :: Double
+defaultBoundingBoxWidth = 3.0
+
+defaultBoundingBoxHeight :: Double
+defaultBoundingBoxHeight = 1.0
+
+widthRatio :: Double
+widthRatio = 0.8
+
+heightRatio :: Double
+heightRatio = 0.5
+
+-- colours used:
+-- https://www.colourlovers.com/palette/541086/Loyal_Friends
+lineColour :: Colour Double
+lineColour = sRGB (160.0 / 255.0) (194.0 / 255.0) (222.0 / 255.0)
+
+fillColour :: Colour Double
+fillColour = sRGB (237.0 / 255.0) (237.0 / 255.0) (244.0 / 255.0)
+
+fontColour :: Colour Double
+fontColour = sRGB (6.0 / 255.0) (71.0 / 255.0) (128.0 / 255.0)
+
+troubleshootingMode :: Bool
+troubleshootingMode = False
+
+defaultFontSize :: Double
+defaultFontSize = defaultBoundingBoxHeight / 8.0
+
+wyvernStyle :: Diagram B -> Diagram B
+wyvernStyle = lw veryThin # lc lineColour # fc fillColour
+
+svgOptions :: (Num n) => Options SVG V2 n
+svgOptions =
+ SVGOptions
+ { _size = mkSizeSpec $ V2 (Just 1920) (Just 1080),
+ _idPrefix = empty,
+ _svgDefinitions = Nothing,
+ _svgAttributes = [],
+ _generateDoctype = True
+ }
diff --git a/src/lib/HelperDiagrams.hs b/src/lib/HelperDiagrams.hs
new file mode 100644
--- /dev/null
+++ b/src/lib/HelperDiagrams.hs
@@ -0,0 +1,176 @@
+module HelperDiagrams where
+
+import Constants (defaultBoundingBoxHeight, defaultBoundingBoxWidth, defaultFontSize, fillColour, fontColour, heightRatio, lineColour, widthRatio, wyvernStyle)
+import Diagrams.Backend.SVG (B)
+import Diagrams.Prelude
+ ( Diagram,
+ Point (..),
+ V2 (..),
+ closeLine,
+ fc,
+ font,
+ fontSize,
+ fromOffsets,
+ fromVertices,
+ lc,
+ light,
+ local,
+ lw,
+ p2,
+ position,
+ r2,
+ rect,
+ regPoly,
+ rotateBy,
+ roundedRect,
+ scaleY,
+ strokeLoop,
+ text,
+ translate,
+ triangle,
+ veryThin,
+ (#),
+ )
+
+rect' :: Double -> Double -> Diagram B
+rect' x y =
+ fromOffsets [V2 x 0.0, V2 0.0 (y * (-1.0)), V2 (x * (-1.0)) 0.0, V2 0.0 y] # closeLine # strokeLoop # wyvernStyle
+
+headlineShape :: Double -> Double -> Diagram B
+headlineShape x y =
+ fromOffsets [V2 x 0.0, V2 0.0 (y * (-1.0)), V2 (x * (-0.5)) (-0.1), V2 (x * (-0.5)) 0.1, V2 0.0 y]
+ # closeLine
+ # strokeLoop
+ # wyvernStyle
+
+addressShape :: Double -> Double -> Diagram B
+addressShape x y =
+ fromOffsets [V2 (x * 0.5) 0.1, V2 (x * 0.5) (-0.1), V2 0.0 (y * (-1.0)), V2 (x * (-1.0)) 0.0]
+ # closeLine
+ # strokeLoop
+ # wyvernStyle
+
+renderText :: String -> Diagram B
+renderText x =
+ text x
+ # fontSize (local defaultFontSize)
+ # light
+ # font "helvetica"
+ # fc fontColour
+
+wyvernRoundedRect :: String -> Diagram B
+wyvernRoundedRect x =
+ renderText x
+ <> roundedRect (defaultBoundingBoxWidth * widthRatio) (defaultBoundingBoxHeight * heightRatio) 0.5 # lw veryThin # lc lineColour # fc fillColour
+
+wyvernRect :: String -> Diagram B
+wyvernRect x =
+ renderText x
+ <> rect (defaultBoundingBoxWidth * widthRatio) (defaultBoundingBoxHeight * heightRatio) # lw veryThin # lc lineColour # fc fillColour
+
+wyvernHeadline :: String -> Diagram B
+wyvernHeadline x =
+ renderText x
+ <> fromOffsets
+ [ V2 0.0 (defaultBoundingBoxHeight * heightRatio),
+ V2 (defaultBoundingBoxWidth * widthRatio) 0.0,
+ V2 0.0 (defaultBoundingBoxHeight * heightRatio * (-1.0)),
+ V2 (defaultBoundingBoxWidth * widthRatio * (-0.5)) (-0.1),
+ V2 (defaultBoundingBoxWidth * widthRatio * (-0.5)) 0.1
+ ]
+ # closeLine
+ # strokeLoop
+ # wyvernStyle
+ # translate (r2 (defaultBoundingBoxWidth * widthRatio * (-0.5), defaultBoundingBoxHeight * heightRatio * (-0.5)))
+
+wyvernAddress :: String -> Diagram B
+wyvernAddress x =
+ renderText x
+ <> fromOffsets
+ [ V2 0.0 (defaultBoundingBoxHeight * heightRatio),
+ V2 (defaultBoundingBoxWidth * widthRatio * 0.5) 0.1,
+ V2 (defaultBoundingBoxWidth * widthRatio * 0.5) (-0.1),
+ V2 0.0 (defaultBoundingBoxHeight * heightRatio * (-1.0)),
+ V2 (defaultBoundingBoxWidth * widthRatio * (-1.0)) 0.0
+ ]
+ # closeLine
+ # strokeLoop
+ # wyvernStyle
+ # translate (r2 (defaultBoundingBoxWidth * widthRatio * (-0.5), defaultBoundingBoxHeight * heightRatio * (-0.5)))
+
+wyvernQuestion :: String -> Diagram B
+wyvernQuestion x =
+ renderText x
+ <> fromOffsets
+ [ V2 (-0.1) (defaultBoundingBoxHeight * heightRatio * 0.5),
+ V2 0.1 (defaultBoundingBoxHeight * heightRatio * 0.5),
+ V2 (defaultBoundingBoxWidth * widthRatio - 0.2) 0.0,
+ V2 0.1 (defaultBoundingBoxHeight * heightRatio * (-0.5)),
+ V2 (-0.1) (defaultBoundingBoxHeight * heightRatio * (-0.5)),
+ V2 (defaultBoundingBoxWidth * widthRatio * (-1.0) + 0.2) 0.0
+ ]
+ # closeLine
+ # strokeLoop
+ # wyvernStyle
+ # translate (r2 (defaultBoundingBoxWidth * widthRatio * (-0.5) + 0.1, defaultBoundingBoxHeight * heightRatio * (-0.5)))
+ <> renderText "yes" # translate (r2 (-0.2, defaultBoundingBoxHeight * (-0.4)))
+ <> renderText "no" # translate (r2 (defaultBoundingBoxWidth * 0.45, 0.1))
+
+wyvernHex :: String -> Diagram B
+wyvernHex x =
+ renderText x
+ <> regPoly 6 ((defaultBoundingBoxWidth * widthRatio) / 2)
+ # scaleY ((defaultBoundingBoxHeight * heightRatio) / (defaultBoundingBoxWidth * widthRatio))
+ # wyvernStyle
+ <> renderText "yes" # translate (r2 (-0.2, defaultBoundingBoxHeight * (-0.35)))
+ <> renderText "no" # translate (r2 (defaultBoundingBoxWidth * 0.45, 0.1))
+
+renderConnection :: [Point V2 Double] -> Diagram B
+renderConnection coordinates = fromVertices coordinates # wyvernStyle
+
+renderGammaConnection :: Point V2 Double -> Point V2 Double -> Double -> Double -> Diagram B
+renderGammaConnection gO@(P (V2 gOX gOY)) gD@(P (V2 gDX gDY)) maxX minY =
+ let gD'@(P (V2 gDX' gDY')) = p2 (gDX + (0.1 * sqrt 3.0 / 2.0) + 0.012, gDY + defaultBoundingBoxHeight * 0.5)
+ gammaMidpoint1 = p2 (gOX, minY)
+ gammaMidpoint2 = p2 (maxX - defaultBoundingBoxWidth * 0.5, minY)
+ gammaMidpoint3 = p2 (maxX - defaultBoundingBoxWidth * 0.5, gDY')
+ coordinates = [gO, gammaMidpoint1, gammaMidpoint2, gammaMidpoint3, gD']
+ in renderConnection coordinates <> position [(p2 (gDX' - 0.025, gDY'), rotateBy (1 / 4) $ triangle 0.1 # wyvernStyle)]
+
+renderUpperBetaConnections :: [(Double, Double)] -> Double -> Diagram B
+renderUpperBetaConnections [] maxD = mempty
+renderUpperBetaConnections [uBC@(uBCa, uBCb)] maxD =
+ renderConnection
+ [ p2 (uBCa, maxD + defaultBoundingBoxHeight * 0.5),
+ p2 (uBCb, maxD + defaultBoundingBoxHeight * 0.5),
+ p2 (uBCb, maxD + defaultBoundingBoxHeight * heightRatio * 0.5)
+ ]
+renderUpperBetaConnections (uBC@(uBCa, uBCb) : uBCs) maxD =
+ renderConnection
+ [ p2 (uBCa, maxD + defaultBoundingBoxHeight * 0.5),
+ p2 (uBCb, maxD + defaultBoundingBoxHeight * 0.5),
+ p2 (uBCb, maxD + defaultBoundingBoxHeight * heightRatio * 0.5)
+ ]
+ <> renderUpperBetaConnections uBCs maxD
+
+renderSideBetaConnection :: Point V2 Double -> Point V2 Double -> Diagram B
+renderSideBetaConnection a@(P (V2 aX aY)) b@(P (V2 bX bY)) =
+ renderConnection
+ [ a,
+ p2 (aX - defaultBoundingBoxWidth * 0.5, aY),
+ p2 (aX - defaultBoundingBoxWidth * 0.5, bY),
+ p2 (bX - (0.1 * sqrt 3.0 / 2.0), bY)
+ ]
+ <> position [(p2 (bX - 0.06, bY), rotateBy (3 / 4) $ triangle 0.1 # wyvernStyle)]
+
+renderLowerBetaConnections' :: [(Double, Double, Double)] -> Double -> Diagram B
+renderLowerBetaConnections' [] _ = mempty
+renderLowerBetaConnections' (lBC@(lBCa, lBCb, lBCc) : lBCs) minD =
+ renderConnection [p2 (lBCa, lBCc + defaultBoundingBoxHeight), p2 (lBCa, minD), p2 (lBCb, minD)]
+ <> renderLowerBetaConnections' lBCs minD
+
+renderLowerBetaConnections :: [(Double, Double, Double)] -> Double -> Diagram B
+renderLowerBetaConnections [] _ = mempty
+renderLowerBetaConnections (lBC@(lBCa, lBCb, lBCc) : lBCs) minD =
+ renderConnection [p2 (lBCa, lBCc + defaultBoundingBoxHeight), p2 (lBCa, minD)]
+ <> renderLowerBetaConnections' lBCs minD
diff --git a/src/lib/ID.hs b/src/lib/ID.hs
new file mode 100644
--- /dev/null
+++ b/src/lib/ID.hs
@@ -0,0 +1,17 @@
+module ID where
+
+newtype ID
+ = ID String
+ deriving (Show)
+
+instance Eq ID where
+ (==) (ID a) (ID b) = a == b
+
+instance Ord ID where
+ compare (ID a) (ID b) = compare a b
+ (<) (ID a) (ID b) = a < b
+ (>=) (ID a) (ID b) = a >= b
+ (>) (ID a) (ID b) = a > b
+ (<=) (ID a) (ID b) = a <= b
+ min (ID a) (ID b) = ID $ min a b
+ max (ID a) (ID b) = ID $ max a b
diff --git a/src/lib/InputArguments.hs b/src/lib/InputArguments.hs
new file mode 100644
--- /dev/null
+++ b/src/lib/InputArguments.hs
@@ -0,0 +1,35 @@
+module InputArguments where
+
+import Options.Applicative (Parser, help, long, metavar, short, strOption)
+
+data InputArguments = InputArguments
+ { inputPath :: String,
+ outputPath :: String
+ }
+
+instance Show InputArguments where
+ show x =
+ let userProvidedInputPath = inputPath x
+ userProvidedOutputPath = outputPath x
+ in "input path: \""
+ <> userProvidedInputPath
+ <> "\"\n"
+ <> "output path: \""
+ <> userProvidedOutputPath
+ <> "\""
+
+parseInput :: Parser InputArguments
+parseInput =
+ InputArguments
+ <$> strOption
+ ( long "inputPath"
+ <> short 'i'
+ <> metavar "PATH"
+ <> help "Path to input *.txt drakon diagram file."
+ )
+ <*> strOption
+ ( long "outputPath"
+ <> short 'o'
+ <> metavar "PATH"
+ <> help "Path to output *.svg drakon diagram file."
+ )
diff --git a/src/lib/Lexer.hs b/src/lib/Lexer.hs
new file mode 100644
--- /dev/null
+++ b/src/lib/Lexer.hs
@@ -0,0 +1,897 @@
+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
+{-# OPTIONS_GHC -fno-warn-unused-binds #-}
+{-# OPTIONS_GHC -fno-warn-unused-imports #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE MagicHash #-}
+{-# LINE 1 "./src/lib/Lexer.x" #-}
+module Lexer
+ (alexScanTokens,
+ Token(TokenAction,
+ TokenSoloIdentifier,
+ TokenOCB,
+ TokenCCB)) where
+#include "ghcconfig.h"
+import qualified Data.Array
+import qualified Data.Char
+import Data.Array.Base (unsafeAt)
+import GHC.Exts (Addr#,Int#,Int(I#),(*#),(+#),(-#),(==#),(>=#),indexCharOffAddr#,indexInt16OffAddr#,indexInt32OffAddr#,int2Word#,narrow16Int#,narrow32Int#,negateInt#,or#,ord#,uncheckedShiftL#,word2Int#)
+import qualified GHC.Exts
+#define ALEX_BASIC 1
+-- -----------------------------------------------------------------------------
+-- Alex wrapper code.
+--
+-- This code is in the PUBLIC DOMAIN; you may copy it freely and use
+-- it for any purpose whatsoever.
+
+#if defined(ALEX_MONAD) || defined(ALEX_MONAD_BYTESTRING) || defined(ALEX_MONAD_STRICT_TEXT)
+import Control.Applicative as App (Applicative (..))
+#endif
+
+#if defined(ALEX_STRICT_TEXT) || defined (ALEX_POSN_STRICT_TEXT) || defined(ALEX_MONAD_STRICT_TEXT)
+import qualified Data.Text
+#endif
+
+import Data.Word (Word8)
+
+#if defined(ALEX_BASIC_BYTESTRING) || defined(ALEX_POSN_BYTESTRING) || defined(ALEX_MONAD_BYTESTRING)
+
+import Data.Int (Int64)
+import qualified Data.ByteString.Lazy as ByteString
+import qualified Data.ByteString.Internal as ByteString (w2c)
+
+#elif defined(ALEX_STRICT_BYTESTRING)
+
+import qualified Data.ByteString as ByteString
+import qualified Data.ByteString.Internal as ByteString hiding (ByteString)
+import qualified Data.ByteString.Unsafe as ByteString
+
+#else
+
+import qualified Data.Bits
+
+-- | Encode a Haskell String to a list of Word8 values, in UTF8 format.
+utf8Encode :: Char -> [Word8]
+utf8Encode = uncurry (:) . utf8Encode'
+
+utf8Encode' :: Char -> (Word8, [Word8])
+utf8Encode' c = case go (Data.Char.ord c) of
+ (x, xs) -> (fromIntegral x, map fromIntegral xs)
+ where
+ go oc
+ | oc <= 0x7f = ( oc
+ , [
+ ])
+
+ | oc <= 0x7ff = ( 0xc0 + (oc `Data.Bits.shiftR` 6)
+ , [0x80 + oc Data.Bits..&. 0x3f
+ ])
+
+ | oc <= 0xffff = ( 0xe0 + (oc `Data.Bits.shiftR` 12)
+ , [0x80 + ((oc `Data.Bits.shiftR` 6) Data.Bits..&. 0x3f)
+ , 0x80 + oc Data.Bits..&. 0x3f
+ ])
+ | otherwise = ( 0xf0 + (oc `Data.Bits.shiftR` 18)
+ , [0x80 + ((oc `Data.Bits.shiftR` 12) Data.Bits..&. 0x3f)
+ , 0x80 + ((oc `Data.Bits.shiftR` 6) Data.Bits..&. 0x3f)
+ , 0x80 + oc Data.Bits..&. 0x3f
+ ])
+
+#endif
+
+type Byte = Word8
+
+-- -----------------------------------------------------------------------------
+-- The input type
+
+#if defined(ALEX_POSN) || defined(ALEX_MONAD) || defined(ALEX_GSCAN)
+type AlexInput = (AlexPosn, -- current position,
+ Char, -- previous char
+ [Byte], -- pending bytes on current char
+ String) -- current input string
+
+ignorePendingBytes :: AlexInput -> AlexInput
+ignorePendingBytes (p,c,_ps,s) = (p,c,[],s)
+
+alexInputPrevChar :: AlexInput -> Char
+alexInputPrevChar (_p,c,_bs,_s) = c
+
+alexGetByte :: AlexInput -> Maybe (Byte,AlexInput)
+alexGetByte (p,c,(b:bs),s) = Just (b,(p,c,bs,s))
+alexGetByte (_,_,[],[]) = Nothing
+alexGetByte (p,_,[],(c:s)) = let p' = alexMove p c
+ in case utf8Encode' c of
+ (b, bs) -> p' `seq` Just (b, (p', c, bs, s))
+#endif
+
+#if defined (ALEX_STRICT_TEXT)
+type AlexInput = (Char, -- previous char
+ [Byte], -- pending bytes on current char
+ Data.Text.Text) -- current input string
+
+ignorePendingBytes :: AlexInput -> AlexInput
+ignorePendingBytes (c,_ps,s) = (c,[],s)
+
+alexInputPrevChar :: AlexInput -> Char
+alexInputPrevChar (c,_bs,_s) = c
+
+alexGetByte :: AlexInput -> Maybe (Byte,AlexInput)
+alexGetByte (c,(b:bs),s) = Just (b,(c,bs,s))
+alexGetByte (_,[],s) = case Data.Text.uncons s of
+ Just (c, cs) ->
+ case utf8Encode' c of
+ (b, bs) -> Just (b, (c, bs, cs))
+ Nothing ->
+ Nothing
+#endif
+
+#if defined (ALEX_POSN_STRICT_TEXT) || defined(ALEX_MONAD_STRICT_TEXT)
+type AlexInput = (AlexPosn, -- current position,
+ Char, -- previous char
+ [Byte], -- pending bytes on current char
+ Data.Text.Text) -- current input string
+
+ignorePendingBytes :: AlexInput -> AlexInput
+ignorePendingBytes (p,c,_ps,s) = (p,c,[],s)
+
+alexInputPrevChar :: AlexInput -> Char
+alexInputPrevChar (_p,c,_bs,_s) = c
+
+alexGetByte :: AlexInput -> Maybe (Byte,AlexInput)
+alexGetByte (p,c,(b:bs),s) = Just (b,(p,c,bs,s))
+alexGetByte (p,_,[],s) = case Data.Text.uncons s of
+ Just (c, cs) ->
+ let p' = alexMove p c
+ in case utf8Encode' c of
+ (b, bs) -> p' `seq` Just (b, (p', c, bs, cs))
+ Nothing ->
+ Nothing
+#endif
+
+#if defined(ALEX_POSN_BYTESTRING) || defined(ALEX_MONAD_BYTESTRING)
+type AlexInput = (AlexPosn, -- current position,
+ Char, -- previous char
+ ByteString.ByteString, -- current input string
+ Int64) -- bytes consumed so far
+
+ignorePendingBytes :: AlexInput -> AlexInput
+ignorePendingBytes i = i -- no pending bytes when lexing bytestrings
+
+alexInputPrevChar :: AlexInput -> Char
+alexInputPrevChar (_,c,_,_) = c
+
+alexGetByte :: AlexInput -> Maybe (Byte,AlexInput)
+alexGetByte (p,_,cs,n) =
+ case ByteString.uncons cs of
+ Nothing -> Nothing
+ Just (b, cs') ->
+ let c = ByteString.w2c b
+ p' = alexMove p c
+ n' = n+1
+ in p' `seq` cs' `seq` n' `seq` Just (b, (p', c, cs',n'))
+#endif
+
+#ifdef ALEX_BASIC_BYTESTRING
+data AlexInput = AlexInput { alexChar :: {-# UNPACK #-} !Char, -- previous char
+ alexStr :: !ByteString.ByteString, -- current input string
+ alexBytePos :: {-# UNPACK #-} !Int64} -- bytes consumed so far
+
+alexInputPrevChar :: AlexInput -> Char
+alexInputPrevChar = alexChar
+
+alexGetByte (AlexInput {alexStr=cs,alexBytePos=n}) =
+ case ByteString.uncons cs of
+ Nothing -> Nothing
+ Just (c, rest) ->
+ Just (c, AlexInput {
+ alexChar = ByteString.w2c c,
+ alexStr = rest,
+ alexBytePos = n+1})
+#endif
+
+#ifdef ALEX_STRICT_BYTESTRING
+data AlexInput = AlexInput { alexChar :: {-# UNPACK #-} !Char,
+ alexStr :: {-# UNPACK #-} !ByteString.ByteString,
+ alexBytePos :: {-# UNPACK #-} !Int}
+
+alexInputPrevChar :: AlexInput -> Char
+alexInputPrevChar = alexChar
+
+alexGetByte (AlexInput {alexStr=cs,alexBytePos=n}) =
+ case ByteString.uncons cs of
+ Nothing -> Nothing
+ Just (c, rest) ->
+ Just (c, AlexInput {
+ alexChar = ByteString.w2c c,
+ alexStr = rest,
+ alexBytePos = n+1})
+#endif
+
+-- -----------------------------------------------------------------------------
+-- Token positions
+
+-- `Posn' records the location of a token in the input text. It has three
+-- fields: the address (number of characters preceding the token), line number
+-- and column of a token within the file. `start_pos' gives the position of the
+-- start of the file and `eof_pos' a standard encoding for the end of file.
+-- `move_pos' calculates the new position after traversing a given character,
+-- assuming the usual eight character tab stops.
+
+#if defined(ALEX_POSN) || defined(ALEX_MONAD) || defined(ALEX_POSN_BYTESTRING) || defined(ALEX_MONAD_BYTESTRING) || defined(ALEX_GSCAN) || defined (ALEX_POSN_STRICT_TEXT) || defined(ALEX_MONAD_STRICT_TEXT)
+data AlexPosn = AlexPn !Int !Int !Int
+ deriving (Eq, Show, Ord)
+
+alexStartPos :: AlexPosn
+alexStartPos = AlexPn 0 1 1
+
+alexMove :: AlexPosn -> Char -> AlexPosn
+alexMove (AlexPn a l c) '\t' = AlexPn (a+1) l (c+alex_tab_size-((c-1) `mod` alex_tab_size))
+alexMove (AlexPn a l _) '\n' = AlexPn (a+1) (l+1) 1
+alexMove (AlexPn a l c) _ = AlexPn (a+1) l (c+1)
+#endif
+
+-- -----------------------------------------------------------------------------
+-- Monad (default and with ByteString input)
+
+#if defined(ALEX_MONAD) || defined(ALEX_MONAD_BYTESTRING) || defined(ALEX_MONAD_STRICT_TEXT)
+data AlexState = AlexState {
+ alex_pos :: !AlexPosn, -- position at current input location
+#ifdef ALEX_MONAD_STRICT_TEXT
+ alex_inp :: Data.Text.Text,
+ alex_chr :: !Char,
+ alex_bytes :: [Byte],
+#endif /* ALEX_MONAD_STRICT_TEXT */
+#ifdef ALEX_MONAD
+ alex_inp :: String, -- the current input
+ alex_chr :: !Char, -- the character before the input
+ alex_bytes :: [Byte],
+#endif /* ALEX_MONAD */
+#ifdef ALEX_MONAD_BYTESTRING
+ alex_bpos:: !Int64, -- bytes consumed so far
+ alex_inp :: ByteString.ByteString, -- the current input
+ alex_chr :: !Char, -- the character before the input
+#endif /* ALEX_MONAD_BYTESTRING */
+ alex_scd :: !Int -- the current startcode
+#ifdef ALEX_MONAD_USER_STATE
+ , alex_ust :: AlexUserState -- AlexUserState will be defined in the user program
+#endif
+ }
+
+-- Compile with -funbox-strict-fields for best results!
+
+#ifdef ALEX_MONAD
+runAlex :: String -> Alex a -> Either String a
+runAlex input__ (Alex f)
+ = case f (AlexState {alex_bytes = [],
+ alex_pos = alexStartPos,
+ alex_inp = input__,
+ alex_chr = '\n',
+#ifdef ALEX_MONAD_USER_STATE
+ alex_ust = alexInitUserState,
+#endif
+ alex_scd = 0}) of Left msg -> Left msg
+ Right ( _, a ) -> Right a
+#endif
+
+#ifdef ALEX_MONAD_BYTESTRING
+runAlex :: ByteString.ByteString -> Alex a -> Either String a
+runAlex input__ (Alex f)
+ = case f (AlexState {alex_bpos = 0,
+ alex_pos = alexStartPos,
+ alex_inp = input__,
+ alex_chr = '\n',
+#ifdef ALEX_MONAD_USER_STATE
+ alex_ust = alexInitUserState,
+#endif
+ alex_scd = 0}) of Left msg -> Left msg
+ Right ( _, a ) -> Right a
+#endif
+
+#ifdef ALEX_MONAD_STRICT_TEXT
+runAlex :: Data.Text.Text -> Alex a -> Either String a
+runAlex input__ (Alex f)
+ = case f (AlexState {alex_bytes = [],
+ alex_pos = alexStartPos,
+ alex_inp = input__,
+ alex_chr = '\n',
+#ifdef ALEX_MONAD_USER_STATE
+ alex_ust = alexInitUserState,
+#endif
+ alex_scd = 0}) of Left msg -> Left msg
+ Right ( _, a ) -> Right a
+#endif
+
+newtype Alex a = Alex { unAlex :: AlexState -> Either String (AlexState, a) }
+
+instance Functor Alex where
+ fmap f a = Alex $ \s -> case unAlex a s of
+ Left msg -> Left msg
+ Right (s', a') -> Right (s', f a')
+
+instance Applicative Alex where
+ pure a = Alex $ \s -> Right (s, a)
+ fa <*> a = Alex $ \s -> case unAlex fa s of
+ Left msg -> Left msg
+ Right (s', f) -> case unAlex a s' of
+ Left msg -> Left msg
+ Right (s'', b) -> Right (s'', f b)
+
+instance Monad Alex where
+ m >>= k = Alex $ \s -> case unAlex m s of
+ Left msg -> Left msg
+ Right (s',a) -> unAlex (k a) s'
+ return = App.pure
+
+
+#ifdef ALEX_MONAD
+alexGetInput :: Alex AlexInput
+alexGetInput
+ = Alex $ \s@AlexState{alex_pos=pos,alex_chr=c,alex_bytes=bs,alex_inp=inp__} ->
+ Right (s, (pos,c,bs,inp__))
+#endif
+
+#ifdef ALEX_MONAD_BYTESTRING
+alexGetInput :: Alex AlexInput
+alexGetInput
+ = Alex $ \s@AlexState{alex_pos=pos,alex_bpos=bpos,alex_chr=c,alex_inp=inp__} ->
+ Right (s, (pos,c,inp__,bpos))
+#endif
+
+#ifdef ALEX_MONAD_STRICT_TEXT
+alexGetInput :: Alex AlexInput
+alexGetInput
+ = Alex $ \s@AlexState{alex_pos=pos,alex_chr=c,alex_bytes=bs,alex_inp=inp__} ->
+ Right (s, (pos,c,bs,inp__))
+#endif
+
+#ifdef ALEX_MONAD
+alexSetInput :: AlexInput -> Alex ()
+alexSetInput (pos,c,bs,inp__)
+ = Alex $ \s -> case s{alex_pos=pos,alex_chr=c,alex_bytes=bs,alex_inp=inp__} of
+ state__@(AlexState{}) -> Right (state__, ())
+#endif
+
+#ifdef ALEX_MONAD_BYTESTRING
+alexSetInput :: AlexInput -> Alex ()
+alexSetInput (pos,c,inp__,bpos)
+ = Alex $ \s -> case s{alex_pos=pos,
+ alex_bpos=bpos,
+ alex_chr=c,
+ alex_inp=inp__} of
+ state__@(AlexState{}) -> Right (state__, ())
+#endif
+
+#ifdef ALEX_MONAD_STRICT_TEXT
+alexSetInput :: AlexInput -> Alex ()
+alexSetInput (pos,c,bs,inp__)
+ = Alex $ \s -> case s{alex_pos=pos,alex_chr=c,alex_bytes=bs,alex_inp=inp__} of
+ state__@(AlexState{}) -> Right (state__, ())
+#endif
+
+alexError :: String -> Alex a
+alexError message = Alex $ const $ Left message
+
+alexGetStartCode :: Alex Int
+alexGetStartCode = Alex $ \s@AlexState{alex_scd=sc} -> Right (s, sc)
+
+alexSetStartCode :: Int -> Alex ()
+alexSetStartCode sc = Alex $ \s -> Right (s{alex_scd=sc}, ())
+
+#if defined(ALEX_MONAD_USER_STATE)
+alexGetUserState :: Alex AlexUserState
+alexGetUserState = Alex $ \s@AlexState{alex_ust=ust} -> Right (s,ust)
+
+alexSetUserState :: AlexUserState -> Alex ()
+alexSetUserState ss = Alex $ \s -> Right (s{alex_ust=ss}, ())
+#endif /* defined(ALEX_MONAD_USER_STATE) */
+
+#ifdef ALEX_MONAD
+alexMonadScan = do
+ inp__ <- alexGetInput
+ sc <- alexGetStartCode
+ case alexScan inp__ sc of
+ AlexEOF -> alexEOF
+ AlexError ((AlexPn _ line column),_,_,_) -> alexError $ "lexical error at line " ++ (show line) ++ ", column " ++ (show column)
+ AlexSkip inp__' _len -> do
+ alexSetInput inp__'
+ alexMonadScan
+ AlexToken inp__' len action -> do
+ alexSetInput inp__'
+ action (ignorePendingBytes inp__) len
+#endif
+
+#ifdef ALEX_MONAD_BYTESTRING
+alexMonadScan = do
+ inp__@(_,_,_,n) <- alexGetInput
+ sc <- alexGetStartCode
+ case alexScan inp__ sc of
+ AlexEOF -> alexEOF
+ AlexError ((AlexPn _ line column),_,_,_) -> alexError $ "lexical error at line " ++ (show line) ++ ", column " ++ (show column)
+ AlexSkip inp__' _len -> do
+ alexSetInput inp__'
+ alexMonadScan
+ AlexToken inp__'@(_,_,_,n') _ action -> let len = n'-n in do
+ alexSetInput inp__'
+ action (ignorePendingBytes inp__) len
+#endif
+
+#ifdef ALEX_MONAD_STRICT_TEXT
+alexMonadScan = do
+ inp__ <- alexGetInput
+ sc <- alexGetStartCode
+ case alexScan inp__ sc of
+ AlexEOF -> alexEOF
+ AlexError ((AlexPn _ line column),_,_,_) -> alexError $ "lexical error at line " ++ (show line) ++ ", column " ++ (show column)
+ AlexSkip inp__' _len -> do
+ alexSetInput inp__'
+ alexMonadScan
+ AlexToken inp__' len action -> do
+ alexSetInput inp__'
+ action (ignorePendingBytes inp__) len
+#endif
+
+-- -----------------------------------------------------------------------------
+-- Useful token actions
+
+#ifdef ALEX_MONAD
+type AlexAction result = AlexInput -> Int -> Alex result
+#endif
+
+#ifdef ALEX_MONAD_BYTESTRING
+type AlexAction result = AlexInput -> Int64 -> Alex result
+#endif
+
+#ifdef ALEX_MONAD_STRICT_TEXT
+type AlexAction result = AlexInput -> Int -> Alex result
+#endif
+
+-- just ignore this token and scan another one
+-- skip :: AlexAction result
+skip _input _len = alexMonadScan
+
+-- ignore this token, but set the start code to a new value
+-- begin :: Int -> AlexAction result
+begin code _input _len = do alexSetStartCode code; alexMonadScan
+
+-- perform an action for this token, and set the start code to a new value
+andBegin :: AlexAction result -> Int -> AlexAction result
+(action `andBegin` code) input__ len = do
+ alexSetStartCode code
+ action input__ len
+
+#ifdef ALEX_MONAD
+token :: (AlexInput -> Int -> token) -> AlexAction token
+token t input__ len = return (t input__ len)
+#endif
+
+#ifdef ALEX_MONAD_BYTESTRING
+token :: (AlexInput -> Int64 -> token) -> AlexAction token
+token t input__ len = return (t input__ len)
+#endif
+
+#ifdef ALEX_MONAD_STRICT_TEXT
+token :: (AlexInput -> Int -> token) -> AlexAction token
+token t input__ len = return (t input__ len)
+#endif
+
+#endif /* defined(ALEX_MONAD) || defined(ALEX_MONAD_BYTESTRING) || defined(ALEX_MONAD_STRICT_TEXT) */
+
+-- -----------------------------------------------------------------------------
+-- Basic wrapper
+
+#ifdef ALEX_BASIC
+type AlexInput = (Char,[Byte],String)
+
+alexInputPrevChar :: AlexInput -> Char
+alexInputPrevChar (c,_,_) = c
+
+-- alexScanTokens :: String -> [token]
+alexScanTokens str = go ('\n',[],str)
+ where go inp__@(_,_bs,s) =
+ case alexScan inp__ 0 of
+ AlexEOF -> []
+ AlexError _ -> error "lexical error"
+ AlexSkip inp__' _ln -> go inp__'
+ AlexToken inp__' len act -> act (take len s) : go inp__'
+
+alexGetByte :: AlexInput -> Maybe (Byte,AlexInput)
+alexGetByte (c,(b:bs),s) = Just (b,(c,bs,s))
+alexGetByte (_,[],[]) = Nothing
+alexGetByte (_,[],(c:s)) = case utf8Encode' c of
+ (b, bs) -> Just (b, (c, bs, s))
+#endif
+
+
+-- -----------------------------------------------------------------------------
+-- Basic wrapper, ByteString version
+
+#ifdef ALEX_BASIC_BYTESTRING
+
+-- alexScanTokens :: ByteString.ByteString -> [token]
+alexScanTokens str = go (AlexInput '\n' str 0)
+ where go inp__ =
+ case alexScan inp__ 0 of
+ AlexEOF -> []
+ AlexError _ -> error "lexical error"
+ AlexSkip inp__' _len -> go inp__'
+ AlexToken inp__' _ act ->
+ let len = alexBytePos inp__' - alexBytePos inp__ in
+ act (ByteString.take len (alexStr inp__)) : go inp__'
+
+#endif
+
+#ifdef ALEX_STRICT_BYTESTRING
+
+-- alexScanTokens :: ByteString.ByteString -> [token]
+alexScanTokens str = go (AlexInput '\n' str 0)
+ where go inp__ =
+ case alexScan inp__ 0 of
+ AlexEOF -> []
+ AlexError _ -> error "lexical error"
+ AlexSkip inp__' _len -> go inp__'
+ AlexToken inp__' _ act ->
+ let len = alexBytePos inp__' - alexBytePos inp__ in
+ act (ByteString.take len (alexStr inp__)) : go inp__'
+
+#endif
+
+#ifdef ALEX_STRICT_TEXT
+-- alexScanTokens :: Data.Text.Text -> [token]
+alexScanTokens str = go ('\n',[],str)
+ where go inp__@(_,_bs,s) =
+ case alexScan inp__ 0 of
+ AlexEOF -> []
+ AlexError _ -> error "lexical error"
+ AlexSkip inp__' _len -> go inp__'
+ AlexToken inp__' len act -> act (Data.Text.take len s) : go inp__'
+#endif
+
+#ifdef ALEX_POSN_STRICT_TEXT
+-- alexScanTokens :: Data.Text.Text -> [token]
+alexScanTokens str = go (alexStartPos,'\n',[],str)
+ where go inp__@(pos,_,_bs,s) =
+ case alexScan inp__ 0 of
+ AlexEOF -> []
+ AlexError ((AlexPn _ line column),_,_,_) -> error $ "lexical error at line " ++ (show line) ++ ", column " ++ (show column)
+ AlexSkip inp__' _len -> go inp__'
+ AlexToken inp__' len act -> act pos (Data.Text.take len s) : go inp__'
+#endif
+
+
+-- -----------------------------------------------------------------------------
+-- Posn wrapper
+
+-- Adds text positions to the basic model.
+
+#ifdef ALEX_POSN
+--alexScanTokens :: String -> [token]
+alexScanTokens str0 = go (alexStartPos,'\n',[],str0)
+ where go inp__@(pos,_,_,str) =
+ case alexScan inp__ 0 of
+ AlexEOF -> []
+ AlexError ((AlexPn _ line column),_,_,_) -> error $ "lexical error at line " ++ (show line) ++ ", column " ++ (show column)
+ AlexSkip inp__' _ln -> go inp__'
+ AlexToken inp__' len act -> act pos (take len str) : go inp__'
+#endif
+
+
+-- -----------------------------------------------------------------------------
+-- Posn wrapper, ByteString version
+
+#ifdef ALEX_POSN_BYTESTRING
+--alexScanTokens :: ByteString.ByteString -> [token]
+alexScanTokens str0 = go (alexStartPos,'\n',str0,0)
+ where go inp__@(pos,_,str,n) =
+ case alexScan inp__ 0 of
+ AlexEOF -> []
+ AlexError ((AlexPn _ line column),_,_,_) -> error $ "lexical error at line " ++ (show line) ++ ", column " ++ (show column)
+ AlexSkip inp__' _len -> go inp__'
+ AlexToken inp__'@(_,_,_,n') _ act ->
+ act pos (ByteString.take (n'-n) str) : go inp__'
+#endif
+
+
+-- -----------------------------------------------------------------------------
+-- GScan wrapper
+
+-- For compatibility with previous versions of Alex, and because we can.
+
+#ifdef ALEX_GSCAN
+alexGScan stop__ state__ inp__ =
+ alex_gscan stop__ alexStartPos '\n' [] inp__ (0,state__)
+
+alex_gscan stop__ p c bs inp__ (sc,state__) =
+ case alexScan (p,c,bs,inp__) sc of
+ AlexEOF -> stop__ p c inp__ (sc,state__)
+ AlexError _ -> stop__ p c inp__ (sc,state__)
+ AlexSkip (p',c',bs',inp__') _len ->
+ alex_gscan stop__ p' c' bs' inp__' (sc,state__)
+ AlexToken (p',c',bs',inp__') len k ->
+ k p c inp__ len (\scs -> alex_gscan stop__ p' c' bs' inp__' scs) (sc,state__)
+#endif
+alex_tab_size :: Int
+alex_tab_size = 8
+alex_base :: AlexAddr
+alex_base = AlexA#
+ "\xf8\xff\xff\xff\x00\x00\x00\x00\x6d\x00\x00\x00\xdf\x00\x00\x00\x00\x00\x00\x00\xfd\xff\xff\xff\x02\x00\x00\x00\x51\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc3\x01\x00\x00\x35\x02\x00\x00"#
+
+alex_table :: AlexAddr
+alex_table = AlexA#
+ "\x00\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x05\x00\x00\x00\x07\x00\x00\x00\x00\x00\x05\x00\x00\x00\x0a\x00\x00\x00\x00\x00\x06\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x09\x00\x00\x00\x08\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x03\x00\x03\x00\x00\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x00\x00\x00\x00\x03\x00\x03\x00\x03\x00\x03\x00\x00\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x00\x00\x03\x00\x00\x00\x00\x00\x00\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x03\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x03\x00\x03\x00\x00\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x00\x00\x00\x00\x03\x00\x03\x00\x03\x00\x03\x00\x00\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x00\x00\x03\x00\x00\x00\x00\x00\x00\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0b\x00\x0b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0b\x00\x0b\x00\x0b\x00\x00\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x00\x00\x00\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x00\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x00\x00\x0b\x00\x00\x00\x00\x00\x00\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0b\x00\x0b\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0b\x00\x0b\x00\x0b\x00\x00\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x00\x00\x00\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x00\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x00\x00\x0b\x00\x00\x00\x00\x00\x00\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"#
+
+alex_check :: AlexAddr
+alex_check = AlexA#
+ "\xff\xff\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\xff\xff\x22\x00\xff\xff\xff\xff\x20\x00\xff\xff\x27\x00\xff\xff\xff\xff\x20\x00\xff\xff\x22\x00\xff\xff\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\xff\xff\x7d\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\x21\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x27\x00\x28\x00\x29\x00\xff\xff\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\xff\xff\x5d\x00\xff\xff\xff\xff\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\x21\x00\x22\x00\xff\xff\xff\xff\xff\xff\xff\xff\x27\x00\x28\x00\x29\x00\xff\xff\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\xff\xff\x5d\x00\xff\xff\xff\xff\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\x21\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x27\x00\x28\x00\x29\x00\xff\xff\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\xff\xff\x5d\x00\xff\xff\xff\xff\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\x21\x00\x22\x00\xff\xff\xff\xff\xff\xff\xff\xff\x27\x00\x28\x00\x29\x00\xff\xff\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\xff\xff\x5d\x00\xff\xff\xff\xff\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"#
+
+alex_deflt :: AlexAddr
+alex_deflt = AlexA#
+ "\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"#
+
+alex_accept = Data.Array.listArray (0 :: Int, 11)
+ [ AlexAccNone
+ , AlexAcc 4
+ , AlexAccNone
+ , AlexAccNone
+ , AlexAcc 3
+ , AlexAccSkip
+ , AlexAccNone
+ , AlexAccNone
+ , AlexAcc 2
+ , AlexAcc 1
+ , AlexAcc 0
+ , AlexAccNone
+ ]
+
+alex_actions = Data.Array.array (0 :: Int, 5)
+ [ (4,alex_action_2)
+ , (3,alex_action_1)
+ , (2,alex_action_5)
+ , (1,alex_action_4)
+ , (0,alex_action_3)
+ ]
+
+alex_action_1 = \s -> TokenAction s
+alex_action_2 = \s -> TokenAction ("# " <> s) -- # is a placeholder id that will later be replaced by a unique identifier
+alex_action_3 = \s -> TokenSoloIdentifier s
+alex_action_4 = \_ -> TokenOCB
+alex_action_5 = \_ -> TokenCCB
+
+#define ALEX_GHC 1
+#define ALEX_NOPRED 1
+-- -----------------------------------------------------------------------------
+-- ALEX TEMPLATE
+--
+-- This code is in the PUBLIC DOMAIN; you may copy it freely and use
+-- it for any purpose whatsoever.
+
+-- -----------------------------------------------------------------------------
+-- INTERNALS and main scanner engine
+
+#ifdef ALEX_GHC
+# define ILIT(n) n#
+# define IBOX(n) (I# (n))
+# define FAST_INT Int#
+-- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex.
+# if __GLASGOW_HASKELL__ > 706
+# define CMP_GEQ(n,m) (((n) >=# (m)) :: Int#)
+# define CMP_EQ(n,m) (((n) ==# (m)) :: Int#)
+# define CMP_MKBOOL(x) ((GHC.Exts.tagToEnum# (x)) :: Bool)
+# else
+# define CMP_GEQ(n,m) (((n) >= (m)) :: Bool)
+# define CMP_EQ(n,m) (((n) == (m)) :: Bool)
+# define CMP_MKBOOL(x) ((x) :: Bool)
+# endif
+# define GTE(n,m) CMP_MKBOOL(CMP_GEQ(n,m))
+# define EQ(n,m) CMP_MKBOOL(CMP_EQ(n,m))
+# define PLUS(n,m) (n +# m)
+# define MINUS(n,m) (n -# m)
+# define TIMES(n,m) (n *# m)
+# define NEGATE(n) (negateInt# (n))
+# define IF_GHC(x) (x)
+#else
+# define ILIT(n) (n)
+# define IBOX(n) (n)
+# define FAST_INT Int
+# define GTE(n,m) (n >= m)
+# define EQ(n,m) (n == m)
+# define PLUS(n,m) (n + m)
+# define MINUS(n,m) (n - m)
+# define TIMES(n,m) (n * m)
+# define NEGATE(n) (negate (n))
+# define IF_GHC(x)
+#endif
+
+#ifdef ALEX_GHC
+data AlexAddr = AlexA# Addr#
+-- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex.
+
+{-# INLINE alexIndexInt16OffAddr #-}
+alexIndexInt16OffAddr :: AlexAddr -> Int# -> Int#
+alexIndexInt16OffAddr (AlexA# arr) off =
+#if __GLASGOW_HASKELL__ >= 901
+ GHC.Exts.int16ToInt# -- qualified import because it doesn't exist on older GHC's
+#endif
+#ifdef WORDS_BIGENDIAN
+ (GHC.Exts.word16ToInt16# (GHC.Exts.wordToWord16# (GHC.Exts.byteSwap16# (GHC.Exts.word16ToWord# (GHC.Exts.int16ToWord16#
+#endif
+ (indexInt16OffAddr# arr off)
+#ifdef WORDS_BIGENDIAN
+ )))))
+#endif
+#else
+alexIndexInt16OffAddr = (Data.Array.!)
+#endif
+
+#ifdef ALEX_GHC
+{-# INLINE alexIndexInt32OffAddr #-}
+alexIndexInt32OffAddr :: AlexAddr -> Int# -> Int#
+alexIndexInt32OffAddr (AlexA# arr) off =
+#if __GLASGOW_HASKELL__ >= 901
+ GHC.Exts.int32ToInt# -- qualified import because it doesn't exist on older GHC's
+#endif
+#ifdef WORDS_BIGENDIAN
+ (GHC.Exts.word32ToInt32# (GHC.Exts.wordToWord32# (GHC.Exts.byteSwap32# (GHC.Exts.word32ToWord# (GHC.Exts.int32ToWord32#
+#endif
+ (indexInt32OffAddr# arr off)
+#ifdef WORDS_BIGENDIAN
+ )))))
+#endif
+#else
+alexIndexInt32OffAddr = (Data.Array.!)
+#endif
+
+#ifdef ALEX_GHC
+-- GHC >= 503, unsafeAt is available from Data.Array.Base.
+quickIndex = unsafeAt
+#else
+quickIndex = (Data.Array.!)
+#endif
+
+-- -----------------------------------------------------------------------------
+-- Main lexing routines
+
+data AlexReturn a
+ = AlexEOF
+ | AlexError !AlexInput
+ | AlexSkip !AlexInput !Int
+ | AlexToken !AlexInput !Int a
+
+-- alexScan :: AlexInput -> StartCode -> AlexReturn a
+alexScan input__ IBOX(sc)
+ = alexScanUser (error "alex rule requiring context was invoked by alexScan; use alexScanUser instead?") input__ IBOX(sc)
+
+-- If the generated alexScan/alexScanUser functions are called multiple times
+-- in the same file, alexScanUser gets broken out into a separate function and
+-- increases memory usage. Make sure GHC inlines this function and optimizes it.
+{-# INLINE alexScanUser #-}
+
+alexScanUser user__ input__ IBOX(sc)
+ = case alex_scan_tkn user__ input__ ILIT(0) input__ sc AlexNone of
+ (AlexNone, input__') ->
+ case alexGetByte input__ of
+ Nothing ->
+#ifdef ALEX_DEBUG
+ Debug.Trace.trace ("End of input.") $
+#endif
+ AlexEOF
+ Just _ ->
+#ifdef ALEX_DEBUG
+ Debug.Trace.trace ("Error.") $
+#endif
+ AlexError input__'
+
+ (AlexLastSkip input__'' len, _) ->
+#ifdef ALEX_DEBUG
+ Debug.Trace.trace ("Skipping.") $
+#endif
+ AlexSkip input__'' len
+
+ (AlexLastAcc k input__''' len, _) ->
+#ifdef ALEX_DEBUG
+ Debug.Trace.trace ("Accept.") $
+#endif
+ AlexToken input__''' len ((Data.Array.!) alex_actions k)
+
+
+-- Push the input through the DFA, remembering the most recent accepting
+-- state it encountered.
+
+alex_scan_tkn user__ orig_input len input__ s last_acc =
+ input__ `seq` -- strict in the input
+ let
+ new_acc = (check_accs (alex_accept `quickIndex` IBOX(s)))
+ in
+ new_acc `seq`
+ case alexGetByte input__ of
+ Nothing -> (new_acc, input__)
+ Just (c, new_input) ->
+#ifdef ALEX_DEBUG
+ Debug.Trace.trace ("State: " ++ show IBOX(s) ++ ", char: " ++ show c ++ " " ++ (show . Data.Char.chr . fromIntegral) c) $
+#endif
+ case fromIntegral c of { IBOX(ord_c) ->
+ let
+ base = alexIndexInt32OffAddr alex_base s
+ offset = PLUS(base,ord_c)
+
+ new_s = if GTE(offset,ILIT(0))
+ && let check = alexIndexInt16OffAddr alex_check offset
+ in EQ(check,ord_c)
+ then alexIndexInt16OffAddr alex_table offset
+ else alexIndexInt16OffAddr alex_deflt s
+ in
+ case new_s of
+ ILIT(-1) -> (new_acc, input__)
+ -- on an error, we want to keep the input *before* the
+ -- character that failed, not after.
+ _ -> alex_scan_tkn user__ orig_input
+#ifdef ALEX_LATIN1
+ PLUS(len,ILIT(1))
+ -- issue 119: in the latin1 encoding, *each* byte is one character
+#else
+ (if c < 0x80 || c >= 0xC0 then PLUS(len,ILIT(1)) else len)
+ -- note that the length is increased ONLY if this is the 1st byte in a char encoding)
+#endif
+ new_input new_s new_acc
+ }
+ where
+ check_accs (AlexAccNone) = last_acc
+ check_accs (AlexAcc a ) = AlexLastAcc a input__ IBOX(len)
+ check_accs (AlexAccSkip) = AlexLastSkip input__ IBOX(len)
+#ifndef ALEX_NOPRED
+ check_accs (AlexAccPred a predx rest)
+ | predx user__ orig_input IBOX(len) input__
+ = AlexLastAcc a input__ IBOX(len)
+ | otherwise
+ = check_accs rest
+ check_accs (AlexAccSkipPred predx rest)
+ | predx user__ orig_input IBOX(len) input__
+ = AlexLastSkip input__ IBOX(len)
+ | otherwise
+ = check_accs rest
+#endif
+
+data AlexLastAcc
+ = AlexNone
+ | AlexLastAcc !Int !AlexInput !Int
+ | AlexLastSkip !AlexInput !Int
+
+data AlexAcc user
+ = AlexAccNone
+ | AlexAcc Int
+ | AlexAccSkip
+#ifndef ALEX_NOPRED
+ | AlexAccPred Int (AlexAccPred user) (AlexAcc user)
+ | AlexAccSkipPred (AlexAccPred user) (AlexAcc user)
+
+type AlexAccPred user = user -> AlexInput -> Int -> AlexInput -> Bool
+
+-- -----------------------------------------------------------------------------
+-- Predicates on a rule
+
+alexAndPred p1 p2 user__ in1 len in2
+ = p1 user__ in1 len in2 && p2 user__ in1 len in2
+
+--alexPrevCharIsPred :: Char -> AlexAccPred _
+alexPrevCharIs c _ input__ _ _ = c == alexInputPrevChar input__
+
+alexPrevCharMatches f _ input__ _ _ = f (alexInputPrevChar input__)
+
+--alexPrevCharIsOneOfPred :: Array Char Bool -> AlexAccPred _
+alexPrevCharIsOneOf arr _ input__ _ _ = arr Data.Array.! alexInputPrevChar input__
+
+--alexRightContext :: Int -> AlexAccPred _
+alexRightContext IBOX(sc) user__ _ _ input__ =
+ case alex_scan_tkn user__ input__ ILIT(0) input__ sc AlexNone of
+ (AlexNone, _) -> False
+ _ -> True
+ -- TODO: there's no need to find the longest
+ -- match when checking the right context, just
+ -- the first match will do.
+#endif
+{-# LINE 30 "./src/lib/Lexer.x" #-}
+data Token
+ = TokenAction String
+ | TokenSoloIdentifier String
+ | TokenOCB
+ | TokenCCB
+ deriving Show
diff --git a/src/lib/Lexer.x b/src/lib/Lexer.x
new file mode 100644
--- /dev/null
+++ b/src/lib/Lexer.x
@@ -0,0 +1,37 @@
+{
+module Lexer
+ (alexScanTokens,
+ Token(TokenAction,
+ TokenSoloIdentifier,
+ TokenOCB,
+ TokenCCB)) where
+}
+
+%wrapper "basic"
+
+$digit = 0-9
+$alpha = [a-zA-Z]
+
+$idChar = [$alpha $digit \']
+$contentChar = [$alpha $digit $white \' \, \! \- \. \/ \? \= \< \> \[ \] \+ \( \)]
+
+@id = $idChar+
+@content = $contentChar+
+
+tokens :-
+
+ $white+ ;
+ @id [$white]+ \"@content\" { \s -> TokenAction s }
+ \"@content\" { \s -> TokenAction ("# " <> s) -- # is a placeholder id that will later be replaced by a unique identifier }
+ @id { \s -> TokenSoloIdentifier s }
+ \{ { \_ -> TokenOCB }
+ \} { \_ -> TokenCCB }
+
+{
+data Token
+ = TokenAction String
+ | TokenSoloIdentifier String
+ | TokenOCB
+ | TokenCCB
+ deriving Show
+}
diff --git a/src/lib/Parser.hs b/src/lib/Parser.hs
new file mode 100644
--- /dev/null
+++ b/src/lib/Parser.hs
@@ -0,0 +1,807 @@
+{-# OPTIONS_GHC -w #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE TypeSynonymInstances #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE PatternGuards #-}
+{-# LANGUAGE NoStrictData #-}
+{-# LANGUAGE UnboxedTuples #-}
+{-# LANGUAGE PartialTypeSignatures #-}
+module Parser where
+import Data.Char
+import Data.String.Utils (lstrip)
+import ID
+import Lexer
+import Blocks
+import qualified Control.Monad as Happy_Prelude
+import qualified Data.Bool as Happy_Prelude
+import qualified Data.Function as Happy_Prelude
+import qualified Data.Int as Happy_Prelude
+import qualified Data.List as Happy_Prelude
+import qualified Data.Maybe as Happy_Prelude
+import qualified Data.String as Happy_Prelude
+import qualified Data.Tuple as Happy_Prelude
+import qualified GHC.Err as Happy_Prelude
+import qualified GHC.Num as Happy_Prelude
+import qualified Text.Show as Happy_Prelude
+import qualified Data.Array as Happy_Data_Array
+import qualified Data.Bits as Bits
+import qualified GHC.Exts as Happy_GHC_Exts
+import Control.Applicative(Applicative(..))
+import Control.Monad (ap)
+
+-- parser produced by Happy Version 2.1.7
+
+data HappyAbsSyn t5 t6 t7 t8
+ = HappyTerminal (Token)
+ | HappyErrorToken Happy_Prelude.Int
+ | HappyAbsSyn5 t5
+ | HappyAbsSyn6 t6
+ | HappyAbsSyn7 t7
+ | HappyAbsSyn8 t8
+
+{-# NOINLINE happyTokenStrings #-}
+happyTokenStrings = ["action","soloId","'{'","'}'","%eof"]
+
+happyActOffsets :: HappyAddr
+happyActOffsets = HappyA# "\x01\x00\x00\x00\x09\x00\x00\x00\x00\x00\x00\x00\x21\x00\x00\x00\x06\x00\x00\x00\x11\x00\x00\x00\x00\x00\x00\x00\x24\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x25\x00\x00\x00\x00\x00\x00\x00\x28\x00\x00\x00\x0f\x00\x00\x00\x28\x00\x00\x00\x13\x00\x00\x00\x22\x00\x00\x00\x27\x00\x00\x00\x19\x00\x00\x00\x00\x00\x00\x00\x27\x00\x00\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x17\x00\x00\x00\x29\x00\x00\x00\xff\xff\xff\xff\x04\x00\x00\x00\x00\x00\x00\x00"#
+
+happyGotoOffsets :: HappyAddr
+happyGotoOffsets = HappyA# "\x0d\x00\x00\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2d\x00\x00\x00\x2e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1f\x00\x00\x00\x2e\x00\x00\x00\x20\x00\x00\x00\x2e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x2e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"#
+
+happyDefActions :: HappyAddr
+happyDefActions = HappyA# "\xfb\xff\xff\xff\x00\x00\x00\x00\xfe\xff\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\xfc\xff\xff\xff\xfa\xff\xff\xff\xf6\xff\xff\xff\xfb\xff\xff\xff\xf9\xff\xff\xff\xf6\xff\xff\xff\xfd\xff\xff\xff\xfb\xff\xff\xff\x00\x00\x00\x00\xfb\xff\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\xf8\xff\xff\xff\x00\x00\x00\x00\xf8\xff\xff\xff\x00\x00\x00\x00\xfb\xff\xff\xff\xf7\xff\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\xf2\xff\xff\xff\xf3\xff\xff\xff"#
+
+happyCheck :: HappyAddr
+happyCheck = HappyA# "\xff\xff\xff\xff\x02\x00\x00\x00\x03\x00\x00\x00\x02\x00\x00\x00\x05\x00\x00\x00\x06\x00\x00\x00\x02\x00\x00\x00\x03\x00\x00\x00\x02\x00\x00\x00\x05\x00\x00\x00\x06\x00\x00\x00\x02\x00\x00\x00\x06\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x02\x00\x00\x00\x03\x00\x00\x00\x02\x00\x00\x00\x03\x00\x00\x00\x02\x00\x00\x00\x05\x00\x00\x00\x02\x00\x00\x00\x03\x00\x00\x00\x02\x00\x00\x00\x05\x00\x00\x00\x02\x00\x00\x00\x03\x00\x00\x00\x02\x00\x00\x00\x05\x00\x00\x00\x01\x00\x00\x00\x05\x00\x00\x00\x03\x00\x00\x00\x01\x00\x00\x00\x01\x00\x00\x00\x03\x00\x00\x00\x03\x00\x00\x00\x01\x00\x00\x00\x04\x00\x00\x00\x03\x00\x00\x00\x05\x00\x00\x00\x04\x00\x00\x00\x04\x00\x00\x00\x02\x00\x00\x00\x04\x00\x00\x00\x02\x00\x00\x00\x02\x00\x00\x00\x05\x00\x00\x00\x02\x00\x00\x00\xff\xff\xff\xff\x03\x00\x00\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"#
+
+happyTable :: HappyAddr
+happyTable = HappyA# "\x00\x00\x00\x00\xf2\xff\xff\xff\xf2\xff\xff\xff\x08\x00\x00\x00\xf2\xff\xff\xff\xf2\xff\xff\xff\xf3\xff\xff\xff\xf3\xff\xff\xff\x04\x00\x00\x00\xf3\xff\xff\xff\xf3\xff\xff\xff\x04\x00\x00\x00\xff\xff\xff\xff\x04\x00\x00\x00\x05\x00\x00\x00\x02\x00\x00\x00\x06\x00\x00\x00\x0b\x00\x00\x00\x11\x00\x00\x00\x0b\x00\x00\x00\x14\x00\x00\x00\x0b\x00\x00\x00\x11\x00\x00\x00\x0b\x00\x00\x00\x12\x00\x00\x00\x0b\x00\x00\x00\x19\x00\x00\x00\x0b\x00\x00\x00\x1a\x00\x00\x00\x0f\x00\x00\x00\x15\x00\x00\x00\x06\x00\x00\x00\x0d\x00\x00\x00\x12\x00\x00\x00\x06\x00\x00\x00\x06\x00\x00\x00\x17\x00\x00\x00\x0d\x00\x00\x00\x06\x00\x00\x00\x17\x00\x00\x00\x09\x00\x00\x00\x0f\x00\x00\x00\x0b\x00\x00\x00\x16\x00\x00\x00\x0b\x00\x00\x00\x02\x00\x00\x00\x1b\x00\x00\x00\x0b\x00\x00\x00\x00\x00\x00\x00\x09\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"#
+
+happyReduceArr = Happy_Data_Array.array (1, 13) [
+ (1 , happyReduce_1),
+ (2 , happyReduce_2),
+ (3 , happyReduce_3),
+ (4 , happyReduce_4),
+ (5 , happyReduce_5),
+ (6 , happyReduce_6),
+ (7 , happyReduce_7),
+ (8 , happyReduce_8),
+ (9 , happyReduce_9),
+ (10 , happyReduce_10),
+ (11 , happyReduce_11),
+ (12 , happyReduce_12),
+ (13 , happyReduce_13)
+ ]
+
+happyRuleArr :: HappyAddr
+happyRuleArr = HappyA# "\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x01\x00\x00\x00\x01\x00\x00\x00\x02\x00\x00\x00\x02\x00\x00\x00\x04\x00\x00\x00\x02\x00\x00\x00\x05\x00\x00\x00\x03\x00\x00\x00\x01\x00\x00\x00\x03\x00\x00\x00\x07\x00\x00\x00\x03\x00\x00\x00\x08\x00\x00\x00\x03\x00\x00\x00\x08\x00\x00\x00\x03\x00\x00\x00\x07\x00\x00\x00"#
+
+happyCatchStates :: [Happy_Prelude.Int]
+happyCatchStates = []
+
+happy_n_terms = 7 :: Happy_Prelude.Int
+happy_n_nonterms = 4 :: Happy_Prelude.Int
+
+happy_n_starts = 1 :: Happy_Prelude.Int
+
+happyReduce_1 = happySpecReduce_1 0# happyReduction_1
+happyReduction_1 (HappyAbsSyn7 happy_var_1)
+ = HappyAbsSyn5
+ ([happy_var_1]
+ )
+happyReduction_1 _ = notHappyAtAll
+
+happyReduce_2 = happySpecReduce_2 0# happyReduction_2
+happyReduction_2 (HappyAbsSyn7 happy_var_2)
+ (HappyAbsSyn5 happy_var_1)
+ = HappyAbsSyn5
+ (happy_var_2 : happy_var_1
+ )
+happyReduction_2 _ _ = notHappyAtAll
+
+happyReduce_3 = happySpecReduce_1 0# happyReduction_3
+happyReduction_3 (HappyAbsSyn6 happy_var_1)
+ = HappyAbsSyn5
+ ([happy_var_1]
+ )
+happyReduction_3 _ = notHappyAtAll
+
+happyReduce_4 = happySpecReduce_0 1# happyReduction_4
+happyReduction_4 = HappyAbsSyn6
+ ([]
+ )
+
+happyReduce_5 = happySpecReduce_1 1# happyReduction_5
+happyReduction_5 (HappyAbsSyn8 happy_var_1)
+ = HappyAbsSyn6
+ ([happy_var_1]
+ )
+happyReduction_5 _ = notHappyAtAll
+
+happyReduce_6 = happySpecReduce_2 1# happyReduction_6
+happyReduction_6 (HappyAbsSyn8 happy_var_2)
+ (HappyAbsSyn6 happy_var_1)
+ = HappyAbsSyn6
+ (happy_var_2 : happy_var_1
+ )
+happyReduction_6 _ _ = notHappyAtAll
+
+happyReduce_7 = happyReduce 4# 2# happyReduction_7
+happyReduction_7 (_ `HappyStk`
+ (HappyAbsSyn6 happy_var_3) `HappyStk`
+ _ `HappyStk`
+ (HappyTerminal (TokenAction happy_var_1)) `HappyStk`
+ happyRest)
+ = HappyAbsSyn7
+ (happy_var_3 <> [toHeadline happy_var_1]
+ ) `HappyStk` happyRest
+
+happyReduce_8 = happyReduce 5# 2# happyReduction_8
+happyReduction_8 (_ `HappyStk`
+ (HappyTerminal (TokenSoloIdentifier happy_var_4)) `HappyStk`
+ (HappyAbsSyn6 happy_var_3) `HappyStk`
+ _ `HappyStk`
+ (HappyTerminal (TokenAction happy_var_1)) `HappyStk`
+ happyRest)
+ = HappyAbsSyn7
+ (toAddress happy_var_4 : happy_var_3 <> [toHeadline happy_var_1]
+ ) `HappyStk` happyRest
+
+happyReduce_9 = happySpecReduce_1 3# happyReduction_9
+happyReduction_9 (HappyTerminal (TokenAction happy_var_1))
+ = HappyAbsSyn8
+ (toAction happy_var_1
+ )
+happyReduction_9 _ = notHappyAtAll
+
+happyReduce_10 = happyReduce 7# 3# happyReduction_10
+happyReduction_10 (_ `HappyStk`
+ (HappyAbsSyn6 happy_var_6) `HappyStk`
+ _ `HappyStk`
+ _ `HappyStk`
+ (HappyAbsSyn6 happy_var_3) `HappyStk`
+ _ `HappyStk`
+ (HappyTerminal (TokenAction happy_var_1)) `HappyStk`
+ happyRest)
+ = HappyAbsSyn8
+ (toFork happy_var_1 happy_var_3 happy_var_6 Nothing
+ ) `HappyStk` happyRest
+
+happyReduce_11 = happyReduce 8# 3# happyReduction_11
+happyReduction_11 (_ `HappyStk`
+ (HappyTerminal (TokenSoloIdentifier happy_var_7)) `HappyStk`
+ (HappyAbsSyn6 happy_var_6) `HappyStk`
+ _ `HappyStk`
+ _ `HappyStk`
+ (HappyAbsSyn6 happy_var_3) `HappyStk`
+ _ `HappyStk`
+ (HappyTerminal (TokenAction happy_var_1)) `HappyStk`
+ happyRest)
+ = HappyAbsSyn8
+ (toFork happy_var_1 happy_var_3 happy_var_6 (Just (ID happy_var_7))
+ ) `HappyStk` happyRest
+
+happyReduce_12 = happyReduce 8# 3# happyReduction_12
+happyReduction_12 (_ `HappyStk`
+ (HappyTerminal (TokenSoloIdentifier happy_var_7)) `HappyStk`
+ (HappyAbsSyn6 happy_var_6) `HappyStk`
+ _ `HappyStk`
+ _ `HappyStk`
+ (HappyAbsSyn6 happy_var_3) `HappyStk`
+ _ `HappyStk`
+ (HappyTerminal (TokenAction happy_var_1)) `HappyStk`
+ happyRest)
+ = HappyAbsSyn8
+ (toFork happy_var_1 happy_var_3 happy_var_6 (Just (ID happy_var_7))
+ ) `HappyStk` happyRest
+
+happyReduce_13 = happyReduce 7# 3# happyReduction_13
+happyReduction_13 (_ `HappyStk`
+ (HappyAbsSyn6 happy_var_6) `HappyStk`
+ _ `HappyStk`
+ _ `HappyStk`
+ (HappyAbsSyn6 happy_var_3) `HappyStk`
+ _ `HappyStk`
+ (HappyTerminal (TokenAction happy_var_1)) `HappyStk`
+ happyRest)
+ = HappyAbsSyn8
+ (toFork happy_var_1 happy_var_3 happy_var_6 Nothing
+ ) `HappyStk` happyRest
+
+happyTerminalToTok term = case term of {
+ TokenAction happy_dollar_dollar -> 2#;
+ TokenSoloIdentifier happy_dollar_dollar -> 3#;
+ TokenOCB -> 4#;
+ TokenCCB -> 5#;
+ _ -> -1#;
+ }
+{-# NOINLINE happyTerminalToTok #-}
+
+happyLex kend _kmore [] = kend notHappyAtAll []
+happyLex _kend kmore (tk:tks) = kmore (happyTerminalToTok tk) tk tks
+{-# INLINE happyLex #-}
+
+happyNewToken action sts stk = happyLex (\tk -> happyDoAction 6# notHappyAtAll action sts stk) (\i tk -> happyDoAction i tk action sts stk)
+
+happyReport 6# tk explist resume tks = happyReport' tks explist resume
+happyReport _ tk explist resume tks = happyReport' (tk:tks) explist (\tks -> resume (Happy_Prelude.tail tks))
+
+
+happyThen :: () => (P a) -> (a -> (P b)) -> (P b)
+happyThen = (thenP)
+happyReturn :: () => a -> (P a)
+happyReturn = (returnP)
+happyThen1 m k tks = (thenP) m (\a -> k a tks)
+happyFmap1 f m tks = happyThen (m tks) (\a -> happyReturn (f a))
+happyReturn1 :: () => a -> b -> (P a)
+happyReturn1 = \a tks -> (returnP) a
+happyReport' :: () => [(Token)] -> [Happy_Prelude.String] -> ([(Token)] -> (P a)) -> (P a)
+happyReport' = (\tokens expected resume -> happyError tokens)
+
+happyAbort :: () => [(Token)] -> (P a)
+happyAbort = Happy_Prelude.error "Called abort handler in non-resumptive parser"
+
+diagram tks = happySomeParser where
+ happySomeParser = happyThen (happyDoParse 0# tks) (\x -> case x of {HappyAbsSyn5 z -> happyReturn z; _other -> notHappyAtAll })
+
+happySeq = happyDontSeq
+
+
+toId :: String -> Maybe ID
+toId t =
+ case head $ words t of
+ "#" -> Nothing
+ x -> Just (ID x)
+
+toContent :: String -> String
+toContent t =
+ let id = head $ words t
+ idFreeContent = lstrip (drop (length id) t)
+ idFreeContent' = drop 1 idFreeContent
+ in take (length idFreeContent' - 1) idFreeContent'
+
+toAction :: String -> Block
+toAction t = Action (toId t) (toContent t)
+
+toFork :: String -> [Block] -> [Block] -> Maybe ID -> Block
+toFork t l r rId = Fork (toId t) (toContent t) l r rId
+
+toHeadline :: String -> Block
+toHeadline t = Headline (toId t) (toContent t)
+
+toAddress :: String -> Block
+toAddress t = Address (toId t) (head $ words t)
+
+happyError = \tks i -> error ("Parse error in line " ++ show (i::Int) ++ ".\n")
+
+data ParseResult a
+ = ParseOk a
+ | ParseFail String
+
+type P a = Int -> ParseResult a
+
+thenP :: P a -> (a -> P b) -> P b
+m `thenP` k = \l ->
+ case m l of
+ ParseFail s -> ParseFail s
+ ParseOk a -> k a l
+
+returnP :: a -> P a
+returnP a = \l -> ParseOk a
+-- $Id: GenericTemplate.hs,v 1.26 2005/01/14 14:47:22 simonmar Exp $
+
+#if !defined(__GLASGOW_HASKELL__)
+# error This code isn't being built with GHC.
+#endif
+
+-- Get WORDS_BIGENDIAN (if defined)
+#include "MachDeps.h"
+
+-- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex.
+#define LT(n,m) ((Happy_GHC_Exts.tagToEnum# (n Happy_GHC_Exts.<# m)) :: Happy_Prelude.Bool)
+#define GTE(n,m) ((Happy_GHC_Exts.tagToEnum# (n Happy_GHC_Exts.>=# m)) :: Happy_Prelude.Bool)
+#define EQ(n,m) ((Happy_GHC_Exts.tagToEnum# (n Happy_GHC_Exts.==# m)) :: Happy_Prelude.Bool)
+#define PLUS(n,m) (n Happy_GHC_Exts.+# m)
+#define MINUS(n,m) (n Happy_GHC_Exts.-# m)
+#define TIMES(n,m) (n Happy_GHC_Exts.*# m)
+#define NEGATE(n) (Happy_GHC_Exts.negateInt# (n))
+
+type Happy_Int = Happy_GHC_Exts.Int#
+data Happy_IntList = HappyCons Happy_Int Happy_IntList
+
+#define INVALID_TOK -1#
+#define ERROR_TOK 0#
+#define CATCH_TOK 1#
+
+#if defined(HAPPY_COERCE)
+# define GET_ERROR_TOKEN(x) (case Happy_GHC_Exts.unsafeCoerce# x of { (Happy_GHC_Exts.I# i) -> i })
+# define MK_ERROR_TOKEN(i) (Happy_GHC_Exts.unsafeCoerce# (Happy_GHC_Exts.I# i))
+# define MK_TOKEN(x) (happyInTok (x))
+#else
+# define GET_ERROR_TOKEN(x) (case x of { HappyErrorToken (Happy_GHC_Exts.I# i) -> i })
+# define MK_ERROR_TOKEN(i) (HappyErrorToken (Happy_GHC_Exts.I# i))
+# define MK_TOKEN(x) (HappyTerminal (x))
+#endif
+
+#if defined(HAPPY_DEBUG)
+# define DEBUG_TRACE(s) (happyTrace (s)) Happy_Prelude.$
+happyTrace string expr = Happy_System_IO_Unsafe.unsafePerformIO Happy_Prelude.$ do
+ Happy_System_IO.hPutStr Happy_System_IO.stderr string
+ Happy_Prelude.return expr
+#else
+# define DEBUG_TRACE(s) {- nothing -}
+#endif
+
+infixr 9 `HappyStk`
+data HappyStk a = HappyStk a (HappyStk a)
+
+-----------------------------------------------------------------------------
+-- starting the parse
+
+happyDoParse start_state = happyNewToken start_state notHappyAtAll notHappyAtAll
+
+-----------------------------------------------------------------------------
+-- Accepting the parse
+
+-- If the current token is ERROR_TOK, it means we've just accepted a partial
+-- parse (a %partial parser). We must ignore the saved token on the top of
+-- the stack in this case.
+happyAccept ERROR_TOK tk st sts (_ `HappyStk` ans `HappyStk` _) =
+ happyReturn1 ans
+happyAccept j tk st sts (HappyStk ans _) =
+ (happyTcHack j (happyTcHack st)) (happyReturn1 ans)
+
+-----------------------------------------------------------------------------
+-- Arrays only: do the next action
+
+happyDoAction i tk st =
+ DEBUG_TRACE("state: " Happy_Prelude.++ Happy_Prelude.show (Happy_GHC_Exts.I# st) Happy_Prelude.++
+ ",\ttoken: " Happy_Prelude.++ Happy_Prelude.show (Happy_GHC_Exts.I# i) Happy_Prelude.++
+ ",\taction: ")
+ case happyDecodeAction (happyNextAction i st) of
+ HappyFail -> DEBUG_TRACE("failing.\n")
+ happyFail i tk st
+ HappyAccept -> DEBUG_TRACE("accept.\n")
+ happyAccept i tk st
+ HappyReduce rule -> DEBUG_TRACE("reduce (rule " Happy_Prelude.++ Happy_Prelude.show (Happy_GHC_Exts.I# rule) Happy_Prelude.++ ")")
+ (happyReduceArr Happy_Data_Array.! (Happy_GHC_Exts.I# rule)) i tk st
+ HappyShift new_state -> DEBUG_TRACE("shift, enter state " Happy_Prelude.++ Happy_Prelude.show (Happy_GHC_Exts.I# new_state) Happy_Prelude.++ "\n")
+ happyShift new_state i tk st
+
+{-# INLINE happyNextAction #-}
+happyNextAction i st = case happyIndexActionTable i st of
+ Happy_Prelude.Just (Happy_GHC_Exts.I# act) -> act
+ Happy_Prelude.Nothing -> happyIndexOffAddr happyDefActions st
+
+{-# INLINE happyIndexActionTable #-}
+happyIndexActionTable i st
+ | GTE(i, 0#), GTE(off, 0#), EQ(happyIndexOffAddr happyCheck off, i)
+ -- i >= 0: Guard against INVALID_TOK (do the default action, which ultimately errors)
+ -- off >= 0: Otherwise it's a default action
+ -- equality check: Ensure that the entry in the compressed array is owned by st
+ = Happy_Prelude.Just (Happy_GHC_Exts.I# (happyIndexOffAddr happyTable off))
+ | Happy_Prelude.otherwise
+ = Happy_Prelude.Nothing
+ where
+ off = PLUS(happyIndexOffAddr happyActOffsets st, i)
+
+data HappyAction
+ = HappyFail
+ | HappyAccept
+ | HappyReduce Happy_Int -- rule number
+ | HappyShift Happy_Int -- new state
+ deriving Happy_Prelude.Show
+
+{-# INLINE happyDecodeAction #-}
+happyDecodeAction :: Happy_Int -> HappyAction
+happyDecodeAction 0# = HappyFail
+happyDecodeAction -1# = HappyAccept
+happyDecodeAction action | LT(action, 0#) = HappyReduce NEGATE(PLUS(action, 1#))
+ | Happy_Prelude.otherwise = HappyShift MINUS(action, 1#)
+
+{-# INLINE happyIndexGotoTable #-}
+happyIndexGotoTable nt st = happyIndexOffAddr happyTable off
+ where
+ off = PLUS(happyIndexOffAddr happyGotoOffsets st, nt)
+
+{-# INLINE happyIndexOffAddr #-}
+happyIndexOffAddr :: HappyAddr -> Happy_Int -> Happy_Int
+happyIndexOffAddr (HappyA# arr) off =
+#if __GLASGOW_HASKELL__ >= 901
+ Happy_GHC_Exts.int32ToInt# -- qualified import because it doesn't exist on older GHC's
+#endif
+#ifdef WORDS_BIGENDIAN
+ -- The CI of `alex` tests this code path
+ (Happy_GHC_Exts.word32ToInt32# (Happy_GHC_Exts.wordToWord32# (Happy_GHC_Exts.byteSwap32# (Happy_GHC_Exts.word32ToWord# (Happy_GHC_Exts.int32ToWord32#
+#endif
+ (Happy_GHC_Exts.indexInt32OffAddr# arr off)
+#ifdef WORDS_BIGENDIAN
+ )))))
+#endif
+
+happyIndexRuleArr :: Happy_Int -> (# Happy_Int, Happy_Int #)
+happyIndexRuleArr r = (# nt, len #)
+ where
+ !(Happy_GHC_Exts.I# n_starts) = happy_n_starts
+ offs = TIMES(MINUS(r,n_starts),2#)
+ nt = happyIndexOffAddr happyRuleArr offs
+ len = happyIndexOffAddr happyRuleArr PLUS(offs,1#)
+
+data HappyAddr = HappyA# Happy_GHC_Exts.Addr#
+
+-----------------------------------------------------------------------------
+-- Shifting a token
+
+happyShift new_state ERROR_TOK tk st sts stk@(x `HappyStk` _) =
+ -- See "Error Fixup" below
+ let i = GET_ERROR_TOKEN(x) in
+ DEBUG_TRACE("shifting the error token")
+ happyDoAction i tk new_state (HappyCons st sts) stk
+
+happyShift new_state i tk st sts stk =
+ happyNewToken new_state (HappyCons st sts) (MK_TOKEN(tk) `HappyStk` stk)
+
+-- happyReduce is specialised for the common cases.
+
+happySpecReduce_0 nt fn j tk st sts stk
+ = happySeq fn (happyGoto nt j tk st (HappyCons st sts) (fn `HappyStk` stk))
+
+happySpecReduce_1 nt fn j tk old_st sts@(HappyCons st _) (v1 `HappyStk` stk')
+ = let r = fn v1 in
+ happyTcHack old_st (happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk')))
+
+happySpecReduce_2 nt fn j tk old_st
+ (HappyCons _ sts@(HappyCons st _))
+ (v1 `HappyStk` v2 `HappyStk` stk')
+ = let r = fn v1 v2 in
+ happyTcHack old_st (happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk')))
+
+happySpecReduce_3 nt fn j tk old_st
+ (HappyCons _ (HappyCons _ sts@(HappyCons st _)))
+ (v1 `HappyStk` v2 `HappyStk` v3 `HappyStk` stk')
+ = let r = fn v1 v2 v3 in
+ happyTcHack old_st (happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk')))
+
+happyReduce k nt fn j tk st sts stk
+ = case happyDrop MINUS(k,(1# :: Happy_Int)) sts of
+ sts1@(HappyCons st1 _) ->
+ let r = fn stk in -- it doesn't hurt to always seq here...
+ st `happyTcHack` happyDoSeq r (happyGoto nt j tk st1 sts1 r)
+
+happyMonadReduce k nt fn j tk st sts stk =
+ case happyDrop k (HappyCons st sts) of
+ sts1@(HappyCons st1 _) ->
+ let drop_stk = happyDropStk k stk in
+ j `happyTcHack` happyThen1 (fn stk tk)
+ (\r -> happyGoto nt j tk st1 sts1 (r `HappyStk` drop_stk))
+
+happyMonad2Reduce k nt fn j tk st sts stk =
+ case happyDrop k (HappyCons st sts) of
+ sts1@(HappyCons st1 _) ->
+ let drop_stk = happyDropStk k stk
+ off = happyIndexOffAddr happyGotoOffsets st1
+ off_i = PLUS(off, nt)
+ new_state = happyIndexOffAddr happyTable off_i
+ in
+ j `happyTcHack` happyThen1 (fn stk tk)
+ (\r -> happyNewToken new_state sts1 (r `HappyStk` drop_stk))
+
+happyDrop 0# l = l
+happyDrop n (HappyCons _ t) = happyDrop MINUS(n,(1# :: Happy_Int)) t
+
+happyDropStk 0# l = l
+happyDropStk n (x `HappyStk` xs) = happyDropStk MINUS(n,(1#::Happy_Int)) xs
+
+-----------------------------------------------------------------------------
+-- Moving to a new state after a reduction
+
+happyGoto nt j tk st =
+ DEBUG_TRACE(", goto state " Happy_Prelude.++ Happy_Prelude.show (Happy_GHC_Exts.I# new_state) Happy_Prelude.++ "\n")
+ happyDoAction j tk new_state
+ where new_state = happyIndexGotoTable nt st
+
+{- Note [Error recovery]
+~~~~~~~~~~~~~~~~~~~~~~~~
+When there is no applicable action for the current lookahead token `tk`,
+happy enters error recovery mode. Depending on whether the grammar file
+declares the two action form `%error { abort } { report }` for
+ Resumptive Error Handling,
+it works in one (not resumptive) or two phases (resumptive):
+
+ 1. Fixup mode:
+ Try to see if there is an action for the error token ERROR_TOK. If there
+ is, do *not* emit an error and pretend instead that an `error` token was
+ inserted.
+ When there is no ERROR_TOK action, report an error.
+
+ In non-resumptive error handling, calling the single error handler
+ (e.g. `happyError`) will throw an exception and abort the parser.
+ However, in resumptive error handling we enter *error resumption mode*.
+
+ 2. Error resumption mode:
+ After reporting the error (with `report`), happy will attempt to find
+ a good state stack to resume parsing in.
+ For each candidate stack, it discards input until one of the candidates
+ resumes (i.e. shifts the current input).
+ If no candidate resumes before the end of input, resumption failed and
+ calls the `abort` function, to much the same effect as in non-resumptive
+ error handling.
+
+ Candidate stacks are declared by the grammar author using the special
+ `catch` terminal and called "catch frames".
+ This mechanism is described in detail in Note [happyResume].
+
+The `catch` resumption mechanism (2) is what usually is associated with
+`error` in `bison` or `menhir`. Since `error` is used for the Fixup mechanism
+(1) above, we call the corresponding token `catch`.
+Furthermore, in constrast to `bison`, our implementation of `catch`
+non-deterministically considers multiple catch frames on the stack for
+resumption (See Note [Multiple catch frames]).
+
+Note [happyResume]
+~~~~~~~~~~~~~~~~~~
+`happyResume` implements the resumption mechanism from Note [Error recovery].
+It is best understood by example. Consider
+
+Exp :: { String }
+Exp : '1' { "1" }
+ | catch { "catch" }
+ | Exp '+' Exp %shift { $1 Happy_Prelude.++ " + " Happy_Prelude.++ $3 } -- %shift: associate 1 + 1 + 1 to the right
+ | '(' Exp ')' { "(" Happy_Prelude.++ $2 Happy_Prelude.++ ")" }
+
+The idea of the use of `catch` here is that upon encountering a parse error
+during expression parsing, we can gracefully degrade using the `catch` rule,
+still producing a partial syntax tree and keep on parsing to find further
+syntax errors.
+
+Let's trace the parser state for input 11+1, which will error out after shifting 1.
+After shifting, we have the following item stack (growing downwards and omitting
+transitive closure items):
+
+ State 0: %start_parseExp -> . Exp
+ State 5: Exp -> '1' .
+
+(Stack as a list of state numbers: [5,0].)
+As Note [Error recovery] describes, we will first try Fixup mode.
+That fails because no production can shift the `error` token.
+Next we try Error resumption mode. This works as follows:
+
+ 1. Pop off the item stack until we find an item that can shift the `catch`
+ token. (Implemented in `pop_items`.)
+ * State 5 cannot shift catch. Pop.
+ * State 0 can shift catch, which would transition into
+ State 4: Exp -> catch .
+ So record the *stack* `[4,0]` after doing the shift transition.
+ We call this a *catch frame*, where the top is a *catch state*,
+ corresponding to an item in which we just shifted a `catch` token.
+ There can be multiple such catch stacks, see Note [Multiple catch frames].
+
+ 2. Discard tokens from the input until the lookahead can be shifted in one
+ of the catch stacks. (Implemented in `discard_input_until_exp` and
+ `some_catch_state_shifts`.)
+ * We cannot shift the current lookahead '1' in state 4, so we discard
+ * We *can* shift the next lookahead '+' in state 4, but only after
+ reducing, which pops State 4 and goes to State 3:
+ State 3: %start_parseExp -> Exp .
+ Exp -> Exp . '+' Exp
+ Here we can shift '+'.
+ As you can see, to implement this machinery we need to simulate
+ the operation of the LALR automaton, especially reduction
+ (`happySimulateReduce`).
+
+Note [Multiple catch frames]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+For fewer spurious error messages, it can be beneficial to trace multiple catch
+items. Consider
+
+Exp : '1'
+ | catch
+ | Exp '+' Exp %shift
+ | '(' Exp ')'
+
+Let's trace the parser state for input (;+1, which will error out after shifting (.
+After shifting, we have the following item stack (growing downwards):
+
+ State 0: %start_parseExp -> . Exp
+ State 6: Exp -> '(' . Exp ')'
+
+Upon error, we want to find items in the stack which can shift a catch token.
+Note that both State 0 and State 6 can shift a catch token, transitioning into
+ State 4: Exp -> catch .
+Hence we record the catch frames `[4,6,0]` and `[4,0]` for possible resumption.
+
+Which catch frame do we pick for resumption?
+Note that resuming catch frame `[4,0]` will parse as "catch+1", whereas
+resuming the innermost frame `[4,6,0]` corresponds to parsing "(catch+1".
+The latter would keep discarding input until the closing ')' is found.
+So we will discard + and 1, leading to a spurious syntax error at the end of
+input, aborting the parse and never producing a partial syntax tree. Bad!
+
+It is far preferable to resume with catch frame `[4,0]`, where we can resume
+successfully on input +, so that is what we do.
+
+In general, we pick the catch frame for resumption that discards the least
+amount of input for a successful shift, preferring the topmost such catch frame.
+-}
+
+-- happyFail :: Happy_Int -> Token -> Happy_Int -> _
+-- This function triggers Note [Error recovery].
+-- If the current token is ERROR_TOK, phase (1) has failed and we might try
+-- phase (2).
+happyFail ERROR_TOK = happyFixupFailed
+happyFail i = happyTryFixup i
+
+-- Enter Error Fixup (see Note [Error recovery]):
+-- generate an error token, save the old token and carry on.
+-- When a `happyShift` accepts the error token, we will pop off the error token
+-- to resume parsing with the current lookahead `i`.
+happyTryFixup i tk action sts stk =
+ DEBUG_TRACE("entering `error` fixup.\n")
+ happyDoAction ERROR_TOK tk action sts (MK_ERROR_TOKEN(i) `HappyStk` stk)
+ -- NB: `happyShift` will simply pop the error token and carry on with
+ -- `tk`. Hence we don't change `tk` in the call here
+
+-- See Note [Error recovery], phase (2).
+-- Enter resumption mode after reporting the error by calling `happyResume`.
+happyFixupFailed tk st sts (x `HappyStk` stk) =
+ let i = GET_ERROR_TOKEN(x) in
+ DEBUG_TRACE("`error` fixup failed.\n")
+ let resume = happyResume i tk st sts stk
+ expected = happyExpectedTokens st sts in
+ happyReport i tk expected resume
+
+-- happyResume :: Happy_Int -> Token -> Happy_Int -> _
+-- See Note [happyResume]
+happyResume i tk st sts stk = pop_items [] st sts stk
+ where
+ !(Happy_GHC_Exts.I# n_starts) = happy_n_starts -- this is to test whether we have a start token
+ !(Happy_GHC_Exts.I# eof_i) = happy_n_terms Happy_Prelude.- 1 -- this is the token number of the EOF token
+ happy_list_to_list :: Happy_IntList -> [Happy_Prelude.Int]
+ happy_list_to_list (HappyCons st sts)
+ | LT(st, n_starts)
+ = [(Happy_GHC_Exts.I# st)]
+ | Happy_Prelude.otherwise
+ = (Happy_GHC_Exts.I# st) : happy_list_to_list sts
+
+ -- See (1) of Note [happyResume]
+ pop_items catch_frames st sts stk
+ | LT(st, n_starts)
+ = DEBUG_TRACE("reached start state " Happy_Prelude.++ Happy_Prelude.show (Happy_GHC_Exts.I# st) Happy_Prelude.++ ", ")
+ if Happy_Prelude.null catch_frames_new
+ then DEBUG_TRACE("no resumption.\n")
+ happyAbort
+ else DEBUG_TRACE("now discard input, trying to anchor in states " Happy_Prelude.++ Happy_Prelude.show (Happy_Prelude.map (happy_list_to_list . Happy_Prelude.fst) (Happy_Prelude.reverse catch_frames_new)) Happy_Prelude.++ ".\n")
+ discard_input_until_exp i tk (Happy_Prelude.reverse catch_frames_new)
+ | (HappyCons st1 sts1) <- sts, _ `HappyStk` stk1 <- stk
+ = pop_items catch_frames_new st1 sts1 stk1
+ where
+ !catch_frames_new
+ | HappyShift new_state <- happyDecodeAction (happyNextAction CATCH_TOK st)
+ , DEBUG_TRACE("can shift catch token in state " Happy_Prelude.++ Happy_Prelude.show (Happy_GHC_Exts.I# st) Happy_Prelude.++ ", into state " Happy_Prelude.++ Happy_Prelude.show (Happy_GHC_Exts.I# new_state) Happy_Prelude.++ "\n")
+ Happy_Prelude.null (Happy_Prelude.filter (\(HappyCons _ (HappyCons h _),_) -> EQ(st,h)) catch_frames)
+ = (HappyCons new_state (HappyCons st sts), MK_ERROR_TOKEN(i) `HappyStk` stk):catch_frames -- MK_ERROR_TOKEN(i) is just some dummy that should not be accessed by user code
+ | Happy_Prelude.otherwise
+ = DEBUG_TRACE("already shifted or can't shift catch in " Happy_Prelude.++ Happy_Prelude.show (Happy_GHC_Exts.I# st) Happy_Prelude.++ "\n")
+ catch_frames
+
+ -- See (2) of Note [happyResume]
+ discard_input_until_exp i tk catch_frames
+ | Happy_Prelude.Just (HappyCons st (HappyCons catch_st sts), catch_frame) <- some_catch_state_shifts i catch_frames
+ = DEBUG_TRACE("found expected token in state " Happy_Prelude.++ Happy_Prelude.show (Happy_GHC_Exts.I# st) Happy_Prelude.++ " after shifting from " Happy_Prelude.++ Happy_Prelude.show (Happy_GHC_Exts.I# catch_st) Happy_Prelude.++ ": " Happy_Prelude.++ Happy_Prelude.show (Happy_GHC_Exts.I# i) Happy_Prelude.++ "\n")
+ happyDoAction i tk st (HappyCons catch_st sts) catch_frame
+ | EQ(i,eof_i) -- is i EOF?
+ = DEBUG_TRACE("reached EOF, cannot resume. abort parse :(\n")
+ happyAbort
+ | Happy_Prelude.otherwise
+ = DEBUG_TRACE("discard token " Happy_Prelude.++ Happy_Prelude.show (Happy_GHC_Exts.I# i) Happy_Prelude.++ "\n")
+ happyLex (\eof_tk -> discard_input_until_exp eof_i eof_tk catch_frames) -- eof
+ (\i tk -> discard_input_until_exp i tk catch_frames) -- not eof
+
+ some_catch_state_shifts _ [] = DEBUG_TRACE("no catch state could shift.\n") Happy_Prelude.Nothing
+ some_catch_state_shifts i catch_frames@(((HappyCons st sts),_):_) = try_head i st sts catch_frames
+ where
+ try_head i st sts catch_frames = -- PRECONDITION: head catch_frames = (HappyCons st sts)
+ DEBUG_TRACE("trying token " Happy_Prelude.++ Happy_Prelude.show (Happy_GHC_Exts.I# i) Happy_Prelude.++ " in state " Happy_Prelude.++ Happy_Prelude.show (Happy_GHC_Exts.I# st) Happy_Prelude.++ ": ")
+ case happyDecodeAction (happyNextAction i st) of
+ HappyFail -> DEBUG_TRACE("fail.\n") some_catch_state_shifts i (Happy_Prelude.tail catch_frames)
+ HappyAccept -> DEBUG_TRACE("accept.\n") Happy_Prelude.Just (Happy_Prelude.head catch_frames)
+ HappyShift _ -> DEBUG_TRACE("shift.\n") Happy_Prelude.Just (Happy_Prelude.head catch_frames)
+ HappyReduce r -> case happySimulateReduce r st sts of
+ (HappyCons st1 sts1) -> try_head i st1 sts1 catch_frames
+
+happySimulateReduce r st sts =
+ DEBUG_TRACE("simulate reduction of rule " Happy_Prelude.++ Happy_Prelude.show (Happy_GHC_Exts.I# r) Happy_Prelude.++ ", ")
+ let (# nt, len #) = happyIndexRuleArr r in
+ DEBUG_TRACE("nt " Happy_Prelude.++ Happy_Prelude.show (Happy_GHC_Exts.I# nt) Happy_Prelude.++ ", len: " Happy_Prelude.++ Happy_Prelude.show (Happy_GHC_Exts.I# len) Happy_Prelude.++ ", new_st ")
+ let !(sts1@(HappyCons st1 _)) = happyDrop len (HappyCons st sts)
+ new_st = happyIndexGotoTable nt st1 in
+ DEBUG_TRACE(Happy_Prelude.show (Happy_GHC_Exts.I# new_st) Happy_Prelude.++ ".\n")
+ (HappyCons new_st sts1)
+
+happyTokenToString :: Happy_Prelude.Int -> Happy_Prelude.String
+happyTokenToString i = happyTokenStrings Happy_Prelude.!! (i Happy_Prelude.- 2) -- 2: errorTok, catchTok
+
+happyExpectedTokens :: Happy_Int -> Happy_IntList -> [Happy_Prelude.String]
+-- Upon a parse error, we want to suggest tokens that are expected in that
+-- situation. This function computes such tokens.
+-- It works by examining the top of the state stack.
+-- For every token number that does a shift transition, record that token number.
+-- For every token number that does a reduce transition, simulate that reduction
+-- on the state state stack and repeat.
+-- The recorded token numbers are then formatted with 'happyTokenToString' and
+-- returned.
+happyExpectedTokens st sts =
+ DEBUG_TRACE("constructing expected tokens.\n")
+ Happy_Prelude.map happyTokenToString (search_shifts st sts [])
+ where
+ search_shifts st sts shifts = Happy_Prelude.foldr (add_action st sts) shifts (distinct_actions st)
+ add_action st sts (Happy_GHC_Exts.I# i, Happy_GHC_Exts.I# act) shifts =
+ DEBUG_TRACE("found action in state " Happy_Prelude.++ Happy_Prelude.show (Happy_GHC_Exts.I# st) Happy_Prelude.++ ", input " Happy_Prelude.++ Happy_Prelude.show (Happy_GHC_Exts.I# i) Happy_Prelude.++ ", " Happy_Prelude.++ Happy_Prelude.show (happyDecodeAction act) Happy_Prelude.++ "\n")
+ case happyDecodeAction act of
+ HappyFail -> shifts
+ HappyAccept -> shifts -- This would always be %eof or error... Not helpful
+ HappyShift _ -> Happy_Prelude.insert (Happy_GHC_Exts.I# i) shifts
+ HappyReduce r -> case happySimulateReduce r st sts of
+ (HappyCons st1 sts1) -> search_shifts st1 sts1 shifts
+ distinct_actions st
+ -- The (token number, action) pairs of all actions in the given state
+ = ((-1), (Happy_GHC_Exts.I# (happyIndexOffAddr happyDefActions st)))
+ : [ (i, act) | i <- [begin_i..happy_n_terms], act <- get_act row_off i ]
+ where
+ row_off = happyIndexOffAddr happyActOffsets st
+ begin_i = 2 -- +2: errorTok,catchTok
+ get_act off (Happy_GHC_Exts.I# i) -- happyIndexActionTable with cached row offset
+ | let off_i = PLUS(off,i)
+ , GTE(off_i,0#)
+ , EQ(happyIndexOffAddr happyCheck off_i,i)
+ = [(Happy_GHC_Exts.I# (happyIndexOffAddr happyTable off_i))]
+ | Happy_Prelude.otherwise
+ = []
+
+-- Internal happy errors:
+
+notHappyAtAll :: a
+notHappyAtAll = Happy_Prelude.error "Internal Happy parser panic. This is not supposed to happen! Please open a bug report at https://github.com/haskell/happy/issues.\n"
+
+-----------------------------------------------------------------------------
+-- Hack to get the typechecker to accept our action functions
+
+happyTcHack :: Happy_Int -> a -> a
+happyTcHack x y = y
+{-# INLINE happyTcHack #-}
+
+-----------------------------------------------------------------------------
+-- Seq-ing. If the --strict flag is given, then Happy emits
+-- happySeq = happyDoSeq
+-- otherwise it emits
+-- happySeq = happyDontSeq
+
+happyDoSeq, happyDontSeq :: a -> b -> b
+happyDoSeq a b = a `Happy_GHC_Exts.seq` b
+happyDontSeq a b = b
+
+-----------------------------------------------------------------------------
+-- Don't inline any functions from the template. GHC has a nasty habit
+-- of deciding to inline happyGoto everywhere, which increases the size of
+-- the generated parser quite a bit.
+
+{-# NOINLINE happyDoAction #-}
+{-# NOINLINE happyTable #-}
+{-# NOINLINE happyCheck #-}
+{-# NOINLINE happyActOffsets #-}
+{-# NOINLINE happyGotoOffsets #-}
+{-# NOINLINE happyDefActions #-}
+
+{-# NOINLINE happyShift #-}
+{-# NOINLINE happySpecReduce_0 #-}
+{-# NOINLINE happySpecReduce_1 #-}
+{-# NOINLINE happySpecReduce_2 #-}
+{-# NOINLINE happySpecReduce_3 #-}
+{-# NOINLINE happyReduce #-}
+{-# NOINLINE happyMonadReduce #-}
+{-# NOINLINE happyGoto #-}
+{-# NOINLINE happyFail #-}
+
+-- end of Happy Template.
diff --git a/src/lib/Parser.y b/src/lib/Parser.y
new file mode 100644
--- /dev/null
+++ b/src/lib/Parser.y
@@ -0,0 +1,81 @@
+{
+module Parser where
+import Data.Char
+import Data.String.Utils (lstrip)
+import ID
+import Lexer
+import Blocks
+}
+
+%name diagram
+%tokentype { Token }
+%monad { P } { thenP } { returnP }
+
+%token
+ action { TokenAction $$ }
+ soloId { TokenSoloIdentifier $$ }
+ '{' { TokenOCB }
+ '}' { TokenCCB }
+
+%%
+
+skewers : headline { [$1] }
+ | skewers headline { $2 : $1 }
+ | skewer { [$1] }
+
+skewer : {- empty -} { [] }
+ | block { [$1] }
+ | skewer block { $2 : $1 }
+
+headline : action '{' skewer '}' { $3 <> [toHeadline $1] }
+ | action '{' skewer soloId '}' { toAddress $4 : $3 <> [toHeadline $1] }
+
+block : action { toAction $1 }
+ | action '{' skewer '}' '{' skewer '}' { toFork $1 $3 $6 Nothing }
+ | action '{' skewer '}' '{' skewer soloId '}' { toFork $1 $3 $6 (Just (ID $7)) }
+ | action '{' skewer '}' '{' skewer soloId '}' { toFork $1 $3 $6 (Just (ID $7)) }
+ | action '{' skewer '}' '{' skewer '}' { toFork $1 $3 $6 Nothing }
+
+{
+toId :: String -> Maybe ID
+toId t =
+ case head $ words t of
+ "#" -> Nothing
+ x -> Just (ID x)
+
+toContent :: String -> String
+toContent t =
+ let id = head $ words t
+ idFreeContent = lstrip (drop (length id) t)
+ idFreeContent' = drop 1 idFreeContent
+ in take (length idFreeContent' - 1) idFreeContent'
+
+toAction :: String -> Block
+toAction t = Action (toId t) (toContent t)
+
+toFork :: String -> [Block] -> [Block] -> Maybe ID -> Block
+toFork t l r rId = Fork (toId t) (toContent t) l r rId
+
+toHeadline :: String -> Block
+toHeadline t = Headline (toId t) (toContent t)
+
+toAddress :: String -> Block
+toAddress t = Address (toId t) (head $ words t)
+
+happyError = \tks i -> error ("Parse error in line " ++ show (i::Int) ++ ".\n")
+
+data ParseResult a
+ = ParseOk a
+ | ParseFail String
+
+type P a = Int -> ParseResult a
+
+thenP :: P a -> (a -> P b) -> P b
+m `thenP` k = \l ->
+ case m l of
+ ParseFail s -> ParseFail s
+ ParseOk a -> k a l
+
+returnP :: a -> P a
+returnP a = \l -> ParseOk a
+}
diff --git a/src/tests/OverlappingLoopbacks.hs b/src/tests/OverlappingLoopbacks.hs
new file mode 100644
--- /dev/null
+++ b/src/tests/OverlappingLoopbacks.hs
@@ -0,0 +1,16 @@
+module Main where
+
+import Content
+import Data.Map
+import Diagrams.Prelude
+import ID
+import Test.HUnit
+
+helloWorldTest :: Test
+helloWorldTest = TestCase (assertEqual "hello world test" 0 0)
+
+sanityCheckTests :: Test
+sanityCheckTests = TestList [helloWorldTest]
+
+main :: IO ()
+main = runTestTTAndExit sanityCheckTests
diff --git a/wyvern-diagrams.cabal b/wyvern-diagrams.cabal
new file mode 100644
--- /dev/null
+++ b/wyvern-diagrams.cabal
@@ -0,0 +1,90 @@
+cabal-version: 3.4
+name: wyvern-diagrams
+version: 0.3.0.6
+synopsis: Simple flowchart diagrams. Inspired by DRAKON.
+description: Wyvern combines syntax and rendering engine
+ for simple, DRAKON-like flowcharts.
+homepage: https://github.com/PiotrJustyna/wyvern
+license: BSD-3-Clause
+License-file: LICENSE
+author: Piotr Justyna
+maintainer: a568adff447749e8a5c47cdf7f31ed11@proton.me
+copyright: Piotr Justyna
+Bug-reports: https://github.com/PiotrJustyna/wyvern/issues
+category: Development
+build-type: Simple
+extra-source-files: diagrams/*.svg, diagrams/*.txt
+extra-doc-files: CHANGELOG.md
+
+source-repository head
+ type: git
+ location: https://github.com/PiotrJustyna/wyvern
+
+common warnings
+ ghc-options: -Wall
+
+library
+ exposed-modules: ID
+ Constants
+ Blocks
+ HelperDiagrams
+ Lexer
+ Parser
+ InputArguments
+ hs-source-dirs: src/lib
+ build-depends:
+ -- BSD-3-Clause
+ base >= 4.21.0 && < 4.22,
+ -- MIT
+ colour >= 2.3.6 && < 2.3.7,
+ -- BSD-2-Clause
+ text >= 2.1.2 && < 2.1.3,
+ -- BSD-3-Clause
+ diagrams-lib >= 1.5.1 && < 1.5.2,
+ -- BSD-3-Clause
+ diagrams-svg >= 1.5 && < 1.5.1,
+ -- BSD-3-Clause
+ containers >= 0.7 && < 0.7.1,
+ -- BSD-3-Clause
+ MissingH >= 1.6.0 && < 1.6.7,
+ -- BSD-3-Clause
+ array >= 0.5.8 && < 0.5.9,
+ -- BSD-3-Clause
+ unordered-containers >= 0.2.21 && < 0.2.22,
+ -- BSD-3-Clause
+ optparse-applicative >= 0.19.0 && < 0.19.1
+ default-language: Haskell2010
+
+executable wyvern-diagrams
+ import: warnings
+ main-is: Main.hs
+ build-depends:
+ -- BSD-3-Clause
+ base >= 4.21.0 && < 4.22,
+ -- BSD-3-Clause
+ array >= 0.5.8 && < 0.5.9,
+ -- BSD-3-Clause
+ diagrams-lib >= 1.5.1 && < 1.5.2,
+ -- BSD-3-Clause
+ diagrams-svg >= 1.5 && < 1.5.1,
+ -- BSD-3-Clause
+ optparse-applicative >= 0.19.0 && < 0.19.1,
+ wyvern-diagrams
+ hs-source-dirs: src/app
+ default-language: Haskell2010
+
+test-suite wyvern-tests
+ type: exitcode-stdio-1.0
+ hs-source-dirs: src/tests
+ main-is: OverlappingLoopbacks.hs
+ build-depends:
+ -- BSD-3-Clause
+ base >= 4.21.0 && < 4.22,
+ -- BSD-3-Clause
+ HUnit,
+ -- BSD-3-Clause
+ diagrams-lib >= 1.5.1 && < 1.5.2,
+ -- BSD-3-Clause
+ containers >= 0.7 && < 0.7.1,
+ wyvern-diagrams
+ default-language: Haskell2010