From 74ea1e1c733173340894078fcd1a401fb0df067a Mon Sep 17 00:00:00 2001
From: hanjoosten <han.joosten@ordina.nl>
Date: Thu, 22 Feb 2024 15:35:20 +0100
Subject: [PATCH 01/43] upgrade to freckle/stack-action@v5

---
 .github/workflows/ci2.yml     | 38 +++++++++++++++++------------------
 .github/workflows/release.yml | 38 +++++++++++++++++------------------
 2 files changed, 38 insertions(+), 38 deletions(-)

diff --git a/.github/workflows/ci2.yml b/.github/workflows/ci2.yml
index 396436a67..1490b764d 100644
--- a/.github/workflows/ci2.yml
+++ b/.github/workflows/ci2.yml
@@ -41,16 +41,16 @@ jobs:
     steps:
       - name: Checkout project contents 📡
         uses: actions/checkout@v3
-      - name: Use cache when available 📦
-        uses: freckle/stack-cache-action@main
+      # - name: Use cache when available 📦
+      #   uses: freckle/stack-cache-action@main
       - name: Set up Mariadb 🧰
         uses: shogo82148/actions-setup-mysql@v1
         with:
           mysql-version: "mariadb-10.6"
       - name: Build and test 🏗 🧪
-        uses: freckle/stack-action@v4 # stack-action does all these steps: dependencies, build, test.
+        uses: freckle/stack-action@v5 # stack-action does all these steps: dependencies, build, test.
         with:
-          stack-arguments: "--copy-bins --flag ampersand:buildAll"
+          stack-build-arguments: "--copy-bins --flag ampersand:buildAll"
 
   build-and-test-macOS:
     name: Build and test on macOS  🏗 🧪
@@ -58,16 +58,16 @@ jobs:
     steps:
       - name: Checkout project contents 📡
         uses: actions/checkout@v3
-      - name: Use cache when available 📦
-        uses: freckle/stack-cache-action@main
+      # - name: Use cache when available 📦
+      #   uses: freckle/stack-cache-action@main
       - name: Set up Mariadb 🧰
         uses: shogo82148/actions-setup-mysql@v1
         with:
           mysql-version: "mariadb-10.6"
       - name: Build and test  🏗 🧪
-        uses: freckle/stack-action@v4
+        uses: freckle/stack-action@v5
         with:
-          stack-arguments: "--copy-bins --flag ampersand:buildAll"
+          stack-build-arguments: "--copy-bins --flag ampersand:buildAll"
 
   build-and-test-windows:
     name: Build and test on Windows 🏗 🧪
@@ -75,15 +75,15 @@ jobs:
     steps:
       - name: Checkout project contents 📡
         uses: actions/checkout@v3
-      - name: Use cache (manually) 📦 # See https://github.com/freckle/stack-cache-action/issues/5
-        uses: actions/cache@v3.3.2
-        # TODO: Cache might be done better, see for inspiration:  https://github.com/godu/advent-of-code-2020/blob/46796832f59d185457a8edf8de043a54a451d688/.github/workflows/ci.yml
-        with:
-          path: |
-            ~/.ghc
-            ~/.stack
-            ~/.stack-work
-          key: ${{ runner.os }}-stack
+      # - name: Use cache (manually) 📦 # See https://github.com/freckle/stack-cache-action/issues/5
+      #   uses: actions/cache@v3.3.2
+      #   # TODO: Cache might be done better, see for inspiration:  https://github.com/godu/advent-of-code-2020/blob/46796832f59d185457a8edf8de043a54a451d688/.github/workflows/ci.yml
+      #   with:
+      #     path: |
+      #       ~/.ghc
+      #       ~/.stack
+      #       ~/.stack-work
+      #     key: ${{ runner.os }}-stack
       - name: Set up Mariadb 🧰
         uses: shogo82148/actions-setup-mysql@v1
         with:
@@ -94,6 +94,6 @@ jobs:
           php-version: "8.0"
           extensions: mysqli
       - name: Build and test 🏗 🧪
-        uses: freckle/stack-action@v4
+        uses: freckle/stack-action@v5
         with:
-          stack-arguments: "--copy-bins --flag ampersand:buildAll"
+          stack-build-arguments: "--copy-bins --flag ampersand:buildAll"
diff --git a/.github/workflows/release.yml b/.github/workflows/release.yml
index 38b7af3b0..dae1e7043 100644
--- a/.github/workflows/release.yml
+++ b/.github/workflows/release.yml
@@ -146,16 +146,16 @@ jobs:
     steps:
       - name: Checkout project contents 📡
         uses: actions/checkout@v3
-      - name: Use cache when available 📦
-        uses: freckle/stack-cache-action@main
+      # - name: Use cache when available 📦
+      #   uses: freckle/stack-cache-action@main
       - name: Set up Mariadb 🧰
         uses: shogo82148/actions-setup-mysql@v1
         with:
           mysql-version: "mariadb-10.6"
       - name: Build and test 🏗 🧪
-        uses: freckle/stack-action@v4 # stack-action does all these steps: dependencies, build, test.
+        uses: freckle/stack-action@v5 # stack-action does all these steps: dependencies, build, test.
         with:
-          stack-arguments: "--copy-bins --flag ampersand:buildAll"
+          stack-build-arguments: "--copy-bins --flag ampersand:buildAll"
       - name: Upload artifacts (Linux)
         uses: actions/upload-artifact@v2
         with:
@@ -168,16 +168,16 @@ jobs:
     steps:
       - name: Checkout project contents 📡
         uses: actions/checkout@v3
-      - name: Use cache when available 📦
-        uses: freckle/stack-cache-action@main
+      # - name: Use cache when available 📦
+      #   uses: freckle/stack-cache-action@main
       - name: Set up Mariadb 🧰
         uses: shogo82148/actions-setup-mysql@v1
         with:
           mysql-version: "mariadb-10.6"
       - name: Build and test  🏗 🧪
-        uses: freckle/stack-action@v4
+        uses: freckle/stack-action@v5
         with:
-          stack-arguments: "--copy-bins --flag ampersand:buildAll --verbose"
+          stack-build-arguments: "--copy-bins --flag ampersand:buildAll --verbose"
       - name: Upload artifacts (macOS)
         uses: actions/upload-artifact@v2
         with:
@@ -190,15 +190,15 @@ jobs:
     steps:
       - name: Checkout project contents 📡
         uses: actions/checkout@v3
-      - name: Use cache (manually) 📦 # See https://github.com/freckle/stack-cache-action/issues/5
-        uses: actions/cache@v3.3.2
-        # TODO: Cache might be done better, see for inspiration:  https://github.com/godu/advent-of-code-2020/blob/46796832f59d185457a8edf8de043a54a451d688/.github/workflows/ci.yml
-        with:
-          path: |
-            ~/.ghc
-            ~/.stack
-            ~/.stack-work
-          key: ${{ runner.os }}-stack
+      # - name: Use cache (manually) 📦 # See https://github.com/freckle/stack-cache-action/issues/5
+      # uses: actions/cache@v3.3.2
+      # # TODO: Cache might be done better, see for inspiration:  https://github.com/godu/advent-of-code-2020/blob/46796832f59d185457a8edf8de043a54a451d688/.github/workflows/ci.yml
+      # with:
+      #   path: |
+      #     ~/.ghc
+      #     ~/.stack
+      #     ~/.stack-work
+      #   key: ${{ runner.os }}-stack
       - name: Set up Mariadb 🧰
         uses: shogo82148/actions-setup-mysql@v1
         with:
@@ -209,9 +209,9 @@ jobs:
           php-version: "8.0"
           extensions: mysqli
       - name: Build and test 🏗 🧪
-        uses: freckle/stack-action@v4
+        uses: freckle/stack-action@v5
         with:
-          stack-arguments: "--copy-bins --flag ampersand:buildAll"
+          stack-build-arguments: "--copy-bins --flag ampersand:buildAll"
       - name: Upload artifacts (Windows)
         uses: actions/upload-artifact@v2
         with:

From a2812c0c8783f5f42edb756e983ef15417cca110 Mon Sep 17 00:00:00 2001
From: hanjoosten <han.joosten@ordina.nl>
Date: Tue, 9 Apr 2024 08:33:00 +0200
Subject: [PATCH 02/43] Dependencies can now be compiled

---
 .devcontainer/Dockerfile         |   2 +-
 .devcontainer/DockerfileUpstream |  37 +--
 ampersand.cabal                  | 382 +++++++++++++++----------------
 package.yaml                     | 116 +++++-----
 stack.yaml                       |  28 +--
 stack.yaml.lock                  |  97 ++------
 6 files changed, 297 insertions(+), 365 deletions(-)

diff --git a/.devcontainer/Dockerfile b/.devcontainer/Dockerfile
index b008efdc3..350119612 100644
--- a/.devcontainer/Dockerfile
+++ b/.devcontainer/Dockerfile
@@ -1,4 +1,4 @@
-FROM ampersandtarski/ampersand-devcontainer:latest
+FROM ampersandtarski/ampersand-devcontainer:ghc9
 
 ENV DEBIAN_FRONTEND=dialog
 
diff --git a/.devcontainer/DockerfileUpstream b/.devcontainer/DockerfileUpstream
index 788521e97..b8d0ac5e1 100644
--- a/.devcontainer/DockerfileUpstream
+++ b/.devcontainer/DockerfileUpstream
@@ -16,21 +16,24 @@ ENV USERNAME=${USERNAME} \
 RUN \
     apt-get update -y && \
     apt-get install -y --no-install-recommends \
+    apt-transport-https \
+    autoconf \
+    automake \
+    build-essential \
     curl \
-    libnuma-dev \
-    zlib1g-dev \
+    gcc \
+    git \
+    gnupg2 \
+    libbz2-dev \
+    libexpat1-dev \
     libgmp-dev \
     libgmp10 \
-    git \
-    wget \
+    libnuma-dev \
     lsb-release \
+    pkg-config \
     software-properties-common \
-    gnupg2 \
-    apt-transport-https \
-    gcc \
-    autoconf \
-    automake \
-    build-essential \
+    wget \
+    zlib1g-dev \
     && rm -rf /var/lib/apt/lists/*
 
 RUN groupadd --gid $USER_GID $USERNAME && \
@@ -57,10 +60,10 @@ RUN curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | sh
 # Add ghcup and cabal to the PATH
 ENV PATH="${WDIR}/.cabal/bin:${WDIR}/.ghcup/bin:${PATH}:${WDIR}/.local/bin:${PATH}"
 
-ARG GHC=8.10.7
-ARG CABAL=3.6.2.0
-ARG HLS=2.2.0.0
-ARG STACK=2.11.1
+ARG GHC=9.6.4
+ARG CABAL=3.10.2.1
+ARG HLS=2.7.0.0
+ARG STACK=2.13.1
 
 # install GHC and cabal
 
@@ -73,9 +76,9 @@ FROM base as tools
 
 # Install global packages.
 # Versions are pinned, since we don't want to accidentally break anything (by always installing latest).
-RUN cabal install -v haskell-dap-0.0.15.0 && \
-    cabal install -v stylish-haskell-0.13.0.0 && \
-    cabal install -v ormolu-0.1.3.1
+RUN cabal install -v haskell-dap-0.0.16.0 && \
+    cabal install -v stylish-haskell-0.14.5.0 && \
+    cabal install -v ormolu-0.7.2.0
 # RUN cabal install -v ghci-dap-0.0.19.0
 # RUN cabal install -v haskell-debug-adapter-0.0.37.0
 # RUN cabal install -v hlint-3.2.7
diff --git a/ampersand.cabal b/ampersand.cabal
index 439c29b53..aeda10c5a 100644
--- a/ampersand.cabal
+++ b/ampersand.cabal
@@ -1,6 +1,6 @@
 cabal-version: 2.0
 
--- This file has been generated from package.yaml by hpack version 0.35.2.
+-- This file has been generated from package.yaml by hpack version 0.36.0.
 --
 -- see: https://github.com/sol/hpack
 
@@ -18,7 +18,7 @@ copyright:      Stef Joosten
 license:        GPL
 license-file:   LICENSE
 tested-with:
-    GHC == 8.10.7
+    GHC == 9.6.4
 build-type:     Custom
 extra-source-files:
     LICENSE
@@ -411,16 +411,16 @@ extra-source-files:
 
 custom-setup
   setup-depends:
-      Cabal ==3.2.1.0
-    , base ==4.14.3.0
-    , bytestring ==0.10.*
-    , directory ==1.3.*
-    , filepath ==1.4.*
-    , process ==1.6.*
-    , rio ==0.1.*
-    , salve ==1.0.11
-    , time ==1.9.3
-    , zip-archive >=0.4.1
+      Cabal
+    , base
+    , bytestring
+    , directory
+    , filepath
+    , process
+    , rio
+    , salve
+    , time
+    , zip-archive
 
 flag buildAll
   description: Build both ampersand and ampPreProc.
@@ -585,55 +585,54 @@ library
       OverloadedStrings
   ghc-options: -Wall -Wcompat -Widentities -optP-Wno-nonportable-include-path -Wredundant-constraints -fwrite-ide-info -hiedir=.hie
   build-depends:
-      HStringTemplate ==0.8.*
-    , QuickCheck ==2.14.2
-    , SpreadsheetML ==0.1.*
-    , aeson ==1.5.6.0
-    , aeson-pretty ==0.8.*
-    , ansi-terminal ==0.11.*
-    , base ==4.14.3.0
-    , bytestring ==0.10.*
-    , casing ==0.1.*
-    , conduit ==1.3.*
-    , containers ==0.6.*
-    , cryptonite ==0.29.*
-    , data-default ==0.7.*
-    , directory ==1.3.*
-    , doctemplates ==0.9
-    , extra >=1.6.6
-    , filepath ==1.4.*
-    , fsnotify ==0.3.*
+      HStringTemplate
+    , QuickCheck
+    , SpreadsheetML
+    , aeson
+    , aeson-pretty
+    , ansi-terminal
+    , base
+    , bytestring
+    , casing
+    , conduit
+    , containers
+    , cryptonite
+    , data-default
+    , directory
+    , doctemplates
+    , extra
+    , filepath
+    , fsnotify
     , generic-deriving
-    , graphviz ==2999.20.*
-    , hashable ==1.3.0.0
-    , http-conduit ==2.3.*
-    , hxt ==9.3.*
-    , lens ==4.19.2
-    , mtl ==2.2.*
-    , optparse-applicative ==0.16.*
-    , pandoc ==2.14.*
-    , pandoc-crossref ==0.3.12.*
-    , pandoc-types ==1.22.*
-    , parsec ==3.1.*
-    , process ==1.6.*
+    , graphviz
+    , hashable
+    , http-conduit
+    , hxt
+    , lens
+    , mtl
+    , optparse-applicative
+    , pandoc
+    , pandoc-crossref
+    , pandoc-types
+    , parsec
+    , process
     , quickcheck-instances
-    , rio ==0.1.*
-    , salve ==1.*
-    , simple-sql-parser ==0.4.4
-    , split ==0.2.*
-    , terminal-size ==0.3.*
-    , texmath ==0.12.*
-    , text ==1.2.*
-    , text1 ==0.0.7.4
-    , time ==1.9.3
+    , rio
+    , salve
+    , simple-sql-parser
+    , split
+    , terminal-size
+    , texmath
+    , text
+    , text1
+    , time
     , transformers
-    , typed-process ==0.2.*
+    , typed-process
     , uri-encode
-    , wl-pprint ==1.2.*
-    , xlsx ==0.8.*
-    , yaml ==0.11.*
-    , yaml-config ==0.4.*
-    , zip-archive >=0.4.1
+    , wl-pprint
+    , xlsx
+    , yaml
+    , zip-archive
   default-language: Haskell2010
   if os(windows)
     build-depends:
@@ -655,56 +654,55 @@ executable ampPreProc
       OverloadedStrings
   ghc-options: -Wall -Wcompat -Widentities -optP-Wno-nonportable-include-path -Wredundant-constraints -fwrite-ide-info -hiedir=.hie -threaded
   build-depends:
-      HStringTemplate ==0.8.*
-    , QuickCheck ==2.14.2
-    , SpreadsheetML ==0.1.*
-    , aeson ==1.5.6.0
-    , aeson-pretty ==0.8.*
+      HStringTemplate
+    , QuickCheck
+    , SpreadsheetML
+    , aeson
+    , aeson-pretty
     , ampersand
-    , ansi-terminal ==0.11.*
-    , base ==4.14.3.0
-    , bytestring ==0.10.*
-    , casing ==0.1.*
-    , conduit ==1.3.*
-    , containers ==0.6.*
-    , cryptonite ==0.29.*
-    , data-default ==0.7.*
-    , directory ==1.3.*
-    , doctemplates ==0.9
-    , extra >=1.6.6
-    , filepath ==1.4.*
-    , fsnotify ==0.3.*
+    , ansi-terminal
+    , base
+    , bytestring
+    , casing
+    , conduit
+    , containers
+    , cryptonite
+    , data-default
+    , directory
+    , doctemplates
+    , extra
+    , filepath
+    , fsnotify
     , generic-deriving
-    , graphviz ==2999.20.*
-    , hashable ==1.3.0.0
-    , http-conduit ==2.3.*
-    , hxt ==9.3.*
-    , lens ==4.19.2
-    , mtl ==2.2.*
-    , optparse-applicative ==0.16.*
-    , pandoc ==2.14.*
-    , pandoc-crossref ==0.3.12.*
-    , pandoc-types ==1.22.*
-    , parsec ==3.1.*
-    , process ==1.6.*
+    , graphviz
+    , hashable
+    , http-conduit
+    , hxt
+    , lens
+    , mtl
+    , optparse-applicative
+    , pandoc
+    , pandoc-crossref
+    , pandoc-types
+    , parsec
+    , process
     , quickcheck-instances
-    , rio ==0.1.*
-    , salve ==1.*
-    , simple-sql-parser ==0.4.4
-    , split ==0.2.*
-    , terminal-size ==0.3.*
-    , texmath ==0.12.*
-    , text ==1.2.*
-    , text1 ==0.0.7.4
-    , time ==1.9.3
+    , rio
+    , salve
+    , simple-sql-parser
+    , split
+    , terminal-size
+    , texmath
+    , text
+    , text1
+    , time
     , transformers
-    , typed-process ==0.2.*
+    , typed-process
     , uri-encode
-    , wl-pprint ==1.2.*
-    , xlsx ==0.8.*
-    , yaml ==0.11.*
-    , yaml-config ==0.4.*
-    , zip-archive >=0.4.1
+    , wl-pprint
+    , xlsx
+    , yaml
+    , zip-archive
   default-language: Haskell2010
   if os(windows)
     build-depends:
@@ -728,57 +726,56 @@ executable ampersand
       OverloadedStrings
   ghc-options: -Wall -Wcompat -Widentities -optP-Wno-nonportable-include-path -Wredundant-constraints -fwrite-ide-info -hiedir=.hie -threaded -fwrite-ide-info
   build-depends:
-      Cabal ==3.2.1.0
-    , HStringTemplate ==0.8.*
-    , QuickCheck ==2.14.2
-    , SpreadsheetML ==0.1.*
-    , aeson ==1.5.6.0
-    , aeson-pretty ==0.8.*
+      Cabal
+    , HStringTemplate
+    , QuickCheck
+    , SpreadsheetML
+    , aeson
+    , aeson-pretty
     , ampersand
-    , ansi-terminal ==0.11.*
-    , base ==4.14.3.0
-    , bytestring ==0.10.*
-    , casing ==0.1.*
-    , conduit ==1.3.*
-    , containers ==0.6.*
-    , cryptonite ==0.29.*
-    , data-default ==0.7.*
-    , directory ==1.3.*
-    , doctemplates ==0.9
-    , extra >=1.6.6
-    , filepath ==1.4.*
-    , fsnotify ==0.3.*
+    , ansi-terminal
+    , base
+    , bytestring
+    , casing
+    , conduit
+    , containers
+    , cryptonite
+    , data-default
+    , directory
+    , doctemplates
+    , extra
+    , filepath
+    , fsnotify
     , generic-deriving
-    , graphviz ==2999.20.*
-    , hashable ==1.3.0.0
-    , http-conduit ==2.3.*
-    , hxt ==9.3.*
-    , lens ==4.19.2
-    , mtl ==2.2.*
-    , optparse-applicative ==0.16.*
-    , pandoc ==2.14.*
-    , pandoc-crossref ==0.3.12.*
-    , pandoc-types ==1.22.*
-    , parsec ==3.1.*
-    , process ==1.6.*
+    , graphviz
+    , hashable
+    , http-conduit
+    , hxt
+    , lens
+    , mtl
+    , optparse-applicative
+    , pandoc
+    , pandoc-crossref
+    , pandoc-types
+    , parsec
+    , process
     , quickcheck-instances
-    , rio ==0.1.*
-    , salve ==1.*
-    , simple-sql-parser ==0.4.4
-    , split ==0.2.*
-    , terminal-size ==0.3.*
-    , texmath ==0.12.*
-    , text ==1.2.*
-    , text1 ==0.0.7.4
-    , time ==1.9.3
+    , rio
+    , salve
+    , simple-sql-parser
+    , split
+    , terminal-size
+    , texmath
+    , text
+    , text1
+    , time
     , transformers
-    , typed-process ==0.2.*
+    , typed-process
     , uri-encode
-    , wl-pprint ==1.2.*
-    , xlsx ==0.8.*
-    , yaml ==0.11.*
-    , yaml-config ==0.4.*
-    , zip-archive >=0.4.1
+    , wl-pprint
+    , xlsx
+    , yaml
+    , zip-archive
   default-language: Haskell2010
   if os(windows)
     build-depends:
@@ -801,56 +798,55 @@ test-suite ampersand-test
       OverloadedStrings
   ghc-options: -Wall -Wcompat -Widentities -optP-Wno-nonportable-include-path -Wredundant-constraints -fwrite-ide-info -hiedir=.hie -threaded
   build-depends:
-      HStringTemplate ==0.8.*
-    , QuickCheck ==2.14.2
-    , SpreadsheetML ==0.1.*
-    , aeson ==1.5.6.0
-    , aeson-pretty ==0.8.*
+      HStringTemplate
+    , QuickCheck
+    , SpreadsheetML
+    , aeson
+    , aeson-pretty
     , ampersand
-    , ansi-terminal ==0.11.*
-    , base ==4.14.3.0
-    , bytestring ==0.10.*
-    , casing ==0.1.*
-    , conduit ==1.3.*
-    , containers ==0.6.*
-    , cryptonite ==0.29.*
-    , data-default ==0.7.*
-    , directory ==1.3.*
-    , doctemplates ==0.9
-    , extra >=1.6.6
-    , filepath ==1.4.*
-    , fsnotify ==0.3.*
+    , ansi-terminal
+    , base
+    , bytestring
+    , casing
+    , conduit
+    , containers
+    , cryptonite
+    , data-default
+    , directory
+    , doctemplates
+    , extra
+    , filepath
+    , fsnotify
     , generic-deriving
-    , graphviz ==2999.20.*
-    , hashable ==1.3.0.0
-    , http-conduit ==2.3.*
-    , hxt ==9.3.*
-    , lens ==4.19.2
-    , mtl ==2.2.*
-    , optparse-applicative ==0.16.*
-    , pandoc ==2.14.*
-    , pandoc-crossref ==0.3.12.*
-    , pandoc-types ==1.22.*
-    , parsec ==3.1.*
-    , process ==1.6.*
+    , graphviz
+    , hashable
+    , http-conduit
+    , hxt
+    , lens
+    , mtl
+    , optparse-applicative
+    , pandoc
+    , pandoc-crossref
+    , pandoc-types
+    , parsec
+    , process
     , quickcheck-instances
-    , rio ==0.1.*
-    , salve ==1.*
-    , simple-sql-parser ==0.4.4
-    , split ==0.2.*
-    , terminal-size ==0.3.*
-    , texmath ==0.12.*
-    , text ==1.2.*
-    , text1 ==0.0.7.4
-    , time ==1.9.3
+    , rio
+    , salve
+    , simple-sql-parser
+    , split
+    , terminal-size
+    , texmath
+    , text
+    , text1
+    , time
     , transformers
-    , typed-process ==0.2.*
+    , typed-process
     , uri-encode
-    , wl-pprint ==1.2.*
-    , xlsx ==0.8.*
-    , yaml ==0.11.*
-    , yaml-config ==0.4.*
-    , zip-archive >=0.4.1
+    , wl-pprint
+    , xlsx
+    , yaml
+    , zip-archive
   default-language: Haskell2010
   if os(windows)
     build-depends:
diff --git a/package.yaml b/package.yaml
index 92a3fea91..9788038d3 100644
--- a/package.yaml
+++ b/package.yaml
@@ -7,7 +7,7 @@ description: You can define your business processes by means of rules, written i
 homepage: http://ampersandtarski.github.io/
 category: Database Design
 stability: alpha
-tested-with: GHC == 8.10.7
+tested-with: GHC == 9.6.4
 build-type: Custom
 license: GPL
 license-file: LICENSE
@@ -36,55 +36,56 @@ default-extensions:
   - NoImplicitPrelude
   - OverloadedStrings
 dependencies:
-  - aeson == 1.5.6.0
-  - aeson-pretty == 0.8.*
-  - ansi-terminal == 0.11.*
-  - base == 4.14.3.0
-  - bytestring == 0.10.*
-  - casing == 0.1.*
-  - conduit == 1.3.*
-  - containers == 0.6.*
-  - cryptonite == 0.29.*
-  - data-default == 0.7.*
-  - directory == 1.3.*
-  - doctemplates == 0.9
-  - extra >= 1.6.6
-  - filepath == 1.4.*
-  - fsnotify == 0.3.*
+  ## Note: We rely on stackage to supply the right versions. The set of versions is determined by the resolver in `stack.yaml`
+  - aeson
+  - aeson-pretty
+  - ansi-terminal
+  - base
+  - bytestring
+  - casing
+  - conduit
+  - containers
+  - cryptonite
+  - data-default
+  - directory
+  - doctemplates
+  - extra
+  - filepath
+  - fsnotify
   - generic-deriving
-  - graphviz == 2999.20.*
-  - hashable == 1.3.0.0
-  - HStringTemplate == 0.8.*
-  - http-conduit == 2.3.*
-  - hxt == 9.3.*
-  - lens == 4.19.2
-  - mtl == 2.2.*
-  - optparse-applicative == 0.16.*
-  - pandoc == 2.14.*
-  - pandoc-crossref == 0.3.12.*
-  - pandoc-types == 1.22.*
-  - parsec == 3.1.*
-  - process == 1.6.*
-  - QuickCheck == 2.14.2
+  - graphviz
+  - hashable
+  - HStringTemplate
+  - http-conduit
+  - hxt
+  - lens
+  - mtl
+  - optparse-applicative
+  - pandoc
+  - pandoc-crossref
+  - pandoc-types
+  - parsec
+  - process
+  - QuickCheck
   - quickcheck-instances
-  - rio == 0.1.*
-  - salve == 1.*
-  - simple-sql-parser == 0.4.4
-  - split == 0.2.*
-  - SpreadsheetML == 0.1.*
-  - terminal-size == 0.3.*
-  - texmath == 0.12.*
-  - text == 1.2.*
-  - text1 == 0.0.7.4
-  - time == 1.9.3
+  - rio
+  - salve
+  - simple-sql-parser
+  - split
+  - SpreadsheetML
+  - terminal-size
+  - texmath
+  - text
+  - text1
+  - time
   - transformers
-  - typed-process == 0.2.*
+  - typed-process
   - uri-encode
-  - wl-pprint == 1.2.*
-  - xlsx == 0.8.*
-  - yaml == 0.11.*
-  - yaml-config == 0.4.*
-  - zip-archive >= 0.4.1
+  - wl-pprint
+  - xlsx
+  - yaml
+  # - yaml-config
+  - zip-archive
 when:
   - condition: os(windows)
     then:
@@ -205,16 +206,17 @@ library:
     - Ampersand.Prototype.StaticFiles_Generated
 custom-setup:
   dependencies:
-    - base == 4.14.3.0
-    - bytestring == 0.10.*
-    - Cabal == 3.2.1.0
-    - directory == 1.3.*
-    - filepath == 1.4.*
-    - process == 1.6.*
-    - rio == 0.1.*
-    - time == 1.9.3
-    - salve == 1.0.11
-    - zip-archive >= 0.4.1
+    ## Note: We rely on stackage to supply the right versions. The set of versions is determined by the resolver in `stack.yaml`
+    - base
+    - bytestring
+    - Cabal
+    - directory
+    - filepath
+    - process
+    - rio
+    - time
+    - salve
+    - zip-archive
 
 executables:
   ampersand:
@@ -226,7 +228,7 @@ executables:
       - -fwrite-ide-info
     dependencies:
       - ampersand
-      - Cabal == 3.2.1.0
+      - Cabal
 
   ampPreProc:
     source-dirs:
diff --git a/stack.yaml b/stack.yaml
index 9410c5f32..6f16458da 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -1,36 +1,30 @@
 # For more information, see: https://github.com/commercialhaskell/stack/blob/release/doc/yaml_configuration.md
 
 # Specifies the GHC version and set of packages available (e.g., lts-3.5, nightly-2015-09-21, ghc-7.10.2)
-resolver: lts-18.28 # HJO,20220605: If changed, make sure you change this in .devcontainer stuff as well.
+resolver: lts-22.16 # HJO,20220605: If changed, make sure you change this in .devcontainer stuff as well.
 # resolver: nightly-2018-11-24 # temporarily no LTS. Same as pandoc-crossref.
-allow-newer: false
+allow-newer: true
+allow-newer-deps:
+  # - simple-sql-parser
+  - text1
+
 # Local packages, usually specified by relative directory name
 packages:
   - "."
 
 # Packages to be pulled from upstream that are not in the resolver (e.g., acme-missiles-0.3)
 extra-deps:
-  - pandoc-crossref-0.3.12.1
-  - roman-numerals-0.5.1.5@sha256:819d04d9d442b24629dd058f6f0b02bd78e9f9ae99538bc44ca448f1cb2b7b01,1208
-  - simple-sql-parser-0.4.4
+  - pandoc-crossref-0.3.17.0
+  - simple-sql-parser-0.7.1@sha256:4281e5426b09161ff2409cc60f40b05bb68f0ebf8b539a8a15ffa2b6d4275ed0,3953
   - SpreadsheetML-0.1@sha256:58aec77fb2d79779c6a1a4c2101526db0947dc558c064a46598cdde5745bfa74,1362
-  - wl-pprint-1.2.1@sha256:aea676cff4a062d7d912149d270e33f5bb0c01b68a9db46ff13b438141ff4b7c,734
-  - yaml-config-0.4.0@sha256:575103d9fa1ef074a2b419256babaae7be5f5257f37adf3ed2601052415b2d83,1814
-  - salve-1.0.11
+  #  - yaml-config-0.4.0@sha256:575103d9fa1ef074a2b419256babaae7be5f5257f37adf3ed2601052415b2d83,1814
   - text1-0.0.7.4@sha256:cc980c88b188384fadd02b56e6e8e5f9317a43e1459a16558273589a49bcf951,2741
-  # extra-deps for weeder-2.1.3:
-  - weeder-2.1.3
-  - dhall-1.37.1@sha256:447031286e8fe270b0baacd9cc5a8af340d2ae94bb53b85807bee93381ca5287,35080
-  - generic-lens-2.0.0.0@sha256:7409fa0ce540d0bd41acf596edd1c5d0c0ab1cd1294d514cf19c5c24e8ef2550,3866
-  - generic-lens-core-2.0.0.0@sha256:40b063c4a1399b3cdb19f2df1fae5a1a82f3313015c7c3e47fc23b8ef1b3e443,2913
-  # extra-deps for haskell-debug-adapter-0.0.37.0:
-  - ghci-dap-0.0.19.0@sha256:5c4485b7a62d120f648c883f1f1480b25363ab5e14f6ca1ed2db526e0af1d43c,3293
-  - haskell-dap-0.0.15.0@sha256:d58ec48d5f23c13675ba6a6ceb75f9ad9c0b0e90031e15cf7cd227478bad5fa5,945
+  - megaparsec-9.6.1@sha256:8d8f8ee5aca5d5c16aa4219afd13687ceab8be640f40ba179359f2b42a628241,3323
 
 # Override default flag values for local packages and extra-deps
 flags:
   pandoc:
-    trypandoc: false
+    #  trypandoc: false
     embed_data_files: true
   #    static: false
   # pandoc-citeproc:
diff --git a/stack.yaml.lock b/stack.yaml.lock
index 0983e3270..14f3e5797 100644
--- a/stack.yaml.lock
+++ b/stack.yaml.lock
@@ -5,26 +5,19 @@
 
 packages:
 - completed:
-    hackage: pandoc-crossref-0.3.12.1@sha256:4d89c5c94bb4f771d3c36adede4672f97a4d3b34862ba15b4c59568524a5f55c,7621
+    hackage: pandoc-crossref-0.3.17.0@sha256:84507632d82a1cbda65bf8874dd8a2f2e03b87f82932a45ee961b6df51f211cf,9282
     pantry-tree:
-      sha256: 5fba7d11a596f283bd1b1458b34e57699f44b0f6e54ac5016b7aa7b863634716
-      size: 7178
+      sha256: 7539426739165223f6dc52f40ab1091c18a35a77fd37cb0cee537e47f4ab6744
+      size: 9882
   original:
-    hackage: pandoc-crossref-0.3.12.1
+    hackage: pandoc-crossref-0.3.17.0
 - completed:
-    hackage: roman-numerals-0.5.1.5@sha256:819d04d9d442b24629dd058f6f0b02bd78e9f9ae99538bc44ca448f1cb2b7b01,1208
+    hackage: simple-sql-parser-0.7.1@sha256:4281e5426b09161ff2409cc60f40b05bb68f0ebf8b539a8a15ffa2b6d4275ed0,3953
     pantry-tree:
-      sha256: 2154c0f4a11842593586dc1932e233cd8c802994763f7d3ce3e5916be8bc7ee5
-      size: 220
+      sha256: 44ec0e83fb8cad34bb357638fd59f79bdb79a700ce139ac59daa28efdda3f1a9
+      size: 2637
   original:
-    hackage: roman-numerals-0.5.1.5@sha256:819d04d9d442b24629dd058f6f0b02bd78e9f9ae99538bc44ca448f1cb2b7b01,1208
-- completed:
-    hackage: simple-sql-parser-0.4.4@sha256:9e7171247d29d8b367f452044791223840aa4587b4e844f852cf620e85c61db0,3978
-    pantry-tree:
-      sha256: 7d2d5a45845ef3504c585ac74cb8ff8c7300658e00f79c2208cf34829b243ea1
-      size: 1746
-  original:
-    hackage: simple-sql-parser-0.4.4
+    hackage: simple-sql-parser-0.7.1@sha256:4281e5426b09161ff2409cc60f40b05bb68f0ebf8b539a8a15ffa2b6d4275ed0,3953
 - completed:
     hackage: SpreadsheetML-0.1@sha256:58aec77fb2d79779c6a1a4c2101526db0947dc558c064a46598cdde5745bfa74,1362
     pantry-tree:
@@ -32,79 +25,23 @@ packages:
       size: 388
   original:
     hackage: SpreadsheetML-0.1@sha256:58aec77fb2d79779c6a1a4c2101526db0947dc558c064a46598cdde5745bfa74,1362
-- completed:
-    hackage: wl-pprint-1.2.1@sha256:aea676cff4a062d7d912149d270e33f5bb0c01b68a9db46ff13b438141ff4b7c,734
-    pantry-tree:
-      sha256: 750b375c6fc33400551f9e32e26e41844c372270a9bc3571e912fa36df7c6d4f
-      size: 221
-  original:
-    hackage: wl-pprint-1.2.1@sha256:aea676cff4a062d7d912149d270e33f5bb0c01b68a9db46ff13b438141ff4b7c,734
-- completed:
-    hackage: yaml-config-0.4.0@sha256:575103d9fa1ef074a2b419256babaae7be5f5257f37adf3ed2601052415b2d83,1814
-    pantry-tree:
-      sha256: 504d63293d50f9949a1130abcaf1885f10df61a658cba854fb704521ba797c91
-      size: 347
-  original:
-    hackage: yaml-config-0.4.0@sha256:575103d9fa1ef074a2b419256babaae7be5f5257f37adf3ed2601052415b2d83,1814
-- completed:
-    hackage: salve-1.0.11@sha256:4a40542345aece926e9571621459e28f956e30da22163571c6d3ab5a934e07b7,1050
-    pantry-tree:
-      sha256: 67b0215716ae7652da96f6846de5c845787a4e3e8cb90da8cd523e3a81c4b66d
-      size: 350
-  original:
-    hackage: salve-1.0.11
 - completed:
     hackage: text1-0.0.7.4@sha256:cc980c88b188384fadd02b56e6e8e5f9317a43e1459a16558273589a49bcf951,2741
     pantry-tree:
-      size: 571
       sha256: e990bf16f9321fd4d5a5101599c232b95b49a5b1252aab6c97dc3778fdc5b375
+      size: 571
   original:
     hackage: text1-0.0.7.4@sha256:cc980c88b188384fadd02b56e6e8e5f9317a43e1459a16558273589a49bcf951,2741
 - completed:
-    hackage: weeder-2.1.3@sha256:db1e3fc56cd4d75bd61f0ebe2af69356cb0e6e3556628365621d5402c4d8acd0,2209
-    pantry-tree:
-      sha256: f5a227042d770ea9e50e89e7447b14f9db36bfa29ecec3ea4a446271e2bb6e7c
-      size: 438
-  original:
-    hackage: weeder-2.1.3
-- completed:
-    hackage: dhall-1.37.1@sha256:447031286e8fe270b0baacd9cc5a8af340d2ae94bb53b85807bee93381ca5287,35080
-    pantry-tree:
-      sha256: 623de5587e614ace2b6e2f908ccd4b4eec26db9cf29de45874bed8c0bdef2db8
-      size: 305799
-  original:
-    hackage: dhall-1.37.1@sha256:447031286e8fe270b0baacd9cc5a8af340d2ae94bb53b85807bee93381ca5287,35080
-- completed:
-    hackage: generic-lens-2.0.0.0@sha256:7409fa0ce540d0bd41acf596edd1c5d0c0ab1cd1294d514cf19c5c24e8ef2550,3866
-    pantry-tree:
-      sha256: 46ba160f0efc9c805eac6666f298f48dda899834b68c860f63641ce1f82db737
-      size: 2470
-  original:
-    hackage: generic-lens-2.0.0.0@sha256:7409fa0ce540d0bd41acf596edd1c5d0c0ab1cd1294d514cf19c5c24e8ef2550,3866
-- completed:
-    hackage: generic-lens-core-2.0.0.0@sha256:40b063c4a1399b3cdb19f2df1fae5a1a82f3313015c7c3e47fc23b8ef1b3e443,2913
-    pantry-tree:
-      sha256: 73f91636570c0e96044f655402ccbf6adba78d3a93f8d9ee97f3115bae096536
-      size: 2201
-  original:
-    hackage: generic-lens-core-2.0.0.0@sha256:40b063c4a1399b3cdb19f2df1fae5a1a82f3313015c7c3e47fc23b8ef1b3e443,2913
-- completed:
-    hackage: ghci-dap-0.0.19.0@sha256:5c4485b7a62d120f648c883f1f1480b25363ab5e14f6ca1ed2db526e0af1d43c,3293
-    pantry-tree:
-      sha256: 4a394aa45d62bf965f77e3e632ffaa4d10204417319c61a704991414cf020cb5
-      size: 2894
-  original:
-    hackage: ghci-dap-0.0.19.0@sha256:5c4485b7a62d120f648c883f1f1480b25363ab5e14f6ca1ed2db526e0af1d43c,3293
-- completed:
-    hackage: haskell-dap-0.0.15.0@sha256:d58ec48d5f23c13675ba6a6ceb75f9ad9c0b0e90031e15cf7cd227478bad5fa5,945
+    hackage: megaparsec-9.6.1@sha256:8d8f8ee5aca5d5c16aa4219afd13687ceab8be640f40ba179359f2b42a628241,3323
     pantry-tree:
-      sha256: 4126d8e2ea49a4acbd30cad46e66068167a1a599032c0ddd8fde607f703c5a23
-      size: 315
+      sha256: ac654040a2402a733496678905ee17198bf628d75032dd025d595bd329739af8
+      size: 1545
   original:
-    hackage: haskell-dap-0.0.15.0@sha256:d58ec48d5f23c13675ba6a6ceb75f9ad9c0b0e90031e15cf7cd227478bad5fa5,945
+    hackage: megaparsec-9.6.1@sha256:8d8f8ee5aca5d5c16aa4219afd13687ceab8be640f40ba179359f2b42a628241,3323
 snapshots:
 - completed:
-    sha256: 428ec8d5ce932190d3cbe266b9eb3c175cd81e984babf876b64019e2cbe4ea68
-    size: 590100
-    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/18/28.yaml
-  original: lts-18.28
+    sha256: 0cd905bf3f615a7f52d52fb6aadda182f695bd1cab10ef892095d974676f0911
+    size: 713334
+    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/22/16.yaml
+  original: lts-22.16

From 26ef38fedd157b8f456ceeb4be353723f512d76c Mon Sep 17 00:00:00 2001
From: hanjoosten <han.joosten@ordina.nl>
Date: Tue, 9 Apr 2024 09:51:35 +0200
Subject: [PATCH 03/43] notification of file changes: FSNotify configuration
 changed

---
 src/Ampersand/Daemon/Wait.hs | 26 +++++++++++++++-----------
 1 file changed, 15 insertions(+), 11 deletions(-)

diff --git a/src/Ampersand/Daemon/Wait.hs b/src/Ampersand/Daemon/Wait.hs
index 260b66d4f..ecbfb4a9a 100644
--- a/src/Ampersand/Daemon/Wait.hs
+++ b/src/Ampersand/Daemon/Wait.hs
@@ -37,7 +37,7 @@ withWaiterNotify env f =
   runRIO env $ do liftIO (withWaiterNotify' f)
 
 withWaiterNotify' :: (Waiter -> IO a) -> IO a
-withWaiterNotify' f = withManagerConf defaultConfig {confDebounce = NoDebounce} $ \manager -> do
+withWaiterNotify' f = withManagerConf defaultConfig $ \manager -> do
   mvar <- liftIO newEmptyMVar
   var <- liftIO $ newVar Map.empty
   f $ WaiterNotify manager mvar var
@@ -74,23 +74,26 @@ waitFiles waiter = do
     logDebug $ "%WAITING: " <> display (T.pack $ unwords files)
     -- As listContentsInside returns directories, we are waiting on them explicitly and so
     -- will pick up new files, as creating a new file changes the containing directory's modtime.
-    files' <- liftIO $
-      fmap concat $
-        forM files $ \file ->
-          ifM (doesDirectoryExist file) (listContentsInside (return . not . L.isPrefixOf "." . takeFileName) file) (return [file])
+    files' <- liftIO
+      $ fmap concat
+      $ forM files
+      $ \file ->
+        ifM (doesDirectoryExist file) (listContentsInside (return . not . L.isPrefixOf "." . takeFileName) file) (return [file])
     case waiter of
       WaiterPoll _ -> pure ()
       WaiterNotify manager kick mp -> do
         dirs <- liftIO $ fmap Set.fromList $ mapM canonicalizePathSafe $ nubOrd $ map takeDirectory files'
         env <- ask
-        liftIO $
-          modifyVar_ mp $ \mp' -> do
+        liftIO
+          $ modifyVar_ mp
+          $ \mp' -> do
             let keep, del :: Map FilePath StopListening
                 (keep, del) = Map.partitionWithKey (\k _ -> k `Set.member` dirs) mp'
             liftIO $ sequence_ $ Map.elems del
             new <- forM (Set.toList $ dirs `Set.difference` Map.keysSet keep) $ \dir -> do
-              can <- liftIO $
-                watchDir manager (fromString dir) (const True) $ \event -> do
+              can <- liftIO
+                $ watchDir manager (fromString dir) (const True)
+                $ \event -> do
                   runRIO env $ logDebug $ "%NOTIFY: " <> displayShow event
                   void $ tryPutMVar kick ()
               return (dir, can)
@@ -127,8 +130,9 @@ waitFiles waiter = do
             -- but try not to
             logDebug $ "%WAITING: Waiting max of 1s due to file removal, " <> display (T.pack $ unwords disappeared)
             -- at most 20 iterations, but stop as soon as the file returns
-            void $
-              flip firstJustM (replicate 20 ()) $ \_ -> do
+            void
+              $ flip firstJustM (replicate 20 ())
+              $ \_ -> do
                 liftIO $ sleep 0.05
                 new' <- liftIO $ mapM getModTime files
                 return $ if null [x | (x, Just _, Nothing) <- L.zip3 files old new'] then Just () else Nothing

From b05e0cac93d9e5c689d24ae718317d3aea3f6a3c Mon Sep 17 00:00:00 2001
From: hanjoosten <han.joosten@ordina.nl>
Date: Tue, 9 Apr 2024 10:56:35 +0200
Subject: [PATCH 04/43] Fix XSLX package upgrade

---
 src/Ampersand/Input/ADL1/FilePos.hs | 15 ++++++++-------
 1 file changed, 8 insertions(+), 7 deletions(-)

diff --git a/src/Ampersand/Input/ADL1/FilePos.hs b/src/Ampersand/Input/ADL1/FilePos.hs
index 20ed8e7be..31e1d8c1b 100644
--- a/src/Ampersand/Input/ADL1/FilePos.hs
+++ b/src/Ampersand/Input/ADL1/FilePos.hs
@@ -56,7 +56,7 @@ addTab ::
   FilePos
 addTab pos@(FilePos _ _ col) = addPos tabWidth pos
   where
-    tabWidth = 8 - ((col -1) `mod` 8)
+    tabWidth = 8 - ((col - 1) `mod` 8)
 
 -- | Adds one column to the file position
 addPos :: Int -> FilePos -> FilePos
@@ -90,12 +90,12 @@ isFuzzyOrigin Origin {} = True
 isFuzzyOrigin MeatGrinder = True
 isFuzzyOrigin _ = False
 
-sortWithOrigins :: Traced a => [a] -> [a]
+sortWithOrigins :: (Traced a) => [a] -> [a]
 sortWithOrigins xs = sortedNonFuzzy <> fuzzy
   where
     (fuzzy, nonfuzzy) = L.partition (isFuzzyOrigin . origin) xs
     sortedNonFuzzy = L.sortBy nonFuzzyOrdering nonfuzzy
-    nonFuzzyOrdering :: Traced a => a -> a -> Ordering
+    nonFuzzyOrdering :: (Traced a) => a -> a -> Ordering
     nonFuzzyOrdering x y = case maybeOrdering (origin x) (origin y) of
       Just ordering -> ordering
       Nothing -> fatal "nonFuzzyOrdering must only be used on list containing non-fuzzy origins"
@@ -118,8 +118,8 @@ maybeOrdering x y = case x of
     case y of
       FileLoc {} -> Just LT
       XLSXLoc fpy wby (rowy, coly) ->
-        Just $
-          compare
+        Just
+          $ compare
             (fpx, wbx, (rowx, colx))
             (fpy, wby, (rowy, coly))
       PropertyRule {} -> Just GT
@@ -164,11 +164,12 @@ instance Show Origin where
   -- the proper working of the ampersand-language-extension
   show (FileLoc pos _) = show pos
   show (XLSXLoc filePath sheet (row, col)) =
-    filePath <> ":"
+    filePath
+      <> ":"
       <> "\n   Sheet: "
       <> T.unpack sheet
       <> ", Cell: "
-      <> T.unpack (int2col col)
+      <> (T.unpack . columnIndexToText $ ColumnIndex col)
       <> show row
       <> ". "
   show (PropertyRule dcl o) = "PropertyRule for " <> (T.unpack . text1ToText) dcl <> " which is defined at " <> show o

From b1eb6a217e3ca55e65c3309652b38fa14fe6e410 Mon Sep 17 00:00:00 2001
From: hanjoosten <han.joosten@ordina.nl>
Date: Tue, 9 Apr 2024 12:50:58 +0200
Subject: [PATCH 05/43] change in ansi-terminal

---
 src/Ampersand/Runners.hs | 33 +++++++++++++++------------------
 1 file changed, 15 insertions(+), 18 deletions(-)

diff --git a/src/Ampersand/Runners.hs b/src/Ampersand/Runners.hs
index 787251cb4..f0d5bde2d 100644
--- a/src/Ampersand/Runners.hs
+++ b/src/Ampersand/Runners.hs
@@ -20,21 +20,21 @@ module Ampersand.Runners
 where
 
 import Ampersand.Basics
---import           RIO.Time (addUTCTime, getCurrentTime)
---import           Stack.Build.Target(NeedTargets(..))
+-- import           RIO.Time (addUTCTime, getCurrentTime)
+-- import           Stack.Build.Target(NeedTargets(..))
 import Ampersand.Types.Config
 import RIO.Process (mkDefaultProcessContext)
---import           Stack.Constants
---import           Stack.DefaultColorWhen (defaultColorWhen)
---import qualified Stack.Docker as Docker
---import qualified Stack.Nix as Nix
---import           Stack.Setup
---import           Stack.Storage.User (upgradeChecksSince, logUpgradeCheck)
---import           Stack.Types.Config
---import           Stack.Types.Docker (dockerEnable)
---import           Stack.Types.Nix (nixEnable)
---import           Stack.Types.Version (stackMinorVersion, stackVersion, minorVersion)
-import System.Console.ANSI (hSupportsANSIWithoutEmulation)
+-- import           Stack.Constants
+-- import           Stack.DefaultColorWhen (defaultColorWhen)
+-- import qualified Stack.Docker as Docker
+-- import qualified Stack.Nix as Nix
+-- import           Stack.Setup
+-- import           Stack.Storage.User (upgradeChecksSince, logUpgradeCheck)
+-- import           Stack.Types.Config
+-- import           Stack.Types.Docker (dockerEnable)
+-- import           Stack.Types.Nix (nixEnable)
+-- import           Stack.Types.Version (stackMinorVersion, stackVersion, minorVersion)
+import System.Console.ANSI (hSupportsANSI)
 import System.Console.Terminal.Size (size, width)
 
 -- -- | Ensure that no project settings are used when running 'withConfig'.
@@ -128,15 +128,12 @@ withConfig inner =
 -- action.
 withRunnerGlobal :: GlobalOpts -> RIO Runner a -> IO a
 withRunnerGlobal go inner = do
-  useColor <-
-    fromMaybe True
-      <$> hSupportsANSIWithoutEmulation stderr
+  useColor <- hSupportsANSI stderr
   let defaultTerminalWidth = 100
   termWidth <-
     clipWidth
       <$> maybe
-        ( fromMaybe defaultTerminalWidth
-            <$> (fmap width <$> size)
+        ( maybe defaultTerminalWidth width <$> size
         )
         pure
         (globalTermWidth go)

From b3164033aa2904a9c7ed185970fb3585ff2ffb23 Mon Sep 17 00:00:00 2001
From: hanjoosten <han.joosten@ordina.nl>
Date: Tue, 9 Apr 2024 14:36:52 +0200
Subject: [PATCH 06/43] use of `pos` in instance declarations fixed (and ormolu
 layout)

---
 src/Ampersand/ADL1/P2A_Converters.hs       | 142 +++----
 src/Ampersand/ADL1/PrettyPrinters.hs       |  64 ++--
 src/Ampersand/Core/A2P_Converters.hs       |  19 +-
 src/Ampersand/Core/AbstractSyntaxTree.hs   | 136 +++----
 src/Ampersand/Core/ParseTree.hs            | 198 +++++-----
 src/Ampersand/FSpec/ShowHS.hs              | 120 ++++--
 src/Ampersand/Input/ADL1/Parser.hs         | 409 ++++++++++++++-------
 src/Ampersand/Input/Archi/ArchiAnalyze.hs  |  60 +--
 src/Ampersand/Test/Parser/ArbitraryTree.hs | 115 +++---
 9 files changed, 769 insertions(+), 494 deletions(-)

diff --git a/src/Ampersand/ADL1/P2A_Converters.hs b/src/Ampersand/ADL1/P2A_Converters.hs
index 255e4694b..100d10579 100644
--- a/src/Ampersand/ADL1/P2A_Converters.hs
+++ b/src/Ampersand/ADL1/P2A_Converters.hs
@@ -67,9 +67,9 @@ checkPurposes ctx =
    in case danglingPurposes of
         [] -> pure ()
         x : xs ->
-          Errors $
-            mkDanglingPurposeError x
-              NE.:| map mkDanglingPurposeError xs
+          Errors
+            $ mkDanglingPurposeError x
+            NE.:| map mkDanglingPurposeError xs
 
 -- Return True if the ExplObj in this Purpose does not exist.
 isDanglingPurpose :: A_Context -> Purpose -> Bool
@@ -83,7 +83,8 @@ isDanglingPurpose ctx purp =
     ExplPattern nm -> nm `notElem` map name (ctxpats ctx)
     ExplInterface nm -> nm `notElem` map name (ctxifcs ctx)
     ExplContext nm ->
-      ctxnm ctx /= nm
+      ctxnm ctx
+        /= nm
         && False -- HJO: This line is a workaround for the issue mentioned in https://github.com/AmpersandTarski/ampersand/issues/46
         -- TODO: fix this when we pick up working on multiple contexts.
         -- Check that interface references are not cyclic
@@ -366,7 +367,8 @@ pCtx2aCtx
 
           mkTypeMap :: [[A_Concept]] -> [Representation] -> Guarded [(A_Concept, TType)]
           mkTypeMap groups reprs =
-            f <$> traverse typeOfGroup groups
+            f
+              <$> traverse typeOfGroup groups
               <*> traverse typeOfSingle [c | c <- conceptsOfReprs, c `notElem` conceptsOfGroups]
             where
               f :: [[(A_Concept, TType)]] -> [Maybe (A_Concept, TType, [Origin])] -> [(A_Concept, TType)]
@@ -431,7 +433,7 @@ pCtx2aCtx
                   g' a as = case L.partition (disjoint a) as of
                     (_, []) -> (a, as)
                     (hs', hs) -> g' (L.nub $ a <> concat hs) hs'
-                  disjoint :: Eq a => [a] -> [a] -> Bool
+                  disjoint :: (Eq a) => [a] -> [a] -> Bool
                   disjoint ys = null . L.intersect ys
 
           mkTypology :: [A_Concept] -> Guarded Typology
@@ -445,8 +447,8 @@ pCtx2aCtx
                     { tyroot = r,
                       tyCpts = reverse . sortSpecific2Generic gns $ cs
                     }
-              rs -> mkMultipleRootsError rs $
-                case filter isInvolved gns of
+              rs -> mkMultipleRootsError rs
+                $ case filter isInvolved gns of
                   [] -> fatal "No involved gens"
                   x : xs -> x NE.:| xs
             where
@@ -684,8 +686,9 @@ pCtx2aCtx
                        in if viewIsCompatible
                             then pure ()
                             else
-                              Errors . pure $
-                                mkIncompatibleViewError objDef viewId viewAnnCptStr viewDefCptStr
+                              Errors
+                                . pure
+                                $ mkIncompatibleViewError objDef viewId viewAnnCptStr viewDefCptStr
                     Nothing -> Errors . pure $ mkUndeclaredError "view" objDef viewId
                 obj crud (e, sr) s =
                   ( BxExpr
@@ -720,9 +723,10 @@ pCtx2aCtx
         case mCrud of
           Nothing -> mostLiberalCruds (Origin "Default for Cruds") Nothing
           Just pc@(P_Cruds org userCrud)
-            | (length . L.nub . map toUpper) userCrudString == length userCrudString
+            | (length . L.nub . map toUpper) userCrudString
+                == length userCrudString
                 && all isValidChar userCrudString ->
-              warnings pc $ mostLiberalCruds org (Just userCrud)
+                warnings pc $ mostLiberalCruds org (Just userCrud)
             | otherwise -> Errors . pure $ mkInvalidCRUDError org userCrud
             where
               userCrudString = T.unpack . text1ToText $ userCrud
@@ -752,40 +756,40 @@ pCtx2aCtx
               crd = text1ToText crd1
               warns :: [Warning]
               warns =
-                map (mkCrudWarning pc) $
-                  [ [ "'C' was specified, but the term ",
-                      "  " <> showA expr,
-                      "doesn't allow for the creation of a new atom at its target concept (" <> (fullName . target) expr <> ") "
+                map (mkCrudWarning pc)
+                  $ [ [ "'C' was specified, but the term ",
+                        "  " <> showA expr,
+                        "doesn't allow for the creation of a new atom at its target concept (" <> (fullName . target) expr <> ") "
+                      ]
+                        <> [ "  HINT: You might want to use U(pdate), which updates the pair in the relation."
+                             | isFitForCrudU expr,
+                               'U' `notElem` T.unpack crd
+                           ]
+                      | 'C' `elem` T.unpack crd && not (isFitForCrudC expr)
                     ]
-                      <> [ "  HINT: You might want to use U(pdate), which updates the pair in the relation."
-                           | isFitForCrudU expr,
-                             'U' `notElem` T.unpack crd
-                         ]
-                    | 'C' `elem` T.unpack crd && not (isFitForCrudC expr)
-                  ]
-                    <> [ [ "'R' was specified, but the term ",
-                           "  " <> showA expr,
-                           "doesn't allow for read of the pairs in that term."
-                         ]
-                         | 'R' `elem` T.unpack crd && not (isFitForCrudR expr)
+                  <> [ [ "'R' was specified, but the term ",
+                         "  " <> showA expr,
+                         "doesn't allow for read of the pairs in that term."
                        ]
-                    <> [ [ "'U' was specified, but the term ",
-                           "  " <> showA expr,
-                           "doesn't allow to insert or delete pairs in it."
-                         ]
-                         | 'U' `elem` T.unpack crd && not (isFitForCrudU expr)
+                       | 'R' `elem` T.unpack crd && not (isFitForCrudR expr)
+                     ]
+                  <> [ [ "'U' was specified, but the term ",
+                         "  " <> showA expr,
+                         "doesn't allow to insert or delete pairs in it."
                        ]
-                    <> [ [ "'D' was specified, but the term ",
-                           "  " <> showA expr,
-                           "doesn't allow for the deletion of an atom from its target concept (" <> (fullName . target) expr <> ") "
-                         ]
-                         | 'D' `elem` T.unpack crd && not (isFitForCrudD expr)
+                       | 'U' `elem` T.unpack crd && not (isFitForCrudU expr)
+                     ]
+                  <> [ [ "'D' was specified, but the term ",
+                         "  " <> showA expr,
+                         "doesn't allow for the deletion of an atom from its target concept (" <> (fullName . target) expr <> ") "
                        ]
-                    <> [ [ "R(ead) is required to do U(pdate) or D(elete) ",
-                           "however, you explicitly specified 'r'."
-                         ]
-                         | 'r' `elem` T.unpack crd && ('U' `elem` T.unpack crd || 'D' `elem` T.unpack crd)
+                       | 'D' `elem` T.unpack crd && not (isFitForCrudD expr)
+                     ]
+                  <> [ [ "R(ead) is required to do U(pdate) or D(elete) ",
+                         "however, you explicitly specified 'r'."
                        ]
+                       | 'r' `elem` T.unpack crd && ('U' `elem` T.unpack crd || 'D' `elem` T.unpack crd)
+                     ]
       pSubi2aSubi ::
         ContextInfo ->
         Expression -> -- Expression of the surrounding
@@ -801,8 +805,8 @@ pCtx2aCtx
           P_InterfaceRef {si_str = ifcId} ->
             do
               (refIfcExpr, _) <- case lookupDisambIfcObj (declDisambMap ci) ifcId of
-                Just disambObj -> typecheckTerm ci $
-                  case disambObj of
+                Just disambObj -> typecheckTerm ci
+                  $ case disambObj of
                     P_BoxItemTerm {} -> obj_ctx disambObj -- term is type checked twice, but otherwise we need a more complicated type check method to access already-checked interfaces. TODO: hide possible duplicate errors in a nice way (that is: via CtxError)
                     P_BxTxt {} -> fatal "TXT is not expected here."
                 Nothing -> Errors . pure $ mkUndeclaredError "interface" o ifcId
@@ -816,11 +820,12 @@ pCtx2aCtx
                     }
                 )
           P_Box {} ->
-            addWarnings warnings $
-              build <$> traverse (fn <=< typecheckObjDef ci) l
-                <* uniqueLables (origin x) tkkey (btKeys . si_header $ x)
-                <* (uniqueLables (origin x) toNonEmptyLabel . filter hasLabel $ l) -- ensure that each label in a box has a unique name.
-                <* mustBeObject (target objExpr)
+            addWarnings warnings
+              $ build
+              <$> traverse (fn <=< typecheckObjDef ci) l
+              <* uniqueLables (origin x) tkkey (btKeys . si_header $ x)
+              <* (uniqueLables (origin x) toNonEmptyLabel . filter hasLabel $ l) -- ensure that each label in a box has a unique name.
+              <* mustBeObject (target objExpr)
             where
               toNonEmptyLabel :: P_BoxItem a -> Text1
               toNonEmptyLabel bi = case obj_PlainName bi of
@@ -903,8 +908,8 @@ pCtx2aCtx
             case gb of
               Errors x -> Errors x
               Checked obj' ws ->
-                addWarnings ws $
-                  case obj' of
+                addWarnings ws
+                  $ case obj' of
                     BxExpr o ->
                       case ttype . target . objExpression $ o of
                         Object ->
@@ -924,10 +929,11 @@ pCtx2aCtx
                                 ifcPurpose = ifc_Prp pIfc
                               }
                         tt ->
-                          Errors . pure
+                          Errors
+                            . pure
                             . mkInterfaceMustBeDefinedOnObject pIfc (target . objExpression $ o)
                             $ tt
-                    BxTxt _ -> fatal "Unexpected BxTxt" --Interface should not have TXT only. it should have a term object.
+                    BxTxt _ -> fatal "Unexpected BxTxt" -- Interface should not have TXT only. it should have a term object.
           ttype :: A_Concept -> TType
           ttype = representationOf declMap
 
@@ -941,7 +947,8 @@ pCtx2aCtx
 
       pPat2aPat :: ContextInfo -> P_Pattern -> Guarded Pattern
       pPat2aPat ci ppat =
-        f <$> traverse (pRul2aRul ci (Just $ label ppat)) (pt_rls ppat)
+        f
+          <$> traverse (pRul2aRul ci (Just $ label ppat)) (pt_rls ppat)
           <*> traverse (pIdentity2aIdentity ci (Just $ label ppat)) (pt_ids ppat)
           <*> traverse (pPop2aPop ci) (pt_pop ppat)
           <*> traverse (pViewDef2aViewDef ci) (pt_vds ppat)
@@ -1041,8 +1048,8 @@ pCtx2aCtx
                 let tgtOk = target expr `isaC` target rel
                 unless tgtOk $ mustBeOrdered pos' (Tgt, expr) (Tgt, rel)
                 let expr' =
-                      addEpsilonLeft genLattice (source rel) $
-                        addEpsilonRight genLattice (target rel) expr
+                      addEpsilonLeft genLattice (source rel)
+                        $ addEpsilonRight genLattice (target rel) expr
                 return
                   AEnforce
                     { pos = pos',
@@ -1081,12 +1088,13 @@ pCtx2aCtx
                       rrmean = [],
                       rrmsg = [],
                       rrviol =
-                        Just . PairView $
-                          PairViewText pos' ("{EX} " <> command <> ";" <> fullName rel <> ";" <> fullName (source rel) <> ";")
-                            NE.:| [ PairViewExp pos' Src (EDcI (source rel)),
-                                    PairViewText pos' $ ";" <> fullName (target rel) <> ";",
-                                    PairViewExp pos' Tgt (EDcI (target rel))
-                                  ],
+                        Just
+                          . PairView
+                          $ PairViewText pos' ("{EX} " <> command <> ";" <> fullName rel <> ";" <> fullName (source rel) <> ";")
+                          NE.:| [ PairViewExp pos' Src (EDcI (source rel)),
+                                  PairViewText pos' $ ";" <> fullName (target rel) <> ";",
+                                  PairViewExp pos' Tgt (EDcI (target rel))
+                                ],
                       rrpat = mPat,
                       rrkind = Enforce
                     }
@@ -1147,7 +1155,7 @@ pCtx2aCtx
       pPurp2aPurp :: ContextInfo -> PPurpose -> Guarded Purpose
       pPurp2aPurp
         ci
-        PRef2
+        PPurpose
           { pos = orig, -- :: Origin
             pexObj = objref, -- :: PRefObj
             pexMarkup = pmarkup, -- :: P_Markup
@@ -1348,7 +1356,7 @@ pDecl2aDecl ::
 pDecl2aDecl typ cptMap maybePatLabel defLanguage defFormat pd =
   do
     checkEndoProps
-    --propLists <- mapM pProp2aProps . Set.toList $ dec_prps pd
+    -- propLists <- mapM pProp2aProps . Set.toList $ dec_prps pd
     dflts <- mapM pReldefault2aReldefaults . L.nub $ dec_defaults pd
     return
       Relation
@@ -1396,9 +1404,9 @@ pDecl2aDecl typ cptMap maybePatLabel defLanguage defFormat pd =
     checkEndoProps :: Guarded ()
     checkEndoProps
       | source decSign == target decSign =
-        pure ()
+          pure ()
       | null xs =
-        pure ()
+          pure ()
       | otherwise = Errors . pure $ mkEndoPropertyError (origin pd) (Set.toList xs)
       where
         xs = Set.filter isEndoProp $ dec_prps pd
@@ -1524,10 +1532,10 @@ instance Functor TT where
   fmap f (MBE a b) = MBE (f a) (f b)
   fmap f (MBG a b) = MBG (f a) (f b)
 
-getAConcept :: HasSignature a => SrcOrTgt -> a -> A_Concept
+getAConcept :: (HasSignature a) => SrcOrTgt -> a -> A_Concept
 getAConcept Src = source
 getAConcept Tgt = target
 
-getConcept :: HasSignature a => SrcOrTgt -> a -> Type
+getConcept :: (HasSignature a) => SrcOrTgt -> a -> Type
 getConcept Src = aConcToType . source
 getConcept Tgt = aConcToType . target
diff --git a/src/Ampersand/ADL1/PrettyPrinters.hs b/src/Ampersand/ADL1/PrettyPrinters.hs
index f5b75e7eb..0fcbc5ec4 100644
--- a/src/Ampersand/ADL1/PrettyPrinters.hs
+++ b/src/Ampersand/ADL1/PrettyPrinters.hs
@@ -14,23 +14,23 @@ import qualified RIO.Text as T
 import qualified RIO.Text.Partial as Partial (replace)
 import Text.PrettyPrint.Leijen
 
-prettyPrint :: Pretty a => a -> Text
+prettyPrint :: (Pretty a) => a -> Text
 prettyPrint x = T.pack $ displayS (renderPretty rfrac col_width doc) ""
   where
     col_width = 120
     rfrac = 0.4
     doc = pretty x
 
-(<~>) :: Pretty b => Doc -> b -> Doc
+(<~>) :: (Pretty b) => Doc -> b -> Doc
 (<~>) a b = a <+> pretty b
 
 (<+\>) :: Doc -> Doc -> Doc
 (<+\>) a b = a <$$> b
 
-(<~\>) :: Pretty b => Doc -> b -> Doc
+(<~\>) :: (Pretty b) => Doc -> b -> Doc
 (<~\>) a b = a <+\> pretty b
 
-perline :: Pretty a => [a] -> Doc
+perline :: (Pretty a) => [a] -> Doc
 perline = vsep . map pretty
 
 quote :: Text -> Doc
@@ -49,24 +49,24 @@ quotePurpose p = text "{+" </> escapeExpl p </> text "+}"
       | T.null needle = fatal "Empty needle."
       | otherwise -- replace is now safe to use, because we have a non-empty needle
         =
-        Partial.replace needle replacement haystack
+          Partial.replace needle replacement haystack
 
-prettyhsep :: Pretty a => [a] -> Doc
+prettyhsep :: (Pretty a) => [a] -> Doc
 prettyhsep = hsep . map pretty
 
 commas :: [Doc] -> Doc
 commas = encloseSep empty empty comma
 
-listOf :: Pretty a => [a] -> Doc
+listOf :: (Pretty a) => [a] -> Doc
 listOf = commas . map pretty
 
 listOfBy :: (a -> Doc) -> [a] -> Doc
 listOfBy fun = commas . map fun
 
-listOf1 :: Pretty a => NE.NonEmpty a -> Doc
+listOf1 :: (Pretty a) => NE.NonEmpty a -> Doc
 listOf1 = listOf . NE.toList
 
-separate :: Pretty a => Text -> [a] -> Doc
+separate :: (Pretty a) => Text -> [a] -> Doc
 separate d xs = encloseSep empty empty ((text . T.unpack) d) $ map pretty xs
 
 instance Pretty Name where
@@ -155,7 +155,7 @@ instance Pretty P_Relation where
 instance Pretty Pragma where
   pretty (Pragma _ l m r) = text "PRAGMA" <+> hsep (map quote [l, m, r])
 
-instance Pretty a => Pretty (Term a) where
+instance (Pretty a) => Pretty (Term a) where
   pretty p = case p of
     Prim a -> pretty a
     -- level 0 (rule)
@@ -220,16 +220,21 @@ instance Pretty SrcOrTgt where
 
 instance Pretty (P_Rule TermPrim) where
   pretty (P_Rule _ nm lbl expr mean msg viol) =
-    text "RULE" <+> pretty nm <+> pretty lbl <+> text ":"
-      <~> expr
-      <+\> perline mean
-      <+\> perline msg
-      <~\> viol
+    text "RULE"
+      <+> pretty nm
+      <+> pretty lbl
+      <+> text ":"
+        <~> expr
+        <+\> perline mean
+        <+\> perline msg
+        <~\> viol
 
 instance Pretty (P_Enforce TermPrim) where
   pretty (P_Enforce _ rel op expr) =
-    text "ENFORCE" <+> pretty rel <+> pretty op
-      <~> expr
+    text "ENFORCE"
+      <+> pretty rel
+      <+> pretty op
+        <~> expr
 
 instance Pretty EnforceOperator where
   pretty op = case op of
@@ -341,11 +346,12 @@ instance Pretty (P_IdentSegmnt TermPrim) where
 instance Pretty P_ViewDef where
   pretty (P_Vd _ nm lbl cpt isDefault html ats) =
     -- improved syntax. Legacy syntax must not be used here anymore.
-    text "VIEW" <~> nm <~> lbl <+> text ":"
-      <~> cpt
+    text "VIEW" <~> nm <~> lbl
+      <+> text ":"
+        <~> cpt
       <+> (if isDefault then text "DEFAULT" else empty)
       <+> braces (listOf ats)
-      <~> html
+        <~> html
       <+> text "ENDVIEW"
 
 instance Pretty ViewHtmlTemplate where
@@ -364,9 +370,10 @@ instance Pretty (P_ViewSegmtPayLoad TermPrim) where
   pretty (P_ViewText txt) = text "TXT" <+> quote txt
 
 instance Pretty PPurpose where
-  pretty (PRef2 _ obj markup refIds) =
-    text "PURPOSE" <~> obj <~> lang <+> refs refIds
-      <+\> quotePurpose (mString markup)
+  pretty (PPurpose _ obj markup refIds) =
+    text "PURPOSE" <~> obj <~> lang
+      <+> refs refIds
+        <+\> quotePurpose (mString markup)
     where
       lang = mFormat markup
       refs rs =
@@ -402,7 +409,8 @@ instance Pretty PClassify where
   pretty p =
     case p of
       PClassify _ spc gen ->
-        text "CLASSIFY" <+> pretty spc
+        text "CLASSIFY"
+          <+> pretty spc
           <+> ( case (NE.length gen, NE.filter (spc /=) gen) of
                   (2, [x]) -> text "ISA" <~> x
                   _ -> text "IS" <+> separate "/\\" (NE.toList gen)
@@ -431,9 +439,11 @@ instance Pretty PRelationDefault where
 
 instance Pretty PAtomPair where
   pretty (PPair _ l r) =
-    text "(" <+> pretty l
-      <~> text "," <+> pretty r
-      <~> text ")"
+    text "("
+      <+> pretty l
+        <~> text ","
+      <+> pretty r
+        <~> text ")"
 
 instance Pretty PAtomValue where
   pretty pav =
diff --git a/src/Ampersand/Core/A2P_Converters.hs b/src/Ampersand/Core/A2P_Converters.hs
index 5aa491218..97aa05af8 100644
--- a/src/Ampersand/Core/A2P_Converters.hs
+++ b/src/Ampersand/Core/A2P_Converters.hs
@@ -128,9 +128,11 @@ aRelDefaults2pRelDefault x = case x of
 
 aProps2Pprops :: AProps -> Set PProp
 aProps2Pprops aps
-  | P_Sym `elem` xs
-      && P_Asy `elem` xs =
-    Set.singleton P_Prop `Set.union` (xs Set.\\ Set.fromList [P_Sym, P_Asy])
+  | P_Sym
+      `elem` xs
+      && P_Asy
+      `elem` xs =
+      Set.singleton P_Prop `Set.union` (xs Set.\\ Set.fromList [P_Sym, P_Asy])
   | otherwise = xs
   where
     xs = Set.map aProp2pProp aps
@@ -234,7 +236,7 @@ aPurpose2pPurpose p =
   if explUserdefd p
     then
       Just
-        PRef2
+        PPurpose
           { pos = explPos p,
             pexObj = aExplObj2PRef2Obj (explObj p),
             pexMarkup = aMarkup2pMarkup (explMarkup p),
@@ -410,12 +412,12 @@ aAtomValue2pAtomValue val =
     HugeBinary -> fatal $ tshow (aavtyp val) <> " cannot be represented in P-structure currently."
     Date -> case val of
       AAVDate {} ->
-        --TODO: Needs rethinking. A string or a double?
+        -- TODO: Needs rethinking. A string or a double?
         ScriptString o (showValADL val)
       _ -> fatal "Unexpected combination of value types"
     DateTime -> case val of
       AAVDateTime {} ->
-        --TODO: Needs rethinking. A string or a double?
+        -- TODO: Needs rethinking. A string or a double?
         ScriptString o (showValADL val)
       _ -> fatal "Unexpected combination of value types"
     Integer -> case val of
@@ -454,8 +456,9 @@ aCruds2pCruds :: Cruds -> P_Cruds
 aCruds2pCruds x =
   P_Cruds
     (crudOrig x)
-    ( toText1Unsafe . T.pack $
-        zipWith (curry f) [crudC x, crudR x, crudU x, crudD x] "crud"
+    ( toText1Unsafe
+        . T.pack
+        $ zipWith (curry f) [crudC x, crudR x, crudU x, crudD x] "crud"
     )
   where
     f :: (Bool, Char) -> Char
diff --git a/src/Ampersand/Core/AbstractSyntaxTree.hs b/src/Ampersand/Core/AbstractSyntaxTree.hs
index 0372ba366..ed0d7af89 100644
--- a/src/Ampersand/Core/AbstractSyntaxTree.hs
+++ b/src/Ampersand/Core/AbstractSyntaxTree.hs
@@ -246,7 +246,7 @@ data AEnforce = AEnforce
   deriving (Eq)
 
 instance Traced AEnforce where
-  origin = pos
+  origin AEnforce {pos = orig} = orig
 
 data AConceptDef = AConceptDef
   { -- | The position of this definition in the text of the Ampersand source (filename, line number and column number).
@@ -267,17 +267,18 @@ instance Named AConceptDef where
   name = acdname
 
 instance Traced AConceptDef where
-  origin = pos
+  origin AConceptDef {pos = orig} = orig
 
 instance Ord AConceptDef where
   compare a b = case compare (name a) (name b) of
     EQ ->
       fromMaybe
-        ( fatal . T.intercalate "\n" $
-            [ "ConceptDef should have a non-fuzzy Origin.",
-              tshow (origin a),
-              tshow (origin b)
-            ]
+        ( fatal
+            . T.intercalate "\n"
+            $ [ "ConceptDef should have a non-fuzzy Origin.",
+                tshow (origin a),
+                tshow (origin b)
+              ]
         )
         (maybeOrdering (origin a) (origin b))
     x -> x
@@ -295,11 +296,12 @@ data A_RoleRule = A_RoleRule
 instance Ord A_RoleRule where
   compare a b =
     fromMaybe
-      ( fatal . T.intercalate "\n" $
-          [ "PPurpose a should have a non-fuzzy Origin.",
-            tshow (origin a),
-            tshow (origin b)
-          ]
+      ( fatal
+          . T.intercalate "\n"
+          $ [ "PPurpose a should have a non-fuzzy Origin.",
+              tshow (origin a),
+              tshow (origin b)
+            ]
       )
       (maybeOrdering (origin a) (origin b))
 
@@ -352,8 +354,11 @@ instance Ord Rule where
 
 instance Show Rule where
   show x =
-    T.unpack $
-      "RULE " <> text1ToText (fullName1 x) <> ": " <> tshow (formalExpression x)
+    T.unpack
+      $ "RULE "
+      <> text1ToText (fullName1 x)
+      <> ": "
+      <> tshow (formalExpression x)
 
 instance Traced Rule where
   origin = rrfps
@@ -660,7 +665,8 @@ instance Show AClassify where
 
 instance Hashable AClassify where
   hashWithSalt s g =
-    s `hashWithSalt` genspc g
+    s
+      `hashWithSalt` genspc g
       `hashWithSalt` ( case g of
                          Isa {} -> [genspc g]
                          IsE {} -> NE.toList . NE.sort $ genrhs g
@@ -753,11 +759,12 @@ instance Ord BoxTxt where
   compare a b = case compare (boxPlainName a, boxtxt a) (boxPlainName b, boxtxt b) of
     EQ ->
       fromMaybe
-        ( fatal . T.intercalate "\n" $
-            [ "BoxTxt should have a non-fuzzy Origin.",
-              tshow (origin a),
-              tshow (origin b)
-            ]
+        ( fatal
+            . T.intercalate "\n"
+            $ [ "BoxTxt should have a non-fuzzy Origin.",
+                tshow (origin a),
+                tshow (origin b)
+              ]
         )
         (maybeOrdering (origin a) (origin b))
     x -> x
@@ -792,11 +799,12 @@ instance Ord ObjectDef where
   compare a b = case compare (objPlainName a) (objPlainName b) of
     EQ ->
       fromMaybe
-        ( fatal . T.intercalate "\n" $
-            [ "ObjectDef should have a non-fuzzy Origin.",
-              tshow (origin a),
-              tshow (origin b)
-            ]
+        ( fatal
+            . T.intercalate "\n"
+            $ [ "ObjectDef should have a non-fuzzy Origin.",
+                tshow (origin a),
+                tshow (origin b)
+              ]
         )
         (maybeOrdering (origin a) (origin b))
     x -> x
@@ -826,7 +834,7 @@ data SubInterface
   | InterfaceRef
       { pos :: !Origin,
         siIsLink :: !Bool,
-        siIfcId :: !Name --id of the interface that is referenced to
+        siIfcId :: !Name -- id of the interface that is referenced to
       }
   deriving (Show)
 
@@ -846,18 +854,19 @@ data Purpose = Expl
   }
   deriving (Show, Typeable)
 
---instance Eq Purpose where
+-- instance Eq Purpose where
 --  a == b = compare a b == EQ
 
 instance Ord Purpose where
   compare a b = case compare (explObj a) (explObj b) of
     EQ ->
       fromMaybe
-        ( fatal . T.intercalate "\n" $
-            [ "Purpose should have a non-fuzzy Origin.",
-              tshow (origin a),
-              tshow (origin b)
-            ]
+        ( fatal
+            . T.intercalate "\n"
+            $ [ "Purpose should have a non-fuzzy Origin.",
+                tshow (origin a),
+                tshow (origin b)
+              ]
         )
         (maybeOrdering (origin a) (origin b))
     x -> x
@@ -963,13 +972,13 @@ showValSQL val =
           Nothing -> mempty
           Just (h, tl)
             | h `elem` ['\'', '\\'] ->
-              T.cons h (T.cons h (f tl))
+                T.cons h (T.cons h (f tl))
             | otherwise -> T.cons h (f tl)
     AAVInteger {} -> tshow (aavint val)
     AAVBoolean {} -> tshow (aavbool val)
     AAVDate {} -> singleQuote . T.pack $ showGregorian (aadateDay val)
-    AAVDateTime {} -> singleQuote . T.pack $ formatTime defaultTimeLocale "%F %T" (aadatetime val) --NOTE: MySQL 5.5 does not comply to ISO standard. This format is MySQL specific
-    --formatTime SL.defaultTimeLocale "%FT%T%QZ" (aadatetime val)
+    AAVDateTime {} -> singleQuote . T.pack $ formatTime defaultTimeLocale "%F %T" (aadatetime val) -- NOTE: MySQL 5.5 does not comply to ISO standard. This format is MySQL specific
+    -- formatTime SL.defaultTimeLocale "%FT%T%QZ" (aadatetime val)
     AAVFloat {} -> tshow (aavflt val)
     AtomValueOfONE {} -> "1"
 
@@ -1233,7 +1242,7 @@ instance HasSignature Expression where
   sign (EDcV sgn) = sgn
   sign (EMp1 _ c) = Sign c c
 
-showSign :: HasSignature a => a -> Text1
+showSign :: (HasSignature a) => a -> Text1
 showSign x = Text1 '[' $ fullName s <> "*" <> fullName t <> "]"
   where
     Sign s t = sign x
@@ -1253,7 +1262,7 @@ getExpressionRelation expr = case getRelation expr of
     getRelation (ECps (e, EDcI {})) = getRelation e
     getRelation (ECps (EDcI {}, e)) = getRelation e
     getRelation (ECps (e1, e2)) =
-      case (getRelation e1, getRelation e2) of --note: target e1==source e2
+      case (getRelation e1, getRelation e2) of -- note: target e1==source e2
         (Just (_, Nothing, i1, _), Just (i2, Nothing, _, _))
           | i1 == target e1 && i2 == source e2 -> Just (i1, Nothing, i2, False)
           | i1 == target e1 && i2 /= source e2 -> Just (i2, Nothing, i2, False)
@@ -1331,7 +1340,7 @@ instance Show A_Concept where
 -- | special type of Show, for types that can have aliases. Its purpose is
 --   to use when giving feedback to the ampersand modeler, in cases aliases
 --   are used.
-class Show a => ShowWithAliases a where
+class (Show a) => ShowWithAliases a where
   showWithAliases :: a -> Text1
 
 instance ShowWithAliases A_Concept where
@@ -1453,22 +1462,23 @@ safePSingleton2AAtomVal :: ContextInfo -> A_Concept -> PAtomValue -> AAtomValue
 safePSingleton2AAtomVal ci c val =
   case unsafePAtomVal2AtomValue typ (Just c) val of
     Left _ ->
-      fatal . T.intercalate "\n  " $
-        [ "This should be impossible: after checking everything an unhandled singleton value found!",
-          "Concept: " <> tshow c,
-          "TType: " <> tshow typ,
-          "Origin: " <> tshow (origin val),
-          "PAtomValue: " <> case val of
-            (PSingleton _ _ v) -> "PSingleton (" <> tshow v <> ")"
-            (ScriptString _ v) -> "ScriptString (" <> tshow v <> ")"
-            (XlsxString _ v) -> "XlsxString (" <> tshow v <> ")"
-            (ScriptInt _ v) -> "ScriptInt (" <> tshow v <> ")"
-            (ScriptFloat _ v) -> "ScriptFloat (" <> tshow v <> ")"
-            (XlsxDouble _ v) -> "XlsxDouble (" <> tshow v <> ")"
-            (ComnBool _ v) -> "ComnBool (" <> tshow v <> ")"
-            (ScriptDate _ v) -> "ScriptDate (" <> tshow v <> ")"
-            (ScriptDateTime _ v) -> "ScriptDateTime (" <> tshow v <> ")"
-        ]
+      fatal
+        . T.intercalate "\n  "
+        $ [ "This should be impossible: after checking everything an unhandled singleton value found!",
+            "Concept: " <> tshow c,
+            "TType: " <> tshow typ,
+            "Origin: " <> tshow (origin val),
+            "PAtomValue: " <> case val of
+              (PSingleton _ _ v) -> "PSingleton (" <> tshow v <> ")"
+              (ScriptString _ v) -> "ScriptString (" <> tshow v <> ")"
+              (XlsxString _ v) -> "XlsxString (" <> tshow v <> ")"
+              (ScriptInt _ v) -> "ScriptInt (" <> tshow v <> ")"
+              (ScriptFloat _ v) -> "ScriptFloat (" <> tshow v <> ")"
+              (XlsxDouble _ v) -> "XlsxDouble (" <> tshow v <> ")"
+              (ComnBool _ v) -> "ComnBool (" <> tshow v <> ")"
+              (ScriptDate _ v) -> "ScriptDate (" <> tshow v <> ")"
+              (ScriptDateTime _ v) -> "ScriptDateTime (" <> tshow v <> ")"
+          ]
     Right x -> x
   where
     typ = representationOf ci c
@@ -1662,16 +1672,16 @@ unsafePAtomVal2AtomValue typ mCpt pav =
                   Nothing -> True
                   Just ('.', afterDot) -> T.all (== '0') afterDot
                   _ -> False
-        message :: Show x => Origin -> x -> Text
+        message :: (Show x) => Origin -> x -> Text
         message orig x =
-          T.intercalate "\n    " $
-            [ "Representation mismatch",
-              "Found: `" <> tshow x <> "` (" <> tshow orig <> "),",
-              "as representation of an atom in concept `" <> text1ToText (fullName1 c) <> "`.",
-              "However, the representation-type of that concept is " <> implicitly,
-              "defined as " <> tshow typ <> ". The found value does not match that type."
-            ]
-              <> example
+          T.intercalate "\n    "
+            $ [ "Representation mismatch",
+                "Found: `" <> tshow x <> "` (" <> tshow orig <> "),",
+                "as representation of an atom in concept `" <> text1ToText (fullName1 c) <> "`.",
+                "However, the representation-type of that concept is " <> implicitly,
+                "defined as " <> tshow typ <> ". The found value does not match that type."
+              ]
+            <> example
           where
             c = fromMaybe (fatal "Representation mismatch without concept known should not happen.") mCpt
             implicitly = if typ == Object then "(implicitly) " else ""
diff --git a/src/Ampersand/Core/ParseTree.hs b/src/Ampersand/Core/ParseTree.hs
index 459b0fb6d..ddc00ef9e 100644
--- a/src/Ampersand/Core/ParseTree.hs
+++ b/src/Ampersand/Core/ParseTree.hs
@@ -119,7 +119,7 @@ data P_Context = PCtx
     -- | The Enforce statements defined in this context, outside the scope of patterns
     ctx_enfs :: ![P_Enforce TermPrim]
   }
-  deriving (Show) --for QuickCheck
+  deriving (Show) -- for QuickCheck
 
 instance Eq P_Context where
   c1 == c2 = name c1 == name c2
@@ -139,7 +139,7 @@ data MetaData = MetaData
   deriving (Show)
 
 instance Traced MetaData where
-  origin = pos
+  origin (MetaData p _ _) = p
 
 data EnforceOperator
   = IsSuperSet !Origin
@@ -161,7 +161,8 @@ instance Foldable P_Enforce where foldMap = foldMapDefault
 
 instance Traversable P_Enforce where
   traverse f (P_Enforce orig rel op expr) =
-    (\r e -> P_Enforce orig r op e) <$> f rel
+    (\r e -> P_Enforce orig r op e)
+      <$> f rel
       <*> traverse f expr
 
 -- | A RoleRule r means that a role called 'mRoles r' must maintain the process rule called 'mRules r'
@@ -176,7 +177,7 @@ data P_RoleRule = Maintain
   deriving (Show) -- deriving (Show) is just for debugging
 
 instance Traced P_RoleRule where
-  origin = pos
+  origin (Maintain {pos = orig}) = orig
 
 data Role = Role
   { pos :: !Origin,
@@ -238,11 +239,12 @@ instance Ord P_Pattern where
   compare a b = case compare (name a) (name b) of
     EQ ->
       fromMaybe
-        ( fatal . T.intercalate "\n" $
-            [ "P_Pattern should have a non-fuzzy Origin.",
-              tshow (origin a),
-              tshow (origin b)
-            ]
+        ( fatal
+            . T.intercalate "\n"
+            $ [ "P_Pattern should have a non-fuzzy Origin.",
+                tshow (origin a),
+                tshow (origin b)
+              ]
         )
         (maybeOrdering (origin a) (origin b))
     x -> x
@@ -257,7 +259,7 @@ instance Labeled P_Pattern where
   mLabel = pt_lbl
 
 instance Traced P_Pattern where
-  origin = pos
+  origin P_Pat {pos = p} = p
 
 data PConceptDef = PConceptDef
   { -- | The position of this definition in the text of the Ampersand source (filename, line number and column number).
@@ -289,11 +291,12 @@ instance Ord PConceptDef where
   compare a b = case compare (name a) (name b) of
     EQ ->
       fromMaybe
-        ( fatal . T.intercalate "\n" $
-            [ "ConceptDef should have a non-fuzzy Origin.",
-              tshow (origin a),
-              tshow (origin b)
-            ]
+        ( fatal
+            . T.intercalate "\n"
+            $ [ "ConceptDef should have a non-fuzzy Origin.",
+                tshow (origin a),
+                tshow (origin b)
+              ]
         )
         (maybeOrdering (origin a) (origin b))
     x -> x
@@ -307,7 +310,7 @@ instance Unique PConceptDef where
       x = origin cd
 
 instance Traced PConceptDef where
-  origin = pos
+  origin PConceptDef {pos = p} = p
 
 instance Named PConceptDef where
   name = cdname
@@ -340,7 +343,7 @@ data Representation = Repr
   deriving (Show)
 
 instance Traced Representation where
-  origin = pos
+  origin Repr {pos = orig} = orig
 
 data TType
   = Alphanumeric
@@ -356,7 +359,7 @@ data TType
   | Integer
   | Float
   | Object
-  | TypeOfOne --special type for the special concept ONE.
+  | TypeOfOne -- special type for the special concept ONE.
   deriving (Eq, Ord, Data, Typeable, Enum, Bounded)
 
 instance Unique TType where
@@ -402,7 +405,7 @@ data P_Relation = P_Relation
     -- | the position in the Ampersand source file where this relation is declared. Not all relations come from the ampersand souce file.
     pos :: !Origin
   }
-  deriving (Show) --For QuickCheck error messages only!
+  deriving (Show) -- For QuickCheck error messages only!
 
 -- | Pragma, used in relations. E.g. if pragma consists of the three strings: "Person ", " is married to person ", and " in Vegas."
 --  then a tuple ("Peter","Jane") in the list of links means that Person Peter is married to person Jane in Vegas.
@@ -415,7 +418,7 @@ data Pragma = Pragma
   deriving (Show, Data, Eq)
 
 instance Traced Pragma where
-  origin = pos
+  origin Pragma {pos = orig} = orig
 
 -- | Equality on P_Relation
 --   Normally, equality on relations means equality of both name (dec_nm) and signature (dec_sign).
@@ -431,7 +434,7 @@ instance Named P_Relation where
   name = dec_nm
 
 instance Traced P_Relation where
-  origin = pos
+  origin P_Relation {pos = orig} = orig
 
 -- | The union of relations requires the conservation of properties of relations, so it is called 'merge' rather than 'union'.
 --   Relations with the same signature are merged. Relations with different signatures are left alone.
@@ -472,7 +475,7 @@ instance Eq PAtomPair where
   a == b = compare a b == EQ
 
 instance Traced PAtomPair where
-  origin = pos
+  origin PPair {pos = orig} = orig
 
 instance Flippable PAtomPair where
   flp pr =
@@ -580,7 +583,7 @@ data TermPrim
     --   At parse time, there may be zero, one or two elements in the list of concepts.
     Pfull Origin P_Concept P_Concept
   | PNamedR P_NamedRel
-  deriving (Show) --For QuickCheck error messages only!
+  deriving (Show) -- For QuickCheck error messages only!
 
 data P_NamedRel = PNamedRel
   { pos :: !Origin,
@@ -667,7 +670,8 @@ instance Traversable P_SubIfc where
   traverse f (P_Box o c lst) = P_Box o c <$> traverse (traverse f) lst
 
 instance Traced (P_SubIfc a) where
-  origin = pos
+  origin P_Box {pos = orig} = orig
+  origin P_InterfaceRef {pos = orig} = orig
 
 instance Functor P_BoxItem where fmap = fmapDefault
 
@@ -695,7 +699,7 @@ instance Traced P_NamedRel where
 instance Named P_NamedRel where
   name (PNamedRel _ nm _) = nm
 
-instance Traced a => Traced (Term a) where
+instance (Traced a) => Traced (Term a) where
   origin e = case e of
     Prim a -> origin a
     PEqu orig _ _ -> orig
@@ -725,9 +729,9 @@ instance Flippable SrcOrTgt where
 
 newtype PairView a = PairView {ppv_segs :: NE.NonEmpty (PairViewSegment a)} deriving (Show, Typeable, Eq, Generic)
 
-instance Hashable a => Hashable (PairView a)
+instance (Hashable a) => Hashable (PairView a)
 
-instance Traced a => Traced (PairView a) where
+instance (Traced a) => Traced (PairView a) where
   origin = origin . NE.head . ppv_segs
 
 data PairViewSegment a
@@ -748,18 +752,20 @@ instance Eq (PairViewSegment a) where
 instance Ord (PairViewSegment a) where
   compare a b =
     fromMaybe
-      ( fatal . T.intercalate "\n" $
-          [ "P_Rule a should have a non-fuzzy Origin.",
-            tshow (origin a),
-            tshow (origin b)
-          ]
+      ( fatal
+          . T.intercalate "\n"
+          $ [ "P_Rule a should have a non-fuzzy Origin.",
+              tshow (origin a),
+              tshow (origin b)
+            ]
       )
       (maybeOrdering (origin a) (origin b))
 
-instance Hashable a => Hashable (PairViewSegment a)
+instance (Hashable a) => Hashable (PairViewSegment a)
 
 instance Traced (PairViewSegment a) where
-  origin = pos
+  origin PairViewText {pos = orig} = orig
+  origin PairViewExp {pos = orig} = orig
 
 -- | the newtype to make it possible for a PairView to be disambiguatable: it must be of the form "d a" instead of "d (Term a)"
 newtype PairViewTerm a = PairViewTerm (PairView (Term a))
@@ -817,20 +823,21 @@ instance Ord (P_Rule a) where
   compare a b = case compare (name a) (name b) of
     EQ ->
       fromMaybe
-        ( fatal . T.intercalate "\n" $
-            [ "P_Rule a should have a non-fuzzy Origin.",
-              tshow (origin a),
-              tshow (origin b)
-            ]
+        ( fatal
+            . T.intercalate "\n"
+            $ [ "P_Rule a should have a non-fuzzy Origin.",
+                tshow (origin a),
+                tshow (origin b)
+              ]
         )
         (maybeOrdering (origin a) (origin b))
     x -> x
 
-instance Eq (P_Rule a) where --Required for merge of P_Contexts
+instance Eq (P_Rule a) where -- Required for merge of P_Contexts
   a == b = compare a b == EQ
 
 instance Traced (P_Rule a) where
-  origin = pos
+  origin P_Rule {pos = orig} = orig
 
 instance Functor P_Rule where fmap = fmapDefault
 
@@ -869,15 +876,16 @@ data P_Population
         p_cpt :: P_Concept, -- the concept the population belongs to
         p_popas :: [PAtomValue] -- atoms in the initial population of that concept
       }
-  deriving (Show) --For QuickCheck error messages only!
-  --NOTE :: Do NOT make instance Eq P_Population, for this is causing problems with merging.
+  deriving (Show) -- For QuickCheck error messages only!
+  -- NOTE :: Do NOT make instance Eq P_Population, for this is causing problems with merging.
 
 instance Named P_Population where
   name P_RelPopu {p_nmdr = rel} = name rel
   name P_CptPopu {p_cpt = cpt} = name cpt
 
 instance Traced P_Population where
-  origin = pos
+  origin P_RelPopu {pos = orig} = orig
+  origin P_CptPopu {pos = orig} = orig
 
 data P_Interface = P_Ifc
   { -- | The interface is of type API
@@ -892,17 +900,18 @@ data P_Interface = P_Ifc
     pos :: !Origin,
     ifc_Prp :: !Text
   }
-  deriving (Show) --For QuickCheck error messages only!
+  deriving (Show) -- For QuickCheck error messages only!
 
-instance Ord P_Interface where --Required for merge of P_Contexts
+instance Ord P_Interface where -- Required for merge of P_Contexts
   compare a b = case compare (name a) (name b) of
     EQ ->
       fromMaybe
-        ( fatal . T.intercalate "\n" $
-            [ "P_Interface should have a non-fuzzy Origin.",
-              tshow (origin a),
-              tshow (origin b)
-            ]
+        ( fatal
+            . T.intercalate "\n"
+            $ [ "P_Interface should have a non-fuzzy Origin.",
+                tshow (origin a),
+                tshow (origin b)
+              ]
         )
         (maybeOrdering (origin a) (origin b))
     x -> x
@@ -917,7 +926,7 @@ instance Labeled P_Interface where
   mLabel = ifc_lbl
 
 instance Traced P_Interface where
-  origin = pos
+  origin P_Ifc {pos = orig} = orig
 
 type P_SubInterface = P_SubIfc TermPrim
 
@@ -929,7 +938,7 @@ data P_SubIfc a
       }
   | P_InterfaceRef
       { pos :: !Origin,
-        si_isLink :: !Bool, --True iff LINKTO is used. (will display as hyperlink)
+        si_isLink :: !Bool, -- True iff LINKTO is used. (will display as hyperlink)
         si_str :: !Name -- Name of the interface that is reffered to
       }
   deriving (Show)
@@ -945,7 +954,7 @@ data BoxHeader = BoxHeader
   deriving (Show, Data)
 
 instance Traced BoxHeader where
-  origin = pos
+  origin BoxHeader {pos = orig} = orig
 
 data TemplateKeyValue = TemplateKeyValue
   { pos :: !Origin,
@@ -957,7 +966,7 @@ data TemplateKeyValue = TemplateKeyValue
   deriving (Show, Data)
 
 instance Traced TemplateKeyValue where
-  origin = pos
+  origin TemplateKeyValue {pos = orig} = orig
 
 type P_BoxBodyElement = P_BoxItem TermPrim
 
@@ -991,11 +1000,12 @@ data P_BoxItem a
 instance Ord (P_BoxItem a) where
   compare a b =
     fromMaybe
-      ( fatal . T.intercalate "\n" $
-          [ "P_BoxItem a should have a non-fuzzy Origin.",
-            tshow (origin a),
-            tshow (origin b)
-          ]
+      ( fatal
+          . T.intercalate "\n"
+          $ [ "P_BoxItem a should have a non-fuzzy Origin.",
+              tshow (origin a),
+              tshow (origin b)
+            ]
       )
       (maybeOrdering (origin a) (origin b))
 
@@ -1003,7 +1013,8 @@ instance Eq (P_BoxItem a) where
   a == b = compare a b == EQ
 
 instance Traced (P_BoxItem a) where
-  origin = pos
+  origin P_BoxItemTerm {pos = orig} = orig
+  origin P_BxTxt {pos = orig} = orig
 
 data P_Cruds = P_Cruds Origin Text1 deriving (Show)
 
@@ -1030,11 +1041,12 @@ instance Named (P_IdentDf a) where
 instance Ord (P_IdentDf a) where
   compare a b =
     fromMaybe
-      ( fatal . T.intercalate "\n" $
-          [ "P_IdentDf a should have a non-fuzzy Origin.",
-            tshow (origin a),
-            tshow (origin b)
-          ]
+      ( fatal
+          . T.intercalate "\n"
+          $ [ "P_IdentDf a should have a non-fuzzy Origin.",
+              tshow (origin a),
+              tshow (origin b)
+            ]
       )
       (maybeOrdering (origin a) (origin b))
 
@@ -1042,7 +1054,7 @@ instance Eq (P_IdentDf a) where
   a == b = compare a b == EQ
 
 instance Traced (P_IdentDf a) where
-  origin = pos
+  origin P_Id {pos = orig} = orig
 
 instance Functor P_IdentDf where fmap = fmapDefault
 
@@ -1088,20 +1100,21 @@ instance Ord (P_ViewD a) where
   compare a b = case compare (name a) (name b) of
     EQ ->
       fromMaybe
-        ( fatal . T.intercalate "\n" $
-            [ "P_ViewD a should have a non-fuzzy Origin.",
-              tshow (origin a),
-              tshow (origin b)
-            ]
+        ( fatal
+            . T.intercalate "\n"
+            $ [ "P_ViewD a should have a non-fuzzy Origin.",
+                tshow (origin a),
+                tshow (origin b)
+              ]
         )
         (maybeOrdering (origin a) (origin b))
     x -> x
 
-instance Eq (P_ViewD a) where --Required for merge of P_Contexts
+instance Eq (P_ViewD a) where -- Required for merge of P_Contexts
   a == b = compare a b == EQ
 
 instance Traced (P_ViewD a) where
-  origin = pos
+  origin P_Vd {pos = orig} = orig
 
 instance Named (P_ViewD a) where
   name = vd_nm
@@ -1121,7 +1134,7 @@ data P_ViewSegment a = P_ViewSegment
   deriving (Show)
 
 instance Traced (P_ViewSegment a) where
-  origin = pos
+  origin P_ViewSegment {pos = orig} = orig
 
 instance Functor P_ViewSegment where fmap = fmapDefault
 
@@ -1171,7 +1184,7 @@ data PRef2Obj
 --     PRef2Interface str -> str
 --     PRef2Context str -> str
 
-data PPurpose = PRef2
+data PPurpose = PPurpose
   { pos :: Origin, -- the position in the Ampersand script of this purpose definition
     pexObj :: PRef2Obj, -- the reference to the object whose purpose is explained
     pexMarkup :: P_Markup, -- the piece of text, including markup and language info
@@ -1179,7 +1192,7 @@ data PPurpose = PRef2
   }
   deriving (Show)
 
-instance Ord PPurpose where --Required for merge of P_Contexts
+instance Ord PPurpose where -- Required for merge of P_Contexts
   compare a b = case compare (pexObj a) (pexObj b) of
     EQ -> case (origin a, origin b) of
       (OriginUnknown, OriginUnknown) -> compare (pexRefIDs a) (pexRefIDs b)
@@ -1187,20 +1200,21 @@ instance Ord PPurpose where --Required for merge of P_Contexts
       (_, OriginUnknown) -> GT
       (_, _) ->
         fromMaybe
-          ( fatal . T.intercalate "\n" $
-              [ "PPurpose a should have a non-fuzzy Origin.",
-                tshow (origin a),
-                tshow (origin b)
-              ]
+          ( fatal
+              . T.intercalate "\n"
+              $ [ "PPurpose a should have a non-fuzzy Origin.",
+                  tshow (origin a),
+                  tshow (origin b)
+                ]
           )
           (maybeOrdering (origin a) (origin b))
     x -> x
 
-instance Eq PPurpose where --Required for merge of P_Contexts
+instance Eq PPurpose where -- Required for merge of P_Contexts
   a == b = compare a b == EQ
 
 instance Traced PPurpose where
-  origin = pos
+  origin PPurpose {pos = orig} = orig
 
 data P_Concept
   = -- | The name of this Concept
@@ -1263,7 +1277,7 @@ instance Eq PClassify where
   p == q = specific p == specific q && generics p == generics q
 
 instance Traced PClassify where
-  origin = pos
+  origin PClassify {pos = orig} = orig
 
 type PProps = Set PProp
 
@@ -1350,7 +1364,7 @@ mergeContexts ctx1 ctx2 =
     fromContextsKeepDoubles :: (P_Context -> [a]) -> [a]
     fromContextsKeepDoubles fun = concatMap fun contexts
     contexts = [ctx1, ctx2]
-    fromContextsRemoveDoubles :: Ord b => (P_Context -> [b]) -> [b]
+    fromContextsRemoveDoubles :: (Ord b) => (P_Context -> [b]) -> [b]
     fromContextsRemoveDoubles f =
       Set.toList . Set.unions . map (Set.fromList . f) $ contexts
     mergePops :: [P_Population] -> [P_Population]
@@ -1360,16 +1374,20 @@ mergeContexts ctx1 ctx2 =
         groupCondition a b =
           case (a, b) of
             (P_RelPopu {}, P_RelPopu {}) ->
-              p_src a == p_src b
-                && p_tgt a == p_tgt b
+              p_src a
+                == p_src b
+                && p_tgt a
+                == p_tgt b
                 && sameNamedRels (p_nmdr a) (p_nmdr b)
             (P_CptPopu {}, P_CptPopu {}) -> p_cpt a == p_cpt b
             _ -> False
           where
             sameNamedRels :: P_NamedRel -> P_NamedRel -> Bool
             sameNamedRels x y =
-              p_nrnm x == p_nrnm y
-                && p_mbSign x == p_mbSign y
+              p_nrnm x
+                == p_nrnm y
+                && p_mbSign x
+                == p_mbSign y
         mergePopsSameType :: NE.NonEmpty P_Population -> P_Population
         mergePopsSameType (h :| tl) = case h of
           P_RelPopu {} -> h {p_popps = Set.toList . Set.unions . map (Set.fromList . p_popps) $ (h : tl)}
diff --git a/src/Ampersand/FSpec/ShowHS.hs b/src/Ampersand/FSpec/ShowHS.hs
index 812d59cf9..60f2fa375 100644
--- a/src/Ampersand/FSpec/ShowHS.hs
+++ b/src/Ampersand/FSpec/ShowHS.hs
@@ -56,20 +56,20 @@ class ShowHSName a where
 class ShowHS a where
   showHS :: (HasFSpecGenOpts env) => env -> Text -> a -> Text
 
-instance ShowHSName a => ShowHSName [a] where
+instance (ShowHSName a) => ShowHSName [a] where
   showHSName xs = "[" <> T.intercalate ", " (map showHSName xs) <> "]"
 
-instance ShowHS a => ShowHS [a] where
+instance (ShowHS a) => ShowHS [a] where
   showHS env indent = wrap "" (indent <> " ") (showHS env)
 
-instance ShowHS a => ShowHS (NE.NonEmpty a) where
+instance (ShowHS a) => ShowHS (NE.NonEmpty a) where
   showHS env indent = wrap "" (indent <> " ") (showHS env) . NE.toList
 
-instance ShowHSName a => ShowHSName (Maybe a) where
+instance (ShowHSName a) => ShowHSName (Maybe a) where
   showHSName Nothing = "Nothing"
   showHSName (Just x) = showHSName x
 
-instance ShowHS a => ShowHS (Maybe a) where
+instance (ShowHS a) => ShowHS (Maybe a) where
   showHS _ _ Nothing = "Nothing"
   showHS env indent (Just x) = "Just (" <> showHS env indent x <> ")"
 
@@ -289,14 +289,18 @@ instance ShowHS FSpec where
       ( if null (interfaceS fSpec)
           then ""
           else
-            "\n -- *** User defined interfaces (total: " <> (tshow . length . interfaceS) fSpec <> " interfaces) ***: "
+            "\n -- *** User defined interfaces (total: "
+              <> (tshow . length . interfaceS) fSpec
+              <> " interfaces) ***: "
               <> T.concat [indent <> " " <> showHSName s <> indent <> "  = " <> showHS env (indent <> "    ") s | s <- interfaceS fSpec]
               <> "\n"
       )
       <> ( if null (interfaceG fSpec)
              then ""
              else
-               "\n -- *** Generated interfaces (total: " <> (tshow . length . interfaceG) fSpec <> " interfaces) ***: "
+               "\n -- *** Generated interfaces (total: "
+                 <> (tshow . length . interfaceG) fSpec
+                 <> " interfaces) ***: "
                  <> T.concat [indent <> " " <> showHSName x <> indent <> "  = " <> showHS env (indent <> "    ") x | x <- interfaceG fSpec]
                  <> "\n"
          )
@@ -304,63 +308,81 @@ instance ShowHS FSpec where
             in if null ds
                  then ""
                  else
-                   "\n -- *** Declared relations (in total: " <> (tshow . length) ds <> " relations) ***: "
+                   "\n -- *** Declared relations (in total: "
+                     <> (tshow . length) ds
+                     <> " relations) ***: "
                      <> T.concat [indent <> " " <> showHSName x <> indent <> "  = " <> showHS env (indent <> "    ") x | x <- toList ds]
                      <> "\n"
          )
       <> ( if null (vIndices fSpec)
              then ""
              else
-               "\n -- *** Indices (total: " <> (tshow . length . vIndices) fSpec <> " indices) ***: "
+               "\n -- *** Indices (total: "
+                 <> (tshow . length . vIndices) fSpec
+                 <> " indices) ***: "
                  <> T.concat [indent <> " " <> showHSName x <> indent <> "  = " <> showHS env (indent <> "    ") x | x <- vIndices fSpec]
                  <> "\n"
          )
       <> ( if null (vviews fSpec)
              then ""
              else
-               "\n -- *** Views (total: " <> (tshow . length . vviews) fSpec <> " views) ***: "
+               "\n -- *** Views (total: "
+                 <> (tshow . length . vviews) fSpec
+                 <> " views) ***: "
                  <> T.concat [indent <> " " <> showHSName x <> indent <> "  = " <> showHS env (indent <> "    ") x | x <- vviews fSpec]
                  <> "\n"
          )
       <> ( if null (vrules fSpec)
              then ""
              else
-               "\n -- *** User defined rules (total: " <> (tshow . length . vrules) fSpec <> " rules) ***: "
+               "\n -- *** User defined rules (total: "
+                 <> (tshow . length . vrules) fSpec
+                 <> " rules) ***: "
                  <> T.concat [indent <> " " <> showHSName x <> indent <> "  = " <> showHS env (indent <> "    ") x | x <- toList $ vrules fSpec]
                  <> "\n"
          )
       <> ( if null (grules fSpec)
              then ""
              else
-               "\n -- *** Generated rules (total: " <> (tshow . length . grules) fSpec <> " rules) ***: "
+               "\n -- *** Generated rules (total: "
+                 <> (tshow . length . grules) fSpec
+                 <> " rules) ***: "
                  <> T.concat [indent <> " " <> showHSName x <> indent <> "  = " <> showHS env (indent <> "    ") x | x <- toList $ grules fSpec]
                  <> "\n"
          )
       <> ( if null (allConjuncts fSpec)
              then ""
              else
-               "\n -- *** Conjuncts (total: " <> (tshow . length . allConjuncts) fSpec <> " conjuncts) ***: "
+               "\n -- *** Conjuncts (total: "
+                 <> (tshow . length . allConjuncts) fSpec
+                 <> " conjuncts) ***: "
                  <> T.concat [indent <> " " <> showHSName x <> indent <> "  = " <> showHS env (indent <> "    ") x | x <- allConjuncts fSpec]
                  <> "\n"
          )
       <> ( if null (vquads fSpec)
              then ""
              else
-               "\n -- *** Quads (total: " <> (tshow . length . vquads) fSpec <> " quads) ***: "
+               "\n -- *** Quads (total: "
+                 <> (tshow . length . vquads) fSpec
+                 <> " quads) ***: "
                  <> T.concat [indent <> " " <> showHSName x <> indent <> "  = " <> showHS env (indent <> "    ") x | x <- vquads fSpec]
                  <> "\n"
          )
       <> ( if null (plugInfos fSpec)
              then ""
              else
-               "\n -- *** PlugInfos (total: " <> (tshow . length . plugInfos) fSpec <> " plugInfos) ***: "
+               "\n -- *** PlugInfos (total: "
+                 <> (tshow . length . plugInfos) fSpec
+                 <> " plugInfos) ***: "
                  <> T.concat [indent <> " " <> showHSName p <> indent <> "  = " <> showHS env (indent <> "    ") p | InternalPlug p <- L.sortBy (compare `on` showUnique) (plugInfos fSpec)]
                  <> "\n"
          )
       <> ( if null (instanceList fSpec :: [Pattern])
              then ""
              else
-               "\n -- *** Patterns (total: " <> (tshow . length $ (instanceList fSpec :: [Pattern])) <> " patterns) ***: "
+               "\n -- *** Patterns (total: "
+                 <> (tshow . length $ (instanceList fSpec :: [Pattern]))
+                 <> " patterns) ***: "
                  <> T.concat [indent <> " " <> showHSName x <> indent <> "  = " <> showHS env (indent <> "    ") x | x <- vpatterns fSpec]
                  <> "\n"
          )
@@ -372,9 +394,16 @@ instance ShowHS FSpec where
       ( if null (allConcepts fSpec)
           then ""
           else
-            "\n -- *** Concepts (total: " <> (tshow . length . allConcepts) fSpec <> " concepts) ***: "
+            "\n -- *** Concepts (total: "
+              <> (tshow . length . allConcepts) fSpec
+              <> " concepts) ***: "
               <> T.concat
-                [ indent <> " " <> showHSName x <> indent <> "  = " <> showHS env (indent <> "    ") x
+                [ indent
+                    <> " "
+                    <> showHSName x
+                    <> indent
+                    <> "  = "
+                    <> showHS env (indent <> "    ") x
                     <> indent
                     <> "    "
                     <> showAtomsOfConcept x
@@ -399,7 +428,8 @@ instance ShowHS FSpec where
       showViolatedRule indent' (r, ps) =
         T.intercalate
           indent'
-          [ " ( " <> showHSName r
+          [ " ( "
+              <> showHSName r
               <> indent'
               <> " , "
               <> wrap
@@ -464,7 +494,9 @@ instance ShowHS Pattern where
 
 instance ShowHS PPurpose where
   showHS env _ expl =
-    "PRef2 (" <> showHS env "" (origin expl) <> ") "
+    "PPurpose ("
+      <> showHS env "" (origin expl)
+      <> ") "
       <> "("
       <> showHS env "" (pexObj expl)
       <> ") "
@@ -488,7 +520,10 @@ instance ShowHS PRef2Obj where
 
 instance ShowHS Purpose where
   showHS env _ expla =
-    "Expl " <> "(" <> showHS env "" (explPos expla) <> ") "
+    "Expl "
+      <> "("
+      <> showHS env "" (explPos expla)
+      <> ") "
       <> "("
       <> showHS env "" (explObj expla)
       <> ") "
@@ -566,7 +601,13 @@ instance ShowHSName IdentityRule where
 
 instance ShowHS IdentityRule where
   showHS env indent identity =
-    "Id (" <> showHS env "" (idPos identity) <> ") " <> tshow (idName identity) <> " (" <> showHSName (idCpt identity) <> ")"
+    "Id ("
+      <> showHS env "" (idPos identity)
+      <> ") "
+      <> tshow (idName identity)
+      <> " ("
+      <> showHSName (idCpt identity)
+      <> ")"
       <> indent
       <> "  [ "
       <> T.intercalate (indent <> "  , ") (NE.toList . fmap (showHS env indent) $ identityAts identity)
@@ -581,7 +622,12 @@ instance ShowHSName ViewDef where
 
 instance ShowHS ViewDef where
   showHS env indent vd =
-    "Vd (" <> showHS env "" (vdpos vd) <> ") " <> fullName vd <> " " <> showHSName (vdcpt vd)
+    "Vd ("
+      <> showHS env "" (vdpos vd)
+      <> ") "
+      <> fullName vd
+      <> " "
+      <> showHSName (vdcpt vd)
       <> indent
       <> "  [ "
       <> T.intercalate (indent <> "  , ") (showHS env indent <$> vdats vd)
@@ -590,7 +636,9 @@ instance ShowHS ViewDef where
 
 instance ShowHS ViewSegment where
   showHS env indent vs =
-    "ViewSegment " <> showHS env indent (origin vs) <> " "
+    "ViewSegment "
+      <> showHS env indent (origin vs)
+      <> " "
       <> " "
       <> tshow (vsmlabel vs)
       <> " "
@@ -608,8 +656,9 @@ instance ShowHS Population where
   showHS _ indent pop =
     case pop of
       ARelPopu {} ->
-        "ARelPopu { popdcl = " <> showHSName (popdcl pop)
-          --TODOFIX
+        "ARelPopu { popdcl = "
+          <> showHSName (popdcl pop)
+          -- TODOFIX
           --          <>indent<>"         , popps  = [ "<>T.intercalate
           --           (indent<>"                    , ") (map show (popps pop))
           <> indent
@@ -617,8 +666,9 @@ instance ShowHS Population where
           <> indent
           <> "         }"
       ACptPopu {} ->
-        "ACptPopu { popcpt = " <> showHSName (popcpt pop)
-          --TODOFIX
+        "ACptPopu { popcpt = "
+          <> showHSName (popcpt pop)
+          -- TODOFIX
           --          <>indent<>"         , popas  = [ "<>T.intercalate
           --           (indent<>"                    , ") (map show (popas pop))
           <> indent
@@ -626,7 +676,7 @@ instance ShowHS Population where
           <> indent
           <> "         }"
 
---instance ShowHSName ObjectDef where
+-- instance ShowHSName ObjectDef where
 --  showHSName = haskellIdentifier . fullName1 . prependToPlainName "oDef_" . objPlainName
 
 instance ShowHS ObjectDef where
@@ -726,7 +776,7 @@ instance ShowHS AClassify where
 instance ShowHSName Relation where
   showHSName d
     | decusr d = haskellIdentifier . fullName1 . prependToPlainName ("rel_" <> fullName d <> "_" <> fullName (source d) <> "_") . name . target $ d -- user defined relations
-    | otherwise = haskellIdentifier . fullName1 . prependToPlainName ("vio_" <> fullName d <> "_" <> fullName (source d) <> "_") . name . target $d -- relations generated per rule
+    | otherwise = haskellIdentifier . fullName1 . prependToPlainName ("vio_" <> fullName d <> "_" <> fullName (source d) <> "_") . name . target $ d -- relations generated per rule
 
 instance ShowHS Relation where
   showHS env indent d =
@@ -810,13 +860,15 @@ instance ShowHSName Origin where
         FileLoc l sym -> "FileLoc (" <> tshow l <> " " <> sym <> ")"
         Origin s -> "Origin " <> tshow s
         PropertyRule str declOrig ->
-          "PropertyRule of " <> text1ToText str <> " "
+          "PropertyRule of "
+            <> text1ToText str
+            <> " "
             <> case declOrig of
               FileLoc l sym -> "declared at FileLoc (" <> tshow l <> " " <> sym <> ")"
               _ ->
-                fatal $
-                  "This should be the origin of a Relation, but it doesn't seem like it is.\n"
-                    <> tshow declOrig
+                fatal
+                  $ "This should be the origin of a Relation, but it doesn't seem like it is.\n"
+                  <> tshow declOrig
         OriginUnknown -> "OriginUnknown"
         XLSXLoc fPath sheet (a, b) -> "XLSXLoc " <> T.pack fPath <> " " <> sheet <> " " <> tshow (a, b)
         MeatGrinder -> "MeatGrinder"
diff --git a/src/Ampersand/Input/ADL1/Parser.hs b/src/Ampersand/Input/ADL1/Parser.hs
index 49a897819..309c28a40 100644
--- a/src/Ampersand/Input/ADL1/Parser.hs
+++ b/src/Ampersand/Input/ADL1/Parser.hs
@@ -37,12 +37,12 @@ pPopulations = many1 . pPopulation
 
 -- | Parses a context
 pContext ::
-  -- |
   NameSpace ->
   -- | The result is the parsed context and a list of include filenames
   AmpParser (P_Context, [Include])
 pContext ns =
-  rebuild <$> (posOf . pKey . toText1Unsafe $ "CONTEXT")
+  rebuild
+    <$> (posOf . pKey . toText1Unsafe $ "CONTEXT")
     <*> pNameWithOptionalLabel ns ContextName
     <*> pMaybe pLanguageRef
     <*> pMaybe pTextMarkup
@@ -78,22 +78,38 @@ pContext ns =
     --- ContextElement ::= MetaData | PatternDef | ProcessDef | RuleDef | Classify | RelationDef | ConceptDef | Index | ViewDef | Interface | Sqlplug | Phpplug | Purpose | Population | PrintThemes | IncludeStatement | Enforce
     pContextElement :: AmpParser ContextElement
     pContextElement =
-      CMeta <$> pMeta
-        <|> CPat <$> pPatternDef ns
-        <|> CRul <$> pRuleDef ns
-        <|> CCfy <$> pClassify ns
-        <|> CRel <$> pRelationDef ns
-        <|> CCon <$> pConceptDef ns
-        <|> CRep <$> pRepresentation ns
-        <|> Cm <$> pRoleRule ns
-        <|> Cm <$> pServiceRule ns
-        <|> CIndx <$> pIdentDef ns
-        <|> CView <$> pViewDef ns
-        <|> Cifc <$> pInterface ns
-        <|> CPrp <$> pPurpose ns
-        <|> CPop <$> pPopulation ns
-        <|> CIncl <$> pIncludeStatement
-        <|> CEnf <$> pEnforce ns
+      CMeta
+        <$> pMeta
+        <|> CPat
+        <$> pPatternDef ns
+        <|> CRul
+        <$> pRuleDef ns
+        <|> CCfy
+        <$> pClassify ns
+        <|> CRel
+        <$> pRelationDef ns
+        <|> CCon
+        <$> pConceptDef ns
+        <|> CRep
+        <$> pRepresentation ns
+        <|> Cm
+        <$> pRoleRule ns
+        <|> Cm
+        <$> pServiceRule ns
+        <|> CIndx
+        <$> pIdentDef ns
+        <|> CView
+        <$> pViewDef ns
+        <|> Cifc
+        <$> pInterface ns
+        <|> CPrp
+        <$> pPurpose ns
+        <|> CPop
+        <$> pPopulation ns
+        <|> CIncl
+        <$> pIncludeStatement
+        <|> CEnf
+        <$> pEnforce ns
 
 pNameWithoutLabel :: NameSpace -> NameType -> AmpParser Name
 pNameWithoutLabel ns typ
@@ -216,7 +232,8 @@ data Include = Include Origin FilePath [Text]
 --- IncludeStatement ::= 'INCLUDE' Text
 pIncludeStatement :: AmpParser Include
 pIncludeStatement =
-  Include <$> currPos
+  Include
+    <$> currPos
     <* (pKey . toText1Unsafe) "INCLUDE"
     <*> (T.unpack <$> pDoubleQuotedString)
     <*> (pBrackets (pDoubleQuotedString `sepBy` pComma) <|> return [])
@@ -225,17 +242,23 @@ pIncludeStatement =
 pLanguageRef :: AmpParser Lang
 pLanguageRef =
   (pKey . toText1Unsafe) "IN"
-    *> ( Dutch <$ (pKey . toText1Unsafe) "DUTCH"
-           <|> English <$ (pKey . toText1Unsafe) "ENGLISH"
+    *> ( Dutch
+           <$ (pKey . toText1Unsafe) "DUTCH"
+           <|> English
+           <$ (pKey . toText1Unsafe) "ENGLISH"
        )
 
 --- TextMarkup ::= 'REST' | 'HTML' | 'LATEX' | 'MARKDOWN'
 pTextMarkup :: AmpParser PandocFormat
 pTextMarkup =
-  ReST <$ (pKey . toText1Unsafe) "REST"
-    <|> HTML <$ (pKey . toText1Unsafe) "HTML"
-    <|> LaTeX <$ (pKey . toText1Unsafe) "LATEX"
-    <|> Markdown <$ (pKey . toText1Unsafe) "MARKDOWN"
+  ReST
+    <$ (pKey . toText1Unsafe) "REST"
+    <|> HTML
+    <$ (pKey . toText1Unsafe) "HTML"
+    <|> LaTeX
+    <$ (pKey . toText1Unsafe) "LATEX"
+    <|> Markdown
+    <$ (pKey . toText1Unsafe) "MARKDOWN"
 
 --- MetaData ::= 'META' Text Text
 pMeta :: AmpParser MetaData
@@ -244,7 +267,8 @@ pMeta = MetaData <$> currPos <* (pKey . toText1Unsafe) "META" <*> pDoubleQuotedS
 --- PatternDef ::= 'PATTERN' ConceptName PatElem* 'ENDPATTERN'
 pPatternDef :: NameSpace -> AmpParser P_Pattern
 pPatternDef ns =
-  rebuild <$> currPos
+  rebuild
+    <$> currPos
     <* (pKey . toText1Unsafe) "PATTERN"
     <*> pNameWithOptionalLabel ns PatternName -- The name spaces of patterns and concepts are shared.
     <*> many (pPatElem ns)
@@ -275,18 +299,30 @@ pPatternDef ns =
 --- PatElem ::= RuleDef | Classify | RelationDef | ConceptDef | Index | ViewDef | Purpose | Population | Enforce
 pPatElem :: NameSpace -> AmpParser PatElem
 pPatElem ns =
-  Pr <$> pRuleDef ns
-    <|> Py <$> pClassify ns
-    <|> Pd <$> pRelationDef ns
-    <|> Pm <$> pRoleRule ns
-    <|> Pm <$> pServiceRule ns
-    <|> Pc <$> pConceptDef ns
-    <|> Prep <$> pRepresentation ns
-    <|> Pk <$> pIdentDef ns
-    <|> Pv <$> pViewDef ns
-    <|> Pe <$> pPurpose ns
-    <|> Pp <$> pPopulation ns
-    <|> Penf <$> pEnforce ns
+  Pr
+    <$> pRuleDef ns
+    <|> Py
+    <$> pClassify ns
+    <|> Pd
+    <$> pRelationDef ns
+    <|> Pm
+    <$> pRoleRule ns
+    <|> Pm
+    <$> pServiceRule ns
+    <|> Pc
+    <$> pConceptDef ns
+    <|> Prep
+    <$> pRepresentation ns
+    <|> Pk
+    <$> pIdentDef ns
+    <|> Pv
+    <$> pViewDef ns
+    <|> Pe
+    <$> pPurpose ns
+    <|> Pp
+    <$> pPopulation ns
+    <|> Penf
+    <$> pEnforce ns
 
 data PatElem
   = Pr (P_Rule TermPrim)
@@ -304,7 +340,8 @@ data PatElem
 --- Enforce ::= 'ENFORCE' Relation (':=' | ':<' | '>:' ) Expression
 pEnforce :: NameSpace -> AmpParser (P_Enforce TermPrim)
 pEnforce ns =
-  P_Enforce <$> currPos
+  P_Enforce
+    <$> currPos
     <* (pKey . toText1Unsafe) "ENFORCE"
     <*> (PNamedR <$> pNamedRel ns)
     <*> pEnforceOperator
@@ -312,7 +349,8 @@ pEnforce ns =
   where
     pEnforceOperator :: AmpParser EnforceOperator
     pEnforceOperator =
-      fun <$> currPos
+      fun
+        <$> currPos
         <*> ( (pOperator . toText1Unsafe) ":="
                 <|> (pOperator . toText1Unsafe) ":<"
                 <|> (pOperator . toText1Unsafe) ">:"
@@ -330,9 +368,11 @@ pEnforce ns =
 --- Classify ::= 'CLASSIFY' ConceptRef ('IS' Cterm | 'ISA' ConceptRef)
 pClassify :: NameSpace -> AmpParser [PClassify] -- Example: CLASSIFY A IS B /\ C /\ D
 pClassify ns =
-  fun <$> currPos
+  fun
+    <$> currPos
     <* (pKey . toText1Unsafe) "CLASSIFY"
-    <*> pConceptRef ns `sepBy1` pComma
+    <*> pConceptRef ns
+    `sepBy1` pComma
     <*> ( (is <$ (pKey . toText1Unsafe) "IS" <*> pCterm)
             <|> (isa <$ (pKey . toText1Unsafe) "ISA" <*> pConceptRef ns)
         )
@@ -350,7 +390,8 @@ pClassify ns =
     --- Cterm1 ::= ConceptRef | ('('? Cterm ')'?)
     pCterm = concat <$> pCterm1 `sepBy1` (pOperator . toText1Unsafe) "/\\"
     pCterm1 =
-      pure <$> pConceptRef ns
+      pure
+        <$> pConceptRef ns
         <|> pParens pCterm -- brackets are allowed for educational reasons.
     is :: [P_Concept] -> (Bool, [P_Concept])
     is gens = (False, gens)
@@ -360,12 +401,13 @@ pClassify ns =
 --- RuleDef ::= 'RULE' Label? Rule Meaning* Message* Violation?
 pRuleDef :: NameSpace -> AmpParser (P_Rule TermPrim)
 pRuleDef ns =
-  build <$> currPos
+  build
+    <$> currPos
     <* (pKey . toText1Unsafe) "RULE"
-      <*> pNameLabelTerm
-      <*> many pMeaning
-      <*> many pMessage
-      <*> pMaybe pViolation
+    <*> pNameLabelTerm
+    <*> many pMeaning
+    <*> many pMessage
+    <*> pMaybe pViolation
   where
     pNameLabelTerm :: AmpParser (Maybe (Name, Maybe Label), Term TermPrim)
     pNameLabelTerm = try pNameAndLabel <|> pNoName
@@ -411,7 +453,7 @@ pRuleDef ns =
                   Nothing -> fatal $ "Not a valid NamePart: " <> localNm
                   Just np -> np
               )
-              NE.:| []
+            NE.:| []
     --- Violation ::= 'VIOLATION' PairView
     pViolation :: AmpParser (PairView (Term TermPrim))
     pViolation = id <$ (pKey . toText1Unsafe) "VIOLATION" <*> pPairView
@@ -425,14 +467,23 @@ pRuleDef ns =
     --- PairViewSegment ::= 'SRC' Term | 'TGT' Term | 'TXT' Text
     pPairViewSegment :: AmpParser (PairViewSegment (Term TermPrim))
     pPairViewSegment =
-      PairViewExp <$> posOf ((pKey . toText1Unsafe) "SRC") <*> return Src <*> pTerm ns
-        <|> PairViewExp <$> posOf ((pKey . toText1Unsafe) "TGT") <*> return Tgt <*> pTerm ns
-        <|> PairViewText <$> posOf ((pKey . toText1Unsafe) "TXT") <*> pDoubleQuotedString
+      PairViewExp
+        <$> posOf ((pKey . toText1Unsafe) "SRC")
+        <*> return Src
+        <*> pTerm ns
+        <|> PairViewExp
+        <$> posOf ((pKey . toText1Unsafe) "TGT")
+        <*> return Tgt
+        <*> pTerm ns
+        <|> PairViewText
+        <$> posOf ((pKey . toText1Unsafe) "TXT")
+        <*> pDoubleQuotedString
 
 --- RelationDef ::= (RelationNew | RelationOld) Props? RelDefaults? ('PRAGMA' Text+)? Meaning* ('=' Content)? '.'?
 pRelationDef :: NameSpace -> AmpParser (P_Relation, [P_Population])
 pRelationDef ns =
-  reorder <$> currPos
+  reorder
+    <$> currPos
     <*> (pRelationNew ns <|> pRelationOld ns)
     <*> optSet pProps
     <*> optList pRelDefaults
@@ -454,7 +505,8 @@ pRelationDef ns =
 pPragma :: AmpParser Pragma
 pPragma =
   build
-    <$> currPos <* (pKey . toText1Unsafe) "PRAGMA"
+    <$> currPos
+    <* (pKey . toText1Unsafe) "PRAGMA"
     <*> pMaybe pDoubleQuotedString
     <*> pMaybe pDoubleQuotedString
     <*> pMaybe pDoubleQuotedString
@@ -475,7 +527,8 @@ pRelDefaults = (pKey . toText1Unsafe) "DEFAULT" *> (toList <$> many1 pRelDefault
 --- RelDefault ::= ( 'SRC' | 'TGT' ) ( ('VALUE' AtomValue (',' AtomValue)*) | ('EVALPHP' '<DoubleQuotedString>') )
 pRelDefault :: AmpParser PRelationDefault
 pRelDefault =
-  build <$> pSrcOrTgt
+  build
+    <$> pSrcOrTgt
     <*> pDef
   where
     build :: SrcOrTgt -> Either (NE.NonEmpty PAtomValue) Text -> PRelationDefault
@@ -484,19 +537,24 @@ pRelDefault =
     pDef :: AmpParser (Either (NE.NonEmpty PAtomValue) Text)
     pDef = pAtom <|> pPHP
     pAtom =
-      Left <$ (pKey . toText1Unsafe) "VALUE"
+      Left
+        <$ (pKey . toText1Unsafe) "VALUE"
         <*> sepBy1 pAtomValue pComma
     pPHP =
-      Right <$ (pKey . toText1Unsafe) "EVALPHP"
+      Right
+        <$ (pKey . toText1Unsafe) "EVALPHP"
         <*> pDoubleQuotedString
     pSrcOrTgt =
-      Src <$ (pKey . toText1Unsafe) "SRC"
-        <|> Tgt <$ (pKey . toText1Unsafe) "TGT"
+      Src
+        <$ (pKey . toText1Unsafe) "SRC"
+        <|> Tgt
+        <$ (pKey . toText1Unsafe) "TGT"
 
 --- RelationNew ::= 'RELATION' Varid Signature
 pRelationNew :: NameSpace -> AmpParser (Name, P_Sign, Maybe Label, PProps)
 pRelationNew ns =
-  (,,,) <$ (pKey . toText1Unsafe) "RELATION"
+  (,,,)
+    <$ (pKey . toText1Unsafe) "RELATION"
     <*> pNameWithoutLabel ns RelationName
     <*> pSign ns
     <*> optional pLabel
@@ -505,7 +563,8 @@ pRelationNew ns =
 --- RelationOld ::= Varid '::' ConceptRef Fun ConceptRef
 pRelationOld :: NameSpace -> AmpParser (Name, P_Sign, Maybe Label, PProps)
 pRelationOld ns =
-  relOld <$> pNameWithoutLabel ns RelationName
+  relOld
+    <$> pNameWithoutLabel ns RelationName
     <* (pOperator . toText1Unsafe) "::"
     <*> pConceptRef ns
     <*> pFun
@@ -541,32 +600,40 @@ pProps = normalizeProps <$> pBrackets (pProp `sepBy` pComma)
 --- Fun ::= '*' | '->' | '<-' | '[' Mults ']'
 pFun :: AmpParser PProps
 pFun =
-  Set.empty <$ (pOperator . toText1Unsafe) "*"
-    <|> Set.fromList [P_Uni, P_Tot] <$ (pOperator . toText1Unsafe) "->"
-    <|> Set.fromList [P_Sur, P_Inj] <$ (pOperator . toText1Unsafe) "<-"
+  Set.empty
+    <$ (pOperator . toText1Unsafe) "*"
+    <|> Set.fromList [P_Uni, P_Tot]
+    <$ (pOperator . toText1Unsafe) "->"
+    <|> Set.fromList [P_Sur, P_Inj]
+    <$ (pOperator . toText1Unsafe) "<-"
     <|> pBrackets pMults
   where
     --- Mults ::= Mult '-' Mult
     pMults :: AmpParser PProps
     pMults =
-      Set.union <$> optSet (pMult (P_Sur, P_Inj))
+      Set.union
+        <$> optSet (pMult (P_Sur, P_Inj))
         <* pDash
         <*> optSet (pMult (P_Tot, P_Uni))
 
     --- Mult ::= ('0' | '1') '..' ('1' | '*') | '*' | '1'
-    --TODO: refactor to Mult ::= '0' '..' ('1' | '*') | '1'('..' ('1' | '*'))? | '*'
+    -- TODO: refactor to Mult ::= '0' '..' ('1' | '*') | '1'('..' ('1' | '*'))? | '*'
     pMult :: (PProp, PProp) -> AmpParser PProps
     pMult (ts, ui) =
-      Set.union <$> (Set.empty <$ pZero <|> Set.singleton ts <$ try pOne)
+      Set.union
+        <$> (Set.empty <$ pZero <|> Set.singleton ts <$ try pOne)
         <* (pOperator . toText1Unsafe) ".."
         <*> (Set.singleton ui <$ try pOne <|> (Set.empty <$ (pOperator . toText1Unsafe) "*"))
-          <|> Set.empty <$ (pOperator . toText1Unsafe) "*"
-          <|> Set.fromList [ts, ui] <$ try pOne
+        <|> Set.empty
+        <$ (pOperator . toText1Unsafe) "*"
+        <|> Set.fromList [ts, ui]
+        <$ try pOne
 
 --- ConceptDef ::= 'CONCEPT' ConceptName Text ('TYPE' Text)? Text?
 pConceptDef :: NameSpace -> AmpParser (DefinitionContainer -> PConceptDef)
 pConceptDef ns =
-  build <$> currPos
+  build
+    <$> currPos
     <* (pKey . toText1Unsafe) "CONCEPT"
     <*> pNameWithOptionalLabel ns ConceptName
     <*> pPCDDef2
@@ -577,7 +644,8 @@ pConceptDef ns =
       PConceptDef orig nm mLab x means
     pPCDDef2 :: AmpParser PCDDef
     pPCDDef2 =
-      ( PCDDefLegacy <$> (pDoubleQuotedString <?> "concept definition (string)")
+      ( PCDDefLegacy
+          <$> (pDoubleQuotedString <?> "concept definition (string)")
           <*> (pDoubleQuotedString `opt` "") -- a reference to the source of this definition.
       )
         <|> (PCDDefNew <$> pMeaning)
@@ -585,9 +653,11 @@ pConceptDef ns =
 --- Representation ::= 'REPRESENT' ConceptNameList 'TYPE' AdlTType
 pRepresentation :: NameSpace -> AmpParser Representation
 pRepresentation ns =
-  Repr <$> currPos
+  Repr
+    <$> currPos
     <* (pKey . toText1Unsafe) "REPRESENT"
-    <*> pConceptRef ns `sepBy1` pComma
+    <*> pConceptRef ns
+    `sepBy1` pComma
     <* (pKey . toText1Unsafe) "TYPE"
     <*> pAdlTType
 
@@ -619,7 +689,8 @@ pAdlTType =
 --- IdentDef ::= 'IDENT' Label ConceptRef '(' IndSegmentList ')'
 pIdentDef :: NameSpace -> AmpParser P_IdentDef
 pIdentDef ns =
-  build <$> currPos
+  build
+    <$> currPos
     <* (pKey . toText1Unsafe) "IDENT"
     <*> pNameWithOptionalLabelAndColon ns IdentName
     <*> pConceptRef ns
@@ -658,12 +729,14 @@ pViewDef ns = try (pViewDefImproved ns) <|> pViewDefLegacy ns -- introduces back
 --- FancyViewDef ::= 'VIEW' Name Label? ConceptOneRef 'DEFAULT'? ('{' ViewObjList '}')?  HtmlView? 'ENDVIEW'
 pViewDefImproved :: NameSpace -> AmpParser P_ViewDef
 pViewDefImproved ns =
-  mkViewDef <$> currPos
+  mkViewDef
+    <$> currPos
     <* (pKey . toText1Unsafe) "VIEW"
     <*> pNameWithOptionalLabelAndColon ns ViewName
     <*> pConceptOneRef ns
     <*> pIsThere ((pKey . toText1Unsafe) "DEFAULT")
-    <*> pBraces (pViewSegment Improved ns `sepBy` pComma) `opt` []
+    <*> pBraces (pViewSegment Improved ns `sepBy` pComma)
+    `opt` []
     <*> pMaybe pHtmlView
     <* (pKey . toText1Unsafe) "ENDVIEW"
   where
@@ -689,15 +762,19 @@ pViewDefImproved ns =
 --- ViewSegmentLoad ::= Term | 'TXT' Text
 pViewSegmentLoad :: NameSpace -> AmpParser (P_ViewSegmtPayLoad TermPrim)
 pViewSegmentLoad ns =
-  P_ViewExp <$> pTerm ns
-    <|> P_ViewText <$ (pKey . toText1Unsafe) "TXT" <*> pDoubleQuotedString
+  P_ViewExp
+    <$> pTerm ns
+    <|> P_ViewText
+    <$ (pKey . toText1Unsafe) "TXT"
+    <*> pDoubleQuotedString
 
 data ViewKind = Legacy | Improved
 
 --- ViewSegment ::= Label ViewSegmentLoad
 pViewSegment :: ViewKind -> NameSpace -> AmpParser (P_ViewSegment TermPrim)
 pViewSegment viewKind ns =
-  build <$> currPos
+  build
+    <$> currPos
     <*> case viewKind of
       Legacy -> pure Nothing
       Improved -> pMaybe pTex1AndColon
@@ -714,7 +791,8 @@ pViewSegment viewKind ns =
 --- ViewDefLegacy ::= 'VIEW' Label ConceptOneRef '(' ViewSegmentList ')'
 pViewDefLegacy :: NameSpace -> AmpParser P_ViewDef
 pViewDefLegacy ns =
-  build <$> currPos
+  build
+    <$> currPos
     <* (pKey . toText1Unsafe) "VIEW"
     <*> pNameWithOptionalLabelAndColon ns ViewName
     <*> pConceptOneRef ns
@@ -740,7 +818,8 @@ pViewDefLegacy ns =
 --- Interface ::= 'INTERFACE' ADLid Params? Roles? ':' Term (ADLid | Conid)? SubInterface?
 pInterface :: NameSpace -> AmpParser P_Interface
 pInterface ns =
-  build <$> currPos
+  build
+    <$> currPos
     <*> pInterfaceIsAPI
     <*> pNameWithOptionalLabel ns InterfaceName
     <*> pMaybe pRoles
@@ -776,7 +855,7 @@ pInterface ns =
                 obj_msub = Just sub
               },
           pos = p,
-          ifc_Prp = "" --TODO: Nothing in syntax defined for the purpose of the interface.
+          ifc_Prp = "" -- TODO: Nothing in syntax defined for the purpose of the interface.
         }
     --- Roles ::= 'FOR' RoleList
     pRoles = (pKey . toText1Unsafe) "FOR" *> pRole ns False `sepBy1` pComma
@@ -784,11 +863,15 @@ pInterface ns =
 --- SubInterface ::= 'BOX' BoxHeader? Box | 'LINKTO'? 'INTERFACE' ADLid
 pSubInterface :: NameSpace -> AmpParser P_SubInterface
 pSubInterface ns =
-  P_Box <$> currPos <*> pBoxHeader <*> pBoxBody
+  P_Box
+    <$> currPos
+    <*> pBoxHeader
+    <*> pBoxBody
     <|> P_InterfaceRef
-      <$> currPos
-      <*> pIsThere ((pKey . toText1Unsafe) "LINKTO") <* pInterfaceKey
-      <*> pNameWithoutLabel ns InterfaceName
+    <$> currPos
+    <*> pIsThere ((pKey . toText1Unsafe) "LINKTO")
+    <* pInterfaceKey
+    <*> pNameWithoutLabel ns InterfaceName
   where
     pBoxHeader :: AmpParser BoxHeader
     pBoxHeader =
@@ -800,9 +883,10 @@ pSubInterface ns =
             (typ, keys) = fromMaybe (toText1Unsafe "FORM", []) x
         pBoxSpecification :: AmpParser (Text1, [TemplateKeyValue])
         pBoxSpecification =
-          pChevrons $
-            (,) <$> (pSingleWord <|> pAnyKeyWord)
-              <*> many pTemplateKeyValue
+          pChevrons
+            $ (,)
+            <$> (pSingleWord <|> pAnyKeyWord)
+            <*> many pTemplateKeyValue
         pTemplateKeyValue :: AmpParser TemplateKeyValue
         pTemplateKeyValue =
           TemplateKeyValue
@@ -829,7 +913,7 @@ pBoxBodyElement ns =
         <* pColon
         <*> pTerm ns -- the context term (for example: I[c])
         <*> pMaybe pCruds
-        <*> pMaybe (pChevrons (pNameWithoutLabel ns ViewName)) --for the view
+        <*> pMaybe (pChevrons (pNameWithoutLabel ns ViewName)) -- for the view
         <*> pMaybe (pSubInterface ns) -- the optional subinterface
       where
         build orig localNm lbl term mCrud mView msub =
@@ -864,7 +948,8 @@ pCruds = P_Cruds <$> currPos <*> pCrudString
 --- Purpose ::= 'PURPOSE' Ref2Obj LanguageRef? TextMarkup? ('REF' StringListSemi)? Expl
 pPurpose :: NameSpace -> AmpParser PPurpose
 pPurpose ns =
-  rebuild <$> currPos
+  rebuild
+    <$> currPos
     <* (pKey . toText1Unsafe) "PURPOSE"
     <*> pRef2Obj
     <*> pMaybe pLanguageRef
@@ -874,7 +959,7 @@ pPurpose ns =
   where
     rebuild :: Origin -> PRef2Obj -> Maybe Lang -> Maybe PandocFormat -> Maybe (NE.NonEmpty Text) -> Text -> PPurpose
     rebuild orig obj lang fmt refs str =
-      PRef2 orig obj (P_Markup lang fmt str) (concatMap splitOnSemicolon (maybe [] NE.toList refs))
+      PPurpose orig obj (P_Markup lang fmt str) (concatMap splitOnSemicolon (maybe [] NE.toList refs))
       where
         -- TODO: This separation should not happen in the parser
         splitOnSemicolon :: Text -> [Text]
@@ -882,14 +967,30 @@ pPurpose ns =
         --- Ref2Obj ::= 'CONCEPT' ConceptName | 'RELATION' NamedRel | 'RULE' ADLid | 'IDENT' ADLid | 'VIEW' ADLid | 'PATTERN' ADLid | 'INTERFACE' ADLid | 'CONTEXT' ADLid
     pRef2Obj :: AmpParser PRef2Obj
     pRef2Obj =
-      PRef2ConceptDef <$ (pKey . toText1Unsafe) "CONCEPT" <*> pNameWithoutLabel ns ConceptName
-        <|> PRef2Relation <$ (pKey . toText1Unsafe) "RELATION" <*> pNamedRel ns
-        <|> PRef2Rule <$ (pKey . toText1Unsafe) "RULE" <*> pNameWithoutLabel ns RuleName
-        <|> PRef2IdentityDef <$ (pKey . toText1Unsafe) "IDENT" <*> pNameWithoutLabel ns IdentName
-        <|> PRef2ViewDef <$ (pKey . toText1Unsafe) "VIEW" <*> pNameWithoutLabel ns ViewName
-        <|> PRef2Pattern <$ (pKey . toText1Unsafe) "PATTERN" <*> pNameWithoutLabel ns PatternName
-        <|> PRef2Interface <$ pInterfaceKey <*> pNameWithoutLabel ns InterfaceName
-        <|> PRef2Context <$ (pKey . toText1Unsafe) "CONTEXT" <*> pNameWithoutLabel ns ContextName
+      PRef2ConceptDef
+        <$ (pKey . toText1Unsafe) "CONCEPT"
+        <*> pNameWithoutLabel ns ConceptName
+        <|> PRef2Relation
+        <$ (pKey . toText1Unsafe) "RELATION"
+        <*> pNamedRel ns
+        <|> PRef2Rule
+        <$ (pKey . toText1Unsafe) "RULE"
+        <*> pNameWithoutLabel ns RuleName
+        <|> PRef2IdentityDef
+        <$ (pKey . toText1Unsafe) "IDENT"
+        <*> pNameWithoutLabel ns IdentName
+        <|> PRef2ViewDef
+        <$ (pKey . toText1Unsafe) "VIEW"
+        <*> pNameWithoutLabel ns ViewName
+        <|> PRef2Pattern
+        <$ (pKey . toText1Unsafe) "PATTERN"
+        <*> pNameWithoutLabel ns PatternName
+        <|> PRef2Interface
+        <$ pInterfaceKey
+        <*> pNameWithoutLabel ns InterfaceName
+        <|> PRef2Context
+        <$ (pKey . toText1Unsafe) "CONTEXT"
+        <*> pNameWithoutLabel ns ContextName
 
 pInterfaceKey :: AmpParser Text1
 pInterfaceKey = pKey (toText1Unsafe "INTERFACE") <|> pKey (toText1Unsafe "API") -- On special request of Rieks, the keyword "API" is allowed everywhere where the keyword "INTERFACE" is used. https://github.com/AmpersandTarski/Ampersand/issues/789
@@ -906,7 +1007,7 @@ pPopulation ::
   AmpParser P_Population
 pPopulation ns =
   (pKey . toText1Unsafe) "POPULATION"
-    *> (try pPopulationCpt <|> pPopulationRel) --FIXME: Adding try solved the problem of parsing POPULATION statements. However, it significantly slowed down the quickCheck tests.
+    *> (try pPopulationCpt <|> pPopulationRel) -- FIXME: Adding try solved the problem of parsing POPULATION statements. However, it significantly slowed down the quickCheck tests.
   where
     pPopulationRel =
       P_RelPopu Nothing Nothing
@@ -922,28 +1023,34 @@ pPopulation ns =
         <*> pBrackets (pAtomValue `sepBy` pComma)
 
 --- RoleRule ::= 'ROLE' RoleList 'MAINTAINS' ADLidList
---TODO: Rename the RoleRule to RoleMantains.
+-- TODO: Rename the RoleRule to RoleMantains.
 pRoleRule :: NameSpace -> AmpParser P_RoleRule
 pRoleRule ns =
   try
-    ( Maintain <$> currPos
+    ( Maintain
+        <$> currPos
         <* (pKey . toText1Unsafe) "ROLE"
-        <*> pRole ns False `sepBy1` pComma
+        <*> pRole ns False
+        `sepBy1` pComma
         <* (pKey . toText1Unsafe) "MAINTAINS"
     )
-    <*> pNameWithoutLabel ns RuleName `sepBy1` pComma
+    <*> pNameWithoutLabel ns RuleName
+    `sepBy1` pComma
 
 --- ServiceRule ::= 'SERVICE' RoleList 'MAINTAINS' ADLidList
---TODO: Rename the RoleRule to RoleMantains.
+-- TODO: Rename the RoleRule to RoleMantains.
 pServiceRule :: NameSpace -> AmpParser P_RoleRule
 pServiceRule ns =
   try
-    ( Maintain <$> currPos
+    ( Maintain
+        <$> currPos
         <* (pKey . toText1Unsafe) "SERVICE"
-        <*> pRole ns True `sepBy1` pComma
+        <*> pRole ns True
+        `sepBy1` pComma
         <* (pKey . toText1Unsafe) "MAINTAINS"
     )
-    <*> pNameWithoutLabel ns RuleName `sepBy1` pComma
+    <*> pNameWithoutLabel ns RuleName
+    `sepBy1` pComma
 
 --- Role ::= ADLid (LABEL doublequotedstring)?
 --- RoleList ::= Role (',' Role)*
@@ -960,12 +1067,13 @@ pRole ns isService =
           rlIsService = isService
         }
 
---pNameWithoutLabel ns RoleName
+-- pNameWithoutLabel ns RoleName
 
 --- Meaning ::= 'MEANING' Markup
 pMeaning :: AmpParser PMeaning
 pMeaning =
-  PMeaning <$ (pKey . toText1Unsafe) "MEANING"
+  PMeaning
+    <$ (pKey . toText1Unsafe) "MEANING"
     <*> pMarkup
 
 --- Message ::= 'MESSAGE' Markup
@@ -989,8 +1097,14 @@ pRule ::
   AmpParser (Term TermPrim)
 pRule ns =
   pTerm ns
-    <??> ( invert PEqu <$> currPos <* (pOperator . toText1Unsafe) "=" <*> pTerm ns
-             <|> invert PInc <$> currPos <* (pOperator . toText1Unsafe) "|-" <*> pTerm ns
+    <??> ( invert PEqu
+             <$> currPos
+             <* (pOperator . toText1Unsafe) "="
+             <*> pTerm ns
+             <|> invert PInc
+             <$> currPos
+             <* (pOperator . toText1Unsafe) "|-"
+             <*> pTerm ns
          )
 
 {-
@@ -1011,8 +1125,10 @@ pTerm ::
   AmpParser (Term TermPrim)
 pTerm ns =
   pTrm2 ns
-    <??> ( invertT PIsc <$> rightAssociate PIsc (toText1Unsafe "/\\") (pTrm2 ns)
-             <|> invertT PUni <$> rightAssociate PUni (toText1Unsafe "\\/") (pTrm2 ns)
+    <??> ( invertT PIsc
+             <$> rightAssociate PIsc (toText1Unsafe "/\\") (pTrm2 ns)
+             <|> invertT PUni
+             <$> rightAssociate PUni (toText1Unsafe "\\/") (pTrm2 ns)
          )
 
 -- The left factored version of difference: (Actually, there is no need for left-factoring here, but no harm either)
@@ -1025,9 +1141,18 @@ pTrm2 ns = pTrm3 ns <??> (invert PDif <$> posOf pDash <*> pTrm3 ns)
 pTrm3 :: NameSpace -> AmpParser (Term TermPrim)
 pTrm3 ns =
   pTrm4 ns
-    <??> ( invert PLrs <$> currPos <* (pOperator . toText1Unsafe) "/" <*> pTrm4 ns
-             <|> invert PRrs <$> currPos <* (pOperator . toText1Unsafe) "\\" <*> pTrm4 ns
-             <|> invert PDia <$> currPos <* (pOperator . toText1Unsafe) "<>" <*> pTrm4 ns
+    <??> ( invert PLrs
+             <$> currPos
+             <* (pOperator . toText1Unsafe) "/"
+             <*> pTrm4 ns
+             <|> invert PRrs
+             <$> currPos
+             <* (pOperator . toText1Unsafe) "\\"
+             <*> pTrm4 ns
+             <|> invert PDia
+             <$> currPos
+             <* (pOperator . toText1Unsafe) "<>"
+             <*> pTrm4 ns
          )
 
 -- composition and relational addition are associative, and parsed similar to union and intersect...
@@ -1035,16 +1160,20 @@ pTrm3 ns =
 pTrm4 :: NameSpace -> AmpParser (Term TermPrim)
 pTrm4 ns =
   pTrm5 ns
-    <??> ( invertT PCps <$> rightAssociate PCps (toText1Unsafe ";") (pTrm5 ns)
-             <|> invertT PRad <$> rightAssociate PRad (toText1Unsafe "!") (pTrm5 ns)
-             <|> invertT PPrd <$> rightAssociate PPrd (toText1Unsafe "#") (pTrm5 ns)
+    <??> ( invertT PCps
+             <$> rightAssociate PCps (toText1Unsafe ";") (pTrm5 ns)
+             <|> invertT PRad
+             <$> rightAssociate PRad (toText1Unsafe "!") (pTrm5 ns)
+             <|> invertT PPrd
+             <$> rightAssociate PPrd (toText1Unsafe "#") (pTrm5 ns)
          )
 
 --- Trm5 ::= '-'* Trm6 ('~' | '*' | '+')*
 pTrm5 :: NameSpace -> AmpParser (Term TermPrim)
---TODO: Separate into prefix and postfix top-level functions
+-- TODO: Separate into prefix and postfix top-level functions
 pTrm5 ns =
-  f <$> many (valPosOf pDash)
+  f
+    <$> many (valPosOf pDash)
     <*> pTrm6 ns
     <*> many
       ( valPosOf
@@ -1065,8 +1194,11 @@ pTrm5 ns =
 --- Trm6 ::= RelationRef | '(' Term ')'
 pTrm6 :: NameSpace -> AmpParser (Term TermPrim)
 pTrm6 ns =
-  Prim <$> pRelationRef ns
-    <|> PBrk <$> currPos <*> pParens (pTerm ns)
+  Prim
+    <$> pRelationRef ns
+    <|> PBrk
+    <$> currPos
+    <*> pParens (pTerm ns)
 
 -- Help function for several terms. The type 't' is each of the terms.
 invert :: (Origin -> t -> t -> t) -> Origin -> t -> t -> t
@@ -1087,10 +1219,20 @@ rightAssociate combinator operator term =
 --- RelationRef ::= NamedRel | 'I' ('[' ConceptOneRef ']')? | 'V' Signature? | Singleton ('[' ConceptOneRef ']')?
 pRelationRef :: NameSpace -> AmpParser TermPrim
 pRelationRef ns =
-  PNamedR <$> pNamedRel ns
-    <|> pid <$> currPos <* (pKey . toText1Unsafe) "I" <*> (pMaybe . pBrackets $ pConceptOneRef ns)
-    <|> pfull <$> currPos <* (pKey . toText1Unsafe) "V" <*> pMaybe (pSign ns)
-    <|> Patm <$> currPos <*> pSingleton <*> (pMaybe . pBrackets $ pConceptOneRef ns)
+  PNamedR
+    <$> pNamedRel ns
+    <|> pid
+    <$> currPos
+    <* (pKey . toText1Unsafe) "I"
+    <*> (pMaybe . pBrackets $ pConceptOneRef ns)
+    <|> pfull
+    <$> currPos
+    <* (pKey . toText1Unsafe) "V"
+    <*> pMaybe (pSign ns)
+    <|> Patm
+    <$> currPos
+    <*> pSingleton
+    <*> (pMaybe . pBrackets $ pConceptOneRef ns)
   where
     pid orig Nothing = PI orig
     pid orig (Just c) = Pid orig c
@@ -1099,7 +1241,8 @@ pRelationRef ns =
 
 pSingleton :: AmpParser PAtomValue
 pSingleton =
-  value2PAtomValue <$> currPos
+  value2PAtomValue
+    <$> currPos
     <*> ( pAtomValInPopulation True
             <|> pBraces (pAtomValInPopulation False)
         )
@@ -1158,7 +1301,8 @@ pContent = pBrackets (pRecord `sepBy` (pComma <|> pSemi))
     pRecord :: AmpParser PAtomPair
     pRecord =
       pParens
-        ( PPair <$> currPos
+        ( PPair
+            <$> currPos
             <*> pAtomValue
             <* pComma
             <*> pAtomValue
@@ -1166,5 +1310,6 @@ pContent = pBrackets (pRecord `sepBy` (pComma <|> pSemi))
 
 pLabel :: AmpParser Label
 pLabel =
-  Label <$ (pKey . toText1Unsafe $ "LABEL")
+  Label
+    <$ (pKey . toText1Unsafe $ "LABEL")
     <*> pDoubleQuotedString
diff --git a/src/Ampersand/Input/Archi/ArchiAnalyze.hs b/src/Ampersand/Input/Archi/ArchiAnalyze.hs
index 861d6fe48..797536624 100644
--- a/src/Ampersand/Input/Archi/ArchiAnalyze.hs
+++ b/src/Ampersand/Input/Archi/ArchiAnalyze.hs
@@ -314,12 +314,12 @@ data ArchiObj
 --   Still, the omitted information is written below, but commented out so you can follow the structure in the ArchiMate-file.
 data Child = Child
   { --  chldType       :: Text
-    --, chldId         :: Text
-    --, chldAlgn       :: Text
-    --, chldFCol       :: Text
+    -- , chldId         :: Text
+    -- , chldAlgn       :: Text
+    -- , chldFCol       :: Text
     chldElem :: Maybe Text1,
-    --, trgtConn       :: Text
-    --, bound          :: Bound
+    -- , trgtConn       :: Text
+    -- , bound          :: Bound
     srcConns :: [SourceConnection],
     childs :: [Child]
   }
@@ -423,7 +423,7 @@ instance WithProperties ArchiObj where
       { viewProps = [prop {archPropId = Just propId} | (propId, prop) <- zip identifiers (viewProps vw)]
       }
 
-instance WithProperties a => WithProperties [a] where
+instance (WithProperties a) => WithProperties [a] where
   allProps xs = concatMap allProps xs
   identifyProps identifiers xs =
     [identifyProps ids x | (ids, x) <- zip idss xs]
@@ -537,7 +537,7 @@ instance MetaArchi ArchiObj where
           unFix str
             | str == toText1Unsafe "Relationship" = str
             | "Relationship" `T.isSuffixOf` text1ToText str =
-              toText1Unsafe . T.reverse . T.drop 12 . T.reverse . text1ToText $ str
+                toText1Unsafe . T.reverse . T.drop 12 . T.reverse . text1ToText $ str
             | otherwise = str
       relLabel :: Text1
       relLabel = case text1ToText relTyp of
@@ -626,7 +626,7 @@ instance MetaArchi ArchiProp where
         ]
     ]
 
-instance MetaArchi a => MetaArchi [a] where
+instance (MetaArchi a) => MetaArchi [a] where
   typeMap maybeViewName xs = Map.unions [typeMap maybeViewName x | x <- xs]
   grindArchi typeLookup xs = concat [grindArchi typeLookup x | x <- xs]
 
@@ -656,7 +656,7 @@ translateArchiElem plainNm (plainSrcName, plainTgtName) maybeViewName props tupl
           },
       archiViewname = maybeViewName,
       grainPurp =
-        PRef2
+        PPurpose
           { pos = OriginUnknown, -- the position in the Ampersand script of this purpose definition
             pexObj = PRef2Relation ref_to_relation, -- the reference to the object whose purpose is explained
             pexMarkup = P_Markup Nothing Nothing purpText, -- the piece of text, including markup and language info
@@ -709,7 +709,7 @@ processStraight absFilePath =
         g x = if x == '\\' then '/' else x
         n [] = fatal "absFilePath is an empty list."
         n x@(h : _) = if h /= '/' then '/' : x else x
-    analArchiRepo :: ArrowXml a => a XmlTree ArchiRepo
+    analArchiRepo :: (ArrowXml a) => a XmlTree ArchiRepo
     analArchiRepo =
       (atTag "archimate:model" <+> atTag "archimate:ArchimateModel")
         >>> proc l -> do
@@ -732,9 +732,10 @@ processStraight absFilePath =
                   archPurposes = purposes
                 }
 
-    getFolder :: ArrowXml a => Int -> a XmlTree Folder
+    getFolder :: (ArrowXml a) => Int -> a XmlTree Folder
     getFolder level =
-      isElem >>> (hasName "folder" <+> hasName "folders")
+      isElem
+        >>> (hasName "folder" <+> hasName "folders")
         >>> proc l -> do
           fldNm' <- getAttrValue "name" -< l
           fldId' <- getAttrValue "id" -< l
@@ -752,9 +753,10 @@ processStraight absFilePath =
                   fldFolders = subFlds
                 }
 
-    getArchiObj :: ArrowXml a => a XmlTree ArchiObj
+    getArchiObj :: (ArrowXml a) => a XmlTree ArchiObj
     getArchiObj =
-      isElem >>> (hasName "element" <+> hasName "elements")
+      isElem
+        >>> (hasName "element" <+> hasName "elements")
         >>> proc l -> do
           -- don't use atTag, because there is recursion in getFolder.
           objId <- getAttrValue "id" -< l
@@ -821,9 +823,10 @@ processStraight absFilePath =
       | otherwise = str
       where
         thePrefix = "archimate:"
-    getProp :: ArrowXml a => a XmlTree ArchiProp
+    getProp :: (ArrowXml a) => a XmlTree ArchiProp
     getProp =
-      isElem >>> (hasName "property" <+> hasName "properties")
+      isElem
+        >>> (hasName "property" <+> hasName "properties")
         >>> proc l -> do
           propKey <- getAttrValue "key" -< l
           propVal <- getAttrValue "value" -< l
@@ -834,22 +837,25 @@ processStraight absFilePath =
                   archPropId = Nothing, -- error "fatal 315: archPropId not yet defined"
                   archPropVal = T.pack propVal
                 }
-    getPurpose :: ArrowXml a => a XmlTree ArchiPurpose
+    getPurpose :: (ArrowXml a) => a XmlTree ArchiPurpose
     getPurpose =
-      isElem >>> hasName "purpose"
+      isElem
+        >>> hasName "purpose"
         >>> proc l -> do
           purpVal <- text -< l
           returnA -< ArchiPurpose {archPurpVal = T.pack purpVal}
-    getDocu :: ArrowXml a => a XmlTree ArchiDocu
+    getDocu :: (ArrowXml a) => a XmlTree ArchiDocu
     getDocu =
-      isElem >>> hasName "documentation"
+      isElem
+        >>> hasName "documentation"
         >>> proc l -> do
           docuVal <- text -< l
           returnA -< ArchiDocu {archDocuVal = T.pack docuVal}
 
-    getChild :: ArrowXml a => a XmlTree Child
+    getChild :: (ArrowXml a) => a XmlTree Child
     getChild =
-      atTag "child" <+> atTag "children"
+      atTag "child"
+        <+> atTag "children"
         >>> proc l -> do
           --  chldType'  <- getAttrValue "xsi:type"            -< l
           --  chldId'    <- getAttrValue "id"                  -< l
@@ -880,9 +886,11 @@ processStraight absFilePath =
     -- The following does not work yet for recent versions of Archi
     -- which should parse with hasName "sourceConnection", but doesn't. TODO
     -- However, forget about this after the ArchiMate Exchange Format can be parsed.
-    getSrcConn :: ArrowXml a => a XmlTree SourceConnection
+    getSrcConn :: (ArrowXml a) => a XmlTree SourceConnection
     getSrcConn =
-      isElem >>> hasName "sourceConnection" <+> hasName "sourceConnections"
+      isElem
+        >>> hasName "sourceConnection"
+        <+> hasName "sourceConnections"
         >>> proc l -> do
           --  sConType'  <- getAttrValue "xsi:type"              -< l
           --  sConId'    <- getAttrValue "id"                    -< l
@@ -938,8 +946,8 @@ processStraight absFilePath =
 -}
 
 -- | Auxiliaries `atTag` and `text` have been copied from the tutorial papers about arrows
-atTag :: ArrowXml a => Text -> a (NTree XNode) XmlTree
+atTag :: (ArrowXml a) => Text -> a (NTree XNode) XmlTree
 atTag tag = deep (isElem >>> hasName (T.unpack tag))
 
-text :: ArrowXml a => a (NTree XNode) String
+text :: (ArrowXml a) => a (NTree XNode) String
 text = getChildren >>> getText
diff --git a/src/Ampersand/Test/Parser/ArbitraryTree.hs b/src/Ampersand/Test/Parser/ArbitraryTree.hs
index 413cc6066..7e4f5d249 100644
--- a/src/Ampersand/Test/Parser/ArbitraryTree.hs
+++ b/src/Ampersand/Test/Parser/ArbitraryTree.hs
@@ -41,7 +41,9 @@ safeFilePath = T.unpack <$> safeText
 --   characters are all alphanumerical or '_'. Keywords are excluded from identifiers
 identifier :: Gen Text1
 identifier =
-  ( Text1 <$> arbitrary `suchThat` isSafeIdChar' True
+  ( Text1
+      <$> arbitrary
+      `suchThat` isSafeIdChar' True
       <*> (T.pack <$> listOf (arbitrary `suchThat` isSafeIdChar' False))
   )
     `suchThat` (not . isKeyword)
@@ -66,17 +68,17 @@ uppercaseName = arbitrary `suchThat` (firstUppercase . namePartToText1 . localNa
 
 makeObj :: ObjectKind -> Gen P_BoxBodyElement
 makeObj objectKind =
-  oneof $
-    ( P_BoxItemTerm
-        <$> plainNameGenerator
-        <*> arbitrary
-        <*> arbitrary
-        <*> term
-        <*> cruds
-        <*> view'
-        <*> subInterface objectKind
-    ) :
-      [ P_BxTxt
+  oneof
+    $ ( P_BoxItemTerm
+          <$> plainNameGenerator
+          <*> arbitrary
+          <*> arbitrary
+          <*> term
+          <*> cruds
+          <*> view'
+          <*> subInterface objectKind
+      )
+    : [ P_BxTxt
           <$> plainNameGenerator
           <*> arbitrary
           <*> safeText
@@ -124,7 +126,7 @@ makeObj objectKind =
             [ P_Box
                 <$> arbitrary
                 <*> arbitrary
-                <*> smallListOf (makeObj (SubInterfaceKind {siMaxDepth = min (n -1) 2})),
+                <*> smallListOf (makeObj (SubInterfaceKind {siMaxDepth = min (n - 1) 2})),
               P_InterfaceRef
                 <$> arbitrary
                 <*> arbitrary
@@ -174,7 +176,8 @@ instance Arbitrary TemplateKeyValue where
 
 instance Arbitrary P_Cruds where
   arbitrary =
-    P_Cruds <$> arbitrary
+    P_Cruds
+      <$> arbitrary
       <*> (toText1Unsafe . T.pack <$> (sublistOf "cCrRuUdD" `suchThat` requirements))
     where
       requirements cs = length cs `elem` [1 .. 4] && map toUpper cs == (L.nub . map toUpper $ cs)
@@ -213,16 +216,20 @@ instance Arbitrary P_RoleRule where
 
 instance Arbitrary Representation where
   arbitrary =
-    Repr <$> arbitrary
-      <*> arbitrary `suchThat` all notIsOneAndnoLabel
-      <*> arbitrary `suchThat` (TypeOfOne /=)
+    Repr
+      <$> arbitrary
+      <*> arbitrary
+      `suchThat` all notIsOneAndnoLabel
+      <*> arbitrary
+      `suchThat` (TypeOfOne /=)
 
 instance Arbitrary TType where
   arbitrary = elements [minBound ..]
 
 instance Arbitrary Role where
   arbitrary =
-    Role <$> arbitrary
+    Role
+      <$> arbitrary
       <*> unrestrictedName
       <*> arbitrary
       <*> arbitrary
@@ -233,20 +240,20 @@ instance Arbitrary P_Pattern where
   arbitrary =
     P_Pat
       <$> arbitrary
-        <*> uppercaseName
-        <*> arbitrary
-        <*> smallListOf arbitrary
-        <*> smallListOf arbitrary
-        <*> smallListOf arbitrary
-        <*> smallListOf arbitrary
-        <*> smallListOf arbitrary
-        <*> smallListOf arbitrary
-        <*> smallListOf arbitrary
-        <*> smallListOf arbitrary
-        <*> smallListOf arbitrary
-        <*> smallListOf arbitrary
-        <*> arbitrary
-        <*> smallListOf arbitrary
+      <*> uppercaseName
+      <*> arbitrary
+      <*> smallListOf arbitrary
+      <*> smallListOf arbitrary
+      <*> smallListOf arbitrary
+      <*> smallListOf arbitrary
+      <*> smallListOf arbitrary
+      <*> smallListOf arbitrary
+      <*> smallListOf arbitrary
+      <*> smallListOf arbitrary
+      <*> smallListOf arbitrary
+      <*> smallListOf arbitrary
+      <*> arbitrary
+      <*> smallListOf arbitrary
 
 instance Arbitrary P_Relation where
   arbitrary =
@@ -375,8 +382,10 @@ instance Arbitrary (P_Rule TermPrim) where
 
 instance Arbitrary (P_Enforce TermPrim) where
   arbitrary =
-    P_Enforce <$> arbitrary
-      <*> arbitrary `suchThat` isNamedRelation
+    P_Enforce
+      <$> arbitrary
+      <*> arbitrary
+      `suchThat` isNamedRelation
       <*> arbitrary
       <*> genNonRuleTerm
     where
@@ -424,14 +433,17 @@ instance Arbitrary P_Population where
   arbitrary =
     oneof
       [ P_RelPopu
-          <$> arbitrary `suchThat` all notIsOneAndnoLabel
-          <*> arbitrary `suchThat` all notIsOneAndnoLabel
+          <$> arbitrary
+          `suchThat` all notIsOneAndnoLabel
+          <*> arbitrary
+          `suchThat` all notIsOneAndnoLabel
           <*> arbitrary
           <*> arbitrary
           <*> arbitrary,
         P_CptPopu
           <$> arbitrary
-          <*> arbitrary `suchThat` notIsOneAndnoLabel
+          <*> arbitrary
+          `suchThat` notIsOneAndnoLabel
           <*> arbitrary
       ]
 
@@ -458,7 +470,8 @@ instance Arbitrary PAtomValue where
 
 instance Arbitrary P_Interface where
   arbitrary =
-    P_Ifc <$> arbitrary
+    P_Ifc
+      <$> arbitrary
       <*> arbitrary
       <*> arbitrary
       <*> arbitrary
@@ -468,10 +481,12 @@ instance Arbitrary P_Interface where
 
 instance Arbitrary P_IdentDef where
   arbitrary =
-    P_Id <$> arbitrary
+    P_Id
+      <$> arbitrary
+      <*> arbitrary
       <*> arbitrary
       <*> arbitrary
-      <*> arbitrary `suchThat` notIsOneAndnoLabel
+      `suchThat` notIsOneAndnoLabel
       <*> arbitrary
 
 instance Arbitrary P_IdentSegment where
@@ -479,10 +494,12 @@ instance Arbitrary P_IdentSegment where
 
 instance Arbitrary P_ViewDef where
   arbitrary =
-    P_Vd <$> arbitrary
+    P_Vd
+      <$> arbitrary
+      <*> arbitrary
       <*> arbitrary
       <*> arbitrary
-      <*> arbitrary `suchThat` noLabel
+      `suchThat` noLabel
       <*> arbitrary
       <*> arbitrary
       <*> arbitrary
@@ -503,7 +520,7 @@ instance Arbitrary (P_ViewSegmtPayLoad TermPrim) where
       ]
 
 instance Arbitrary PPurpose where
-  arbitrary = PRef2 <$> arbitrary <*> arbitrary <*> arbitrary <*> listOf safeText
+  arbitrary = PPurpose <$> arbitrary <*> arbitrary <*> arbitrary <*> listOf safeText
 
 instance Arbitrary PRef2Obj where
   arbitrary =
@@ -534,15 +551,19 @@ instance Arbitrary P_Concept where
 instance Arbitrary P_Sign where
   arbitrary =
     P_Sign
-      <$> arbitrary `suchThat` noLabel
-      <*> arbitrary `suchThat` noLabel
+      <$> arbitrary
+      `suchThat` noLabel
+      <*> arbitrary
+      `suchThat` noLabel
 
 instance Arbitrary PClassify where
   arbitrary =
     PClassify
       <$> arbitrary
-      <*> arbitrary `suchThat` notIsOneAndnoLabel
-      <*> arbitrary `suchThat` all notIsOneAndnoLabel
+      <*> arbitrary
+      `suchThat` notIsOneAndnoLabel
+      <*> arbitrary
+      `suchThat` all notIsOneAndnoLabel
 
 instance Arbitrary Lang where
   arbitrary = elements [minBound ..]

From af98a8a327b421bdee272545dbe0e65df83ccf8d Mon Sep 17 00:00:00 2001
From: hanjoosten <han.joosten@ordina.nl>
Date: Tue, 9 Apr 2024 15:57:16 +0200
Subject: [PATCH 07/43] iso8601DateFormat was deprecated

---
 src/Ampersand/Core/AbstractSyntaxTree.hs | 12 ++++++------
 1 file changed, 6 insertions(+), 6 deletions(-)

diff --git a/src/Ampersand/Core/AbstractSyntaxTree.hs b/src/Ampersand/Core/AbstractSyntaxTree.hs
index ed0d7af89..7045b0675 100644
--- a/src/Ampersand/Core/AbstractSyntaxTree.hs
+++ b/src/Ampersand/Core/AbstractSyntaxTree.hs
@@ -1498,14 +1498,14 @@ unsafePAtomVal2AtomValue typ mCpt pav =
             AAVDateTime t x ->
               -- Rounding is needed, to maximize the number of databases
               -- on wich this runs. (MySQL 5.5 only knows seconds)
-              AAVDateTime t (truncateByFormat x)
+              AAVDateTime t roundBySeconds
               where
-                truncateByFormat :: UTCTime -> UTCTime
-                truncateByFormat = f (parseTimeOrError True) . f formatTime
+                picosecondsInASecond = 1000000000000
+                roundBySeconds :: UTCTime
+                roundBySeconds = x {utctDayTime = rounded (utctDayTime x)}
                   where
-                    format = iso8601DateFormat (Just "%H:%M:%S")
-                    --    f:: TimeLocale -> Text -> typ
-                    f fun = fun defaultTimeLocale format
+                    rounded :: DiffTime -> DiffTime
+                    rounded = picosecondsToDiffTime . quot picosecondsInASecond . diffTimeToPicoseconds
             _ -> rawVal
   where
     unsafePAtomVal2AtomValue' :: Either Text AAtomValue

From bd98bb6096c7f68b75feb99152d2d246cd0d9ddb Mon Sep 17 00:00:00 2001
From: hanjoosten <han.joosten@ordina.nl>
Date: Wed, 10 Apr 2024 17:13:18 +0200
Subject: [PATCH 08/43] Use stack 2.15.5

---
 .devcontainer/DockerfileUpstream | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/.devcontainer/DockerfileUpstream b/.devcontainer/DockerfileUpstream
index b8d0ac5e1..0e2c8a679 100644
--- a/.devcontainer/DockerfileUpstream
+++ b/.devcontainer/DockerfileUpstream
@@ -63,7 +63,7 @@ ENV PATH="${WDIR}/.cabal/bin:${WDIR}/.ghcup/bin:${PATH}:${WDIR}/.local/bin:${PAT
 ARG GHC=9.6.4
 ARG CABAL=3.10.2.1
 ARG HLS=2.7.0.0
-ARG STACK=2.13.1
+ARG STACK=2.15.5
 
 # install GHC and cabal
 

From d5aed4a4c715784545e44d9293247654b35487d1 Mon Sep 17 00:00:00 2001
From: hanjoosten <han.joosten@ordina.nl>
Date: Wed, 10 Apr 2024 19:04:50 +0200
Subject: [PATCH 09/43] adapt to new version of xlsx library

---
 src/Ampersand/Input/Xslx/XLSX.hs        | 200 ++++++++++++------------
 src/Ampersand/Output/Population2Xlsx.hs |  17 +-
 2 files changed, 113 insertions(+), 104 deletions(-)

diff --git a/src/Ampersand/Input/Xslx/XLSX.hs b/src/Ampersand/Input/Xslx/XLSX.hs
index 9b6b2f4e3..2c2110b0e 100644
--- a/src/Ampersand/Input/Xslx/XLSX.hs
+++ b/src/Ampersand/Input/Xslx/XLSX.hs
@@ -215,13 +215,13 @@ addRelations pCtx = enrichedContext
     signatur :: P_Relation -> (Name, P_Sign)
     signatur rel = (name rel, dec_sign rel)
     concepts =
-      L.nub $
-        [PCpt (name pop) Nothing | pop@P_CptPopu {} <- ctx_pops pCtx]
-          <> [src' | P_RelPopu {p_src = src} <- ctx_pops pCtx, Just src' <- [src]]
-          <> [tgt' | P_RelPopu {p_tgt = tgt} <- ctx_pops pCtx, Just tgt' <- [tgt]]
-          <> map sourc declaredRelations
-          <> map targt declaredRelations
-          <> concat [specific gen : NE.toList (generics gen) | gen <- ctx_gs pCtx]
+      L.nub
+        $ [PCpt (name pop) Nothing | pop@P_CptPopu {} <- ctx_pops pCtx]
+        <> [src' | P_RelPopu {p_src = src} <- ctx_pops pCtx, Just src' <- [src]]
+        <> [tgt' | P_RelPopu {p_tgt = tgt} <- ctx_pops pCtx, Just tgt' <- [tgt]]
+        <> map sourc declaredRelations
+        <> map targt declaredRelations
+        <> concat [specific gen : NE.toList (generics gen) | gen <- ctx_gs pCtx]
     pops = computeConceptPopulations (ctx_pops pCtx <> [p | pat <- ctx_pats pCtx, p <- pt_pop pat]) -- All populations defined in this context, from POPULATION statements as well as from Relation declarations.
     computeConceptPopulations :: [P_Population] -> [P_Population]
     computeConceptPopulations pps -- I feel this computation should be done in P2A_Converters.hs, so every A_structure has compliant populations.
@@ -230,20 +230,20 @@ addRelations pCtx = enrichedContext
           { pos = OriginUnknown,
             p_cpt = c,
             p_popas =
-              L.nub $
-                [atom | cpt@P_CptPopu {} <- pps, name cpt == name c, atom <- p_popas cpt]
-                  <> [ ppLeft pair
-                       | pop@P_RelPopu {p_src = src} <- pps,
-                         Just src' <- [src],
-                         src' == c,
-                         pair <- p_popps pop
-                     ]
-                  <> [ ppRight pair
-                       | pop@P_RelPopu {p_tgt = tgt} <- pps,
-                         Just tgt' <- [tgt],
-                         tgt' == c,
-                         pair <- p_popps pop
-                     ]
+              L.nub
+                $ [atom | cpt@P_CptPopu {} <- pps, name cpt == name c, atom <- p_popas cpt]
+                <> [ ppLeft pair
+                     | pop@P_RelPopu {p_src = src} <- pps,
+                       Just src' <- [src],
+                       src' == c,
+                       pair <- p_popps pop
+                   ]
+                <> [ ppRight pair
+                     | pop@P_RelPopu {p_tgt = tgt} <- pps,
+                       Just tgt' <- [tgt],
+                       tgt' == c,
+                       pair <- p_popps pop
+                   ]
           }
         | c <- concepts
       ]
@@ -256,35 +256,34 @@ addRelations pCtx = enrichedContext
 data SheetCellsForTable = Mapping
   { theSheetName :: Text,
     theCellMap :: CellMap,
-    headerRowNrs :: [Int], -- The row numbers of the table header
-    popRowNrs :: [Int], -- The row numbers of the population
-    colNrs :: [Int], -- The column numbers that contain a relation
+    headerRowNrs :: [RowIndex], -- The row numbers of the table header
+    popRowNrs :: [RowIndex], -- The row numbers of the population
+    colNrs :: [ColumnIndex], -- The column numbers that contain a relation
     debugInfo :: [Text]
   }
 
-instance Show SheetCellsForTable where --for debugging only
+instance Show SheetCellsForTable where -- for debugging only
   show x =
-    T.unpack . T.unlines $
-      [ "Sheet       : " <> theSheetName x,
-        "headerRowNrs: " <> tshow (headerRowNrs x),
-        "popRowNrs   : " <> tshow (popRowNrs x),
-        "colNrs      : " <> tshow (colNrs x)
-      ]
-        <> debugInfo x
+    T.unpack
+      . T.unlines
+      $ [ "Sheet       : " <> theSheetName x,
+          "headerRowNrs: " <> tshow (headerRowNrs x),
+          "popRowNrs   : " <> tshow (popRowNrs x),
+          "colNrs      : " <> tshow (colNrs x)
+        ]
+      <> debugInfo x
 
 toPops ::
   (HasFSpecGenOpts env) =>
-  -- |
   env ->
   NameSpace ->
   -- | The file name is needed for displaying errors in context
   FilePath ->
-  -- |
   SheetCellsForTable ->
   [P_Population]
 toPops env ns file x = map popForColumn (colNrs x)
   where
-    popForColumn :: Int -> P_Population
+    popForColumn :: ColumnIndex -> P_Population
     popForColumn i =
       if i == sourceCol
         then
@@ -315,10 +314,12 @@ toPops env ns file x = map popForColumn (colNrs x)
         mkPConcept' nm = mkPConcept nm Nothing
         popOrigin :: Origin
         popOrigin = originOfCell (relNamesRow, targetCol)
+        relNamesRow, conceptNamesRow :: RowIndex
         (relNamesRow, conceptNamesRow) = case headerRowNrs x of
           [] -> fatal "headerRowNrs x is empty"
           [rnr] -> (rnr, fatal "headerRowNrs x has only one element")
           rnr : cnr : _ -> (rnr, cnr)
+        sourceCol :: ColumnIndex
         sourceCol = case colNrs x of
           [] -> fatal "colNrs x is empty"
           c : _ -> c
@@ -365,27 +366,27 @@ toPops env ns file x = map popForColumn (colNrs x)
             _ -> fatal ("No valid relation name found. This should have been checked before" <> tshow (relNamesRow, targetCol))
         thePairs :: [PAtomPair]
         thePairs = concat . mapMaybe pairsAtRow . popRowNrs $ x
-        pairsAtRow :: Int -> Maybe [PAtomPair]
+        pairsAtRow :: RowIndex -> Maybe [PAtomPair]
         pairsAtRow r = case ( value (r, sourceCol),
                               value (r, targetCol)
                             ) of
           (Just s, Just t) ->
-            Just $
-              (if isFlipped' then map flp else id)
+            Just
+              $ (if isFlipped' then map flp else id)
                 [ mkPair origTrg s' t'
                   | s' <- cellToAtomValues mSourceConceptDelimiter s origSrc,
                     t' <- cellToAtomValues mTargetConceptDelimiter t origTrg
                 ]
           _ -> Nothing
           where
-            origSrc = XLSXLoc file (theSheetName x) (r, sourceCol)
-            origTrg = XLSXLoc file (theSheetName x) (r, targetCol)
+            origSrc = XLSXLoc file (theSheetName x) (unRowIndex r, unColumnIndex sourceCol)
+            origTrg = XLSXLoc file (theSheetName x) (unRowIndex r, unColumnIndex targetCol)
         cellToAtomValues ::
-          -- | the delimiter, if there is any, used as seperator for multiple values in the cell
+          -- \| the delimiter, if there is any, used as seperator for multiple values in the cell
           Maybe Char ->
-          -- | The value that is read from the cell
+          -- \| The value that is read from the cell
           CellValue ->
-          -- | the origin of the value.
+          -- \| the origin of the value.
           Origin ->
           [PAtomValue]
         cellToAtomValues mDelimiter cv orig =
@@ -407,11 +408,12 @@ toPops env ns file x = map popForColumn (colNrs x)
                 . map _richTextRunText
                 $ ts
             CellError e ->
-              fatal . T.intercalate "\n  " $
-                [ "Error reading cell at:",
-                  tshow orig,
-                  tshow e
-                ]
+              fatal
+                . T.intercalate "\n  "
+                $ [ "Error reading cell at:",
+                    tshow orig,
+                    tshow e
+                  ]
         unDelimit :: Maybe Char -> Text -> [Text]
         unDelimit mDelimiter xs =
           case mDelimiter of
@@ -419,68 +421,71 @@ toPops env ns file x = map popForColumn (colNrs x)
             (Just delimiter) -> map trim $ T.split (== delimiter) xs
         handleSpaces = if view trimXLSXCellsL env then trim else id
     originOfCell ::
-      (Int, Int) -> -- (row number,col number)
+      CellIndex -> -- (row number,col number)
       Origin
     originOfCell (r, c) =
-      XLSXLoc file (theSheetName x) (r, c)
+      XLSXLoc file (theSheetName x) (unRowIndex r, unColumnIndex c)
 
-    value :: (Int, Int) -> Maybe CellValue
+    value :: CellIndex -> Maybe CellValue
     value k = theCellMap x ^? ix k . cellValue . _Just
 
+type CellIndex = (RowIndex, ColumnIndex)
+
 -- This function processes one Excel worksheet and yields every "wide table" (a block of lines in the excel sheet) as a SheetCellsForTable
 theSheetCellsForTable :: NameSpace -> (Text, Worksheet) -> [SheetCellsForTable]
 theSheetCellsForTable ns (sheetName, ws) =
-  catMaybes [theMapping i | i <- [0 .. length tableStarters - 1]]
+  catMaybes [theMapping (RowIndex i) | i <- [0 .. length tableStarters - 1]]
   where
-    tableStarters :: [(Int, Int)]
+    tableStarters :: [CellIndex]
     tableStarters = filter isStartOfTable $ Map.keys (ws ^. wsCells)
       where
-        isStartOfTable :: (Int, Int) -> Bool
+        isStartOfTable :: CellIndex -> Bool
         isStartOfTable (rowNr, colNr)
           | colNr /= 1 = False
           | rowNr == 1 = isBracketed' (rowNr, colNr)
           | otherwise =
-            isBracketed' (rowNr, colNr)
-              && (not . isBracketed') (rowNr - 1, colNr)
+              isBracketed' (rowNr, colNr)
+                && (not . isBracketed') (rowNr - 1, colNr)
 
-    value :: (Int, Int) -> Maybe CellValue
+    value :: CellIndex -> Maybe CellValue
     value k = (ws ^. wsCells) ^? ix k . cellValue . _Just
-    isBracketed' :: (Int, Int) -> Bool
+    isBracketed' :: CellIndex -> Bool
     isBracketed' k =
       case value k of
         Just (CellText t) -> isBracketed t
         _ -> False
 
-    theMapping :: Int -> Maybe SheetCellsForTable
+    theMapping :: RowIndex -> Maybe SheetCellsForTable
     theMapping indexInTableStarters
-      | length okHeaderRows /= nrOfHeaderRows = Nothing -- Because there are not enough header rows
+      | length okHeaderRows /= unRowIndex nrOfHeaderRows = Nothing -- Because there are not enough header rows
       | otherwise =
-        Just
-          Mapping
-            { theSheetName = sheetName,
-              theCellMap = ws ^. wsCells,
-              headerRowNrs = okHeaderRows,
-              popRowNrs = populationRows,
-              colNrs = theCols,
-              debugInfo =
-                [ "indexInTableStarters: " <> tshow indexInTableStarters,
-                  "maxRowOfWorksheet   : " <> tshow maxRowOfWorksheet,
-                  "maxColOfWorksheet   : " <> tshow maxColOfWorksheet,
-                  "startOfTable        : " <> tshow startOfTable,
-                  "firstPopRowNr       : " <> tshow firstPopRowNr,
-                  "lastPopRowNr        : " <> tshow lastPopRowNr,
-                  "[(row,isProperRow)] : " <> T.concat [tshow (r, isProperRow r) | r <- [firstPopRowNr .. lastPopRowNr]],
-                  "theCols             : " <> tshow theCols
-                ]
-            }
+          Just
+            Mapping
+              { theSheetName = sheetName,
+                theCellMap = ws ^. wsCells,
+                headerRowNrs = okHeaderRows,
+                popRowNrs = populationRows,
+                colNrs = theCols,
+                debugInfo =
+                  [ "indexInTableStarters: " <> tshow indexInTableStarters,
+                    "maxRowOfWorksheet   : " <> tshow maxRowOfWorksheet,
+                    "maxColOfWorksheet   : " <> tshow maxColOfWorksheet,
+                    "startOfTable        : " <> tshow startOfTable,
+                    "firstPopRowNr       : " <> tshow firstPopRowNr,
+                    "lastPopRowNr        : " <> tshow lastPopRowNr,
+                    "[(row,isProperRow)] : " <> T.concat [tshow (r, isProperRow r) | r <- [firstPopRowNr .. lastPopRowNr]],
+                    "theCols             : " <> tshow theCols
+                  ]
+              }
       where
         startOfTable = tableStarters `L.genericIndex` indexInTableStarters
         firstHeaderRowNr = fst startOfTable
         firstColumNr = snd startOfTable
         relationNameRowNr = firstHeaderRowNr
         conceptNameRowNr = firstHeaderRowNr + 1
+        nrOfHeaderRows :: RowIndex
         nrOfHeaderRows = 2
-        maxRowOfWorksheet :: Int
+        maxRowOfWorksheet :: RowIndex
         maxRowOfWorksheet = case L.maximumMaybe (map fst (Map.keys (ws ^. wsCells))) of
           Nothing -> fatal "Maximum of an empty list is not defined!"
           Just m -> m
@@ -488,10 +493,10 @@ theSheetCellsForTable ns (sheetName, ws) =
           Nothing -> fatal "Maximum of an empty list is not defined!"
           Just m -> m
         firstPopRowNr = firstHeaderRowNr + nrOfHeaderRows
-        lastPopRowNr = ((map fst tableStarters <> [maxRowOfWorksheet + 1]) `L.genericIndex` (indexInTableStarters + 1)) -1
-        okHeaderRows = filter isProperRow [firstHeaderRowNr, firstHeaderRowNr + nrOfHeaderRows -1]
+        lastPopRowNr = ((map fst tableStarters <> [maxRowOfWorksheet + 1]) `L.genericIndex` (indexInTableStarters + 1)) - 1
+        okHeaderRows = filter isProperRow [firstHeaderRowNr, firstHeaderRowNr + nrOfHeaderRows - 1]
         populationRows = filter isProperRow [firstPopRowNr .. lastPopRowNr]
-        isProperRow :: Int -> Bool
+        isProperRow :: RowIndex -> Bool
         isProperRow rowNr
           | rowNr == relationNameRowNr = True -- The first row was recognized as tableStarter
           | rowNr == conceptNameRowNr = isProperConceptName (rowNr, firstColumNr)
@@ -505,7 +510,7 @@ theSheetCellsForTable ns (sheetName, ws) =
             Just (CellError e) -> fatal $ "Error reading cell " <> tshow e
             Nothing -> False
         theCols = filter isProperCol [1 .. maxColOfWorksheet]
-        isProperCol :: Int -> Bool
+        isProperCol :: ColumnIndex -> Bool
         isProperCol colNr
           | colNr == 1 = isProperConceptName (conceptNameRowNr, colNr)
           | otherwise = isProperConceptName (conceptNameRowNr, colNr) && isProperRelName (relationNameRowNr, colNr)
@@ -531,25 +536,26 @@ conceptNameWithOptionalDelimiter ::
 --  Where Conceptname is any string starting with an uppercase character
 conceptNameWithOptionalDelimiter ns t'
   | isBracketed t =
-    let mid = T.dropEnd 1 . T.drop 1 $ t
-     in case T.uncons . T.reverse $ mid of
-          Nothing -> Nothing
-          Just (d, revInit) ->
-            let nm = T.reverse revInit
-             in if isDelimiter d && isConceptName nm
-                  then Just (mkName' nm, Just d)
-                  else Nothing
+      let mid = T.dropEnd 1 . T.drop 1 $ t
+       in case T.uncons . T.reverse $ mid of
+            Nothing -> Nothing
+            Just (d, revInit) ->
+              let nm = T.reverse revInit
+               in if isDelimiter d && isConceptName nm
+                    then Just (mkName' nm, Just d)
+                    else Nothing
   | isConceptName t = Just (mkName' t, Nothing)
   | otherwise = Nothing
   where
     t = trim t'
     mkName' x =
-      withNameSpace ns . mkName ConceptName $
-        ( case toNamePart x of
-            Nothing -> fatal $ "Not a valid NamePart: " <> tshow x
-            Just np -> np
-        )
-          :| []
+      withNameSpace ns
+        . mkName ConceptName
+        $ ( case toNamePart x of
+              Nothing -> fatal $ "Not a valid NamePart: " <> tshow x
+              Just np -> np
+          )
+        :| []
 
 isDelimiter :: Char -> Bool
 isDelimiter = isPunctuation
diff --git a/src/Ampersand/Output/Population2Xlsx.hs b/src/Ampersand/Output/Population2Xlsx.hs
index 3dad42499..9086cafc0 100644
--- a/src/Ampersand/Output/Population2Xlsx.hs
+++ b/src/Ampersand/Output/Population2Xlsx.hs
@@ -27,10 +27,13 @@ plugs2Sheets fSpec = mapMaybe plug2sheet $ plugInfos fSpec
         sheet :: Maybe Worksheet
         sheet = case matrix of
           Nothing -> Nothing
-          Just m -> Just def {_wsCells = fromRows . numberList . map numberList $ m}
+          Just m -> Just def {_wsCells = fromRows . rowsToMatrix . map cellsToRow $ m}
           where
-            numberList :: [c] -> [(Int, c)]
-            numberList = zip [1 ..]
+            cellsToRow :: [Cell] -> [(ColumnIndex, Cell)]
+            cellsToRow = zip [ColumnIndex 1 ..]
+            -- rowsToMatrix :: [[(ColumnIndex, Cell)]] -> [(RowIndex, (ColumnIndex, Cell))]
+            rowsToMatrix :: [b] -> [(RowIndex, b)]
+            rowsToMatrix = zip [RowIndex 1 ..]
         matrix :: Maybe [[Cell]]
         matrix =
           case plug of
@@ -50,8 +53,8 @@ plugs2Sheets fSpec = mapMaybe plug2sheet $ plugInfos fSpec
                     [ if isFirstField -- In case of the first field of the table, we put the fieldname inbetween brackets,
                     -- to be able to find the population again by the reader of the .xlsx file
                         then Just $ "[" <> (sqlColumNameToText . attSQLColName $ att) <> "]"
-                        else Just $
-                          case plug of
+                        else Just
+                          $ case plug of
                             TblSQL {} -> sqlColumNameToText . attSQLColName $ att
                             BinSQL {} -> sqlColumNameToText . sqlname $ plug,
                       Just . fullName . target . attExpr $ att
@@ -65,8 +68,8 @@ plugs2Sheets fSpec = mapMaybe plug2sheet $ plugInfos fSpec
                 { _cellStyle = Nothing,
                   _cellValue = case mVal of
                     Nothing -> Nothing
-                    Just aVal -> Just $
-                      case aVal of
+                    Just aVal -> Just
+                      $ case aVal of
                         AAVString {} -> CellText $ aavtxt aVal
                         AAVInteger _ int -> CellDouble (fromInteger int)
                         AAVFloat _ x -> CellDouble x

From 44319be5545c1714c3c3f78fb3945cb8565e4335 Mon Sep 17 00:00:00 2001
From: hanjoosten <han.joosten@ordina.nl>
Date: Thu, 11 Apr 2024 10:39:15 +0200
Subject: [PATCH 10/43] Adaption to new version of simple-sql-parser

---
 src/Ampersand/FSpec/FSpec.hs                  |  24 +-
 src/Ampersand/FSpec/SQL.hs                    | 579 +++++++++---------
 src/Ampersand/Output/Population2Xlsx.hs       |   8 +-
 .../Output/ToPandoc/SharedAmongChapters.hs    |  51 +-
 4 files changed, 342 insertions(+), 320 deletions(-)

diff --git a/src/Ampersand/FSpec/FSpec.hs b/src/Ampersand/FSpec/FSpec.hs
index a4e496d05..6abd5d2b5 100644
--- a/src/Ampersand/FSpec/FSpec.hs
+++ b/src/Ampersand/FSpec/FSpec.hs
@@ -24,9 +24,7 @@ module Ampersand.FSpec.FSpec
     metaValues,
     SqlAttribute (..),
     SqlName,
-    sqlColumNameToString,
     sqlColumNameToText1,
-    sqlColumNameToText,
     text1ToSqlName,
     isPrimaryKey,
     isForeignKey,
@@ -170,7 +168,7 @@ instance Eq FSpec where
 instance Unique FSpec where
   showUnique = maybe fatalmsg showUnique . originalContext
     where
-      fatalmsg = fatal "showUnique is not expected to be called on an FSpec derived from a module. " --TODO: Either make sure that this is te case, or fix it. See https://github.com/AmpersandTarski/Ampersand/issues/1307
+      fatalmsg = fatal "showUnique is not expected to be called on an FSpec derived from a module. " -- TODO: Either make sure that this is te case, or fix it. See https://github.com/AmpersandTarski/Ampersand/issues/1307
 
 metaValues :: Text1 -> FSpec -> [Text]
 metaValues key fSpec = [mtVal m | m <- metas fSpec, mtName m == key]
@@ -189,7 +187,7 @@ instance Hashable FSpec where
       `composeHash` (L.sort . fmap conceptAndTType . Set.toList . allConcepts)
       `composeHash` (L.sortBy (compare `on` genspc) . vgens)
     where
-      composeHash :: Hashable a => Int -> (FSpec -> a) -> Int
+      composeHash :: (Hashable a) => Int -> (FSpec -> a) -> Int
       composeHash s fun = s `hashWithSalt` fun fSpec
       conceptAndTType :: A_Concept -> (A_Concept, TType)
       conceptAndTType cpt = (cpt, cptTType fSpec cpt)
@@ -284,7 +282,7 @@ dnf2expr dnf =
 newtype PlugInfo = InternalPlug PlugSQL
   deriving (Show, Eq, Typeable)
 
---instance Named PlugInfo where
+-- instance Named PlugInfo where
 --  name (InternalPlug psql) = name psql
 
 instance Unique PlugInfo where
@@ -331,7 +329,7 @@ data PlugSQL
       }
   deriving (Show, Typeable)
 
---instance Named PlugSQL where
+-- instance Named PlugSQL where
 --  name = sqlname
 
 instance Eq PlugSQL where
@@ -352,9 +350,9 @@ plugAttributes plug = case plug of
     let store = case dLkpTbl plug of
           [x] -> x
           _ ->
-            fatal $
-              "Relation lookup table of a binary table should contain exactly one element:\n"
-                <> tshow (dLkpTbl plug)
+            fatal
+              $ "Relation lookup table of a binary table should contain exactly one element:\n"
+              <> tshow (dLkpTbl plug)
      in rsSrcAtt store NE.:| [rsTrgAtt store]
 
 -- | This returns all column/table pairs that serve as a concept table for cpt. When adding/removing atoms, all of these
@@ -401,17 +399,11 @@ instance Eq SqlName where
   a == b = compare a b == EQ
 
 instance Show SqlName where
-  show = sqlColumNameToString
-
-sqlColumNameToString :: SqlName -> String
-sqlColumNameToString = T.unpack . sqlColumNameToText
+  show (SqlName t) = show t
 
 sqlColumNameToText1 :: SqlName -> Text1
 sqlColumNameToText1 (SqlName t) = t
 
-sqlColumNameToText :: SqlName -> Text
-sqlColumNameToText = text1ToText . sqlColumNameToText1
-
 text1ToSqlName :: Text1 -> SqlName
 text1ToSqlName = SqlName
 
diff --git a/src/Ampersand/FSpec/SQL.hs b/src/Ampersand/FSpec/SQL.hs
index 3fa6523f5..791e3dd93 100644
--- a/src/Ampersand/FSpec/SQL.hs
+++ b/src/Ampersand/FSpec/SQL.hs
@@ -17,9 +17,10 @@ import Ampersand.Classes
 import Ampersand.Core.ShowAStruct
 import Ampersand.FSpec.FSpec
 import Ampersand.FSpec.FSpecAux
+import Language.SQL.SimpleSQL.Dialect
 import Language.SQL.SimpleSQL.Pretty
 import Language.SQL.SimpleSQL.Syntax
-import RIO.List (intercalate, lastMaybe, maximumMaybe, nub, partition, (\\))
+import RIO.List (lastMaybe, maximumMaybe, nub, partition, (\\))
 import qualified RIO.NonEmpty as NE
 import qualified RIO.Text as T
 
@@ -33,8 +34,8 @@ placeHolderSQL = "_SRCATOM"
 
 broadQueryWithPlaceholder :: FSpec -> ObjectDef -> Text
 broadQueryWithPlaceholder fSpec =
-  T.unwords . T.words
-    . T.pack
+  T.unwords
+    . T.words
     . prettyQueryExpr theDialect
     . broadQuery fSpec
 
@@ -42,7 +43,6 @@ prettyBroadQueryWithPlaceholder :: Int -> FSpec -> ObjectDef -> Text
 prettyBroadQueryWithPlaceholder i fSpec =
   T.intercalate ("\n" <> T.replicate i " ")
     . T.lines
-    . T.pack
     . prettyQueryExpr theDialect
     . broadQuery fSpec
 
@@ -61,8 +61,8 @@ class SQLAble a where
 
   doNonPretty :: (FSpec -> a -> BinQueryExpr) -> FSpec -> a -> Text
   doNonPretty fun fSpec =
-    T.unwords . T.words
-      . T.pack
+    T.unwords
+      . T.words
       . prettyQueryExpr theDialect
       . toSQL
       . stripComment
@@ -80,9 +80,8 @@ class SQLAble a where
   doPretty fun i fSpec =
     SqlQueryPretty
       . T.lines
-      . T.pack
-      . intercalate ("\n" <> replicate i ' ')
-      . lines
+      . T.intercalate ("\n" <> T.replicate i " ")
+      . T.lines
       . prettyQueryExpr theDialect
       . toSQL
       . fun fSpec
@@ -94,12 +93,12 @@ class SQLAble a where
       insertPlaceholder :: BinQueryExpr -> BinQueryExpr
       insertPlaceholder bqe =
         case bqe of
-          BSE {} -> case (col2ValueExpr (bseSrc bqe), bseWhr bqe) of
+          BSE {} -> case (col2ScalarExpr (bseSrc bqe), bseWhr bqe) of
             (Iden [_], _) ->
               bqeWithPlaceholder
             (Iden [_, a], _)
               | a == sourceAlias ->
-                bqeWithPlaceholder
+                  bqeWithPlaceholder
               | otherwise -> bqeWithoutPlaceholder
             _ -> bqeWithoutPlaceholder
           BCQE {} ->
@@ -118,12 +117,12 @@ class SQLAble a where
                 bseSrc = bseSrc bqe,
                 bseTrg = bseTrg bqe,
                 bseTbl = bseTbl bqe,
-                bseWhr = Just $
-                  case bseWhr bqe of
+                bseWhr = Just
+                  $ case bseWhr bqe of
                     Nothing -> placeHolder
                     Just whr -> conjunctSQL [placeHolder, whr]
               }
-          placeHolder = BinOp (col2ValueExpr (bseSrc bqe)) [Name "="] (StringLit $ T.unpack placeHolderSQL)
+          placeHolder = BinOp (col2ScalarExpr (bseSrc bqe)) [uName "="] (stringLit placeHolderSQL)
 
 instance SQLAble Expression where
   getBinQueryExpr fSpec = setDistinct . selectExpr fSpec
@@ -132,8 +131,8 @@ instance SQLAble Relation where
   getBinQueryExpr = selectRelation
 
 sourceAlias, targetAlias :: Name
-sourceAlias = Name "src"
-targetAlias = Name "tgt"
+sourceAlias = uName "src"
+targetAlias = uName "tgt"
 
 selectExpr ::
   FSpec -> -- current context
@@ -148,8 +147,8 @@ selectExpr ::
   -- Code for the Kleene operators EKl0 ( * ) and EKl1 ( + ) is not done, because this cannot be expressed in SQL.
   -- These operators must be eliminated from the Expression before using selectExpr, or else you will get fatals.
 selectExpr fSpec expr =
-  traceExprComment expr [tshow expr] $
-    fromMaybe (nonSpecialSelectExpr fSpec expr) (maybeSpecialCase fSpec expr) --special cases for optimized results.
+  traceExprComment expr [tshow expr]
+    $ fromMaybe (nonSpecialSelectExpr fSpec expr) (maybeSpecialCase fSpec expr) -- special cases for optimized results.
 
 -- Special cases for optimized SQL generation
 -- Sometimes it is possible to generate queries that perform better. If this is the case for some
@@ -159,31 +158,31 @@ maybeSpecialCase fSpec expr =
   case expr of
     EIsc (EDcI a, ECpl (ECps (EDcD r, EFlp (EDcD r')))) -- I[A] /\ -(r;r~)
       | r == r' ->
-        Just
-          . traceComment
-            [ "case: EIsc (EDcI a, ECpl (ECps (EDcD r,EFlp (EDcD r')) ))",
-              "  this is an optimized case for: " <> tshow r <> " [TOT]."
-            ]
-          $ let col =
-                  Col
-                    { cTable = [Name "notIns"],
-                      cCol = [sqlAttConcept fSpec a],
-                      cAlias = [],
-                      cSpecial = Nothing
+          Just
+            . traceComment
+              [ "case: EIsc (EDcI a, ECpl (ECps (EDcD r,EFlp (EDcD r')) ))",
+                "  this is an optimized case for: " <> tshow r <> " [TOT]."
+              ]
+            $ let col =
+                    Col
+                      { cTable = [uName "notIns"],
+                        cCol = [sqlAttConcept fSpec a],
+                        cAlias = [],
+                        cSpecial = Nothing
+                      }
+                  aAtt = col2ScalarExpr col
+                  whereClause =
+                    conjunctSQL
+                      [ aAtt `isNotIn` selectSource (selectExpr fSpec (EDcD r)),
+                        notNull aAtt
+                      ]
+               in BSE
+                    { bseSetQuantifier = SQDefault,
+                      bseSrc = col,
+                      bseTrg = col,
+                      bseTbl = [sqlConceptTable fSpec a `as` uName "notIns"],
+                      bseWhr = Just whereClause
                     }
-                aAtt = col2ValueExpr col
-                whereClause =
-                  conjunctSQL
-                    [ aAtt `isNotIn` selectSource (selectExpr fSpec (EDcD r)),
-                      notNull aAtt
-                    ]
-             in BSE
-                  { bseSetQuantifier = SQDefault,
-                    bseSrc = col,
-                    bseTrg = col,
-                    bseTbl = [sqlConceptTable fSpec a `as` Name "notIns"],
-                    bseWhr = Just whereClause
-                  }
       | otherwise -> Nothing
     EIsc (ECpl (ECps (EDcD r, EFlp (EDcD r'))), EDcI a) -- -(r;r~) /\ I[A]
       | r == r' -> maybeSpecialCase fSpec $ EIsc (EDcI a, ECpl (ECps (EDcD r, EFlp (EDcD r'))))
@@ -240,17 +239,20 @@ maybeSpecialCase fSpec expr =
                   False -- Needs to be false in MySql
                   JLeft
                   leftTable
-                  ( Just . JoinOn . conjunctSQL $
-                      [ BinOp (Iden [table1, sourceAlias]) [Name "="] (Iden [table2, expr2Src]),
-                        BinOp (Iden [table1, targetAlias]) [Name "="] (Iden [table2, expr2trg])
-                      ]
+                  ( Just
+                      . JoinOn
+                      . conjunctSQL
+                      $ [ BinOp (Iden [table1, sourceAlias]) [uName "="] (Iden [table2, expr2Src]),
+                          BinOp (Iden [table1, targetAlias]) [uName "="] (Iden [table2, expr2trg])
+                        ]
                   )
               ],
             bseWhr =
-              Just . disjunctSQL $
-                [ isNull (Iden [table2, expr2Src]),
-                  isNull (Iden [table2, expr2trg])
-                ]
+              Just
+                . disjunctSQL
+                $ [ isNull (Iden [table2, expr2Src]),
+                    isNull (Iden [table2, expr2trg])
+                  ]
           }
       where
         fun = if isFlipped' then flp else id
@@ -258,9 +260,9 @@ maybeSpecialCase fSpec expr =
           case expr2 of
             EDcD rel ->
               let (plug, relstore) = getRelationTableInfo fSpec rel
-                  s = QName . sqlColumNameToString . attSQLColName . rsSrcAtt $ relstore
-                  t = QName . sqlColumNameToString . attSQLColName . rsTrgAtt $ relstore
-                  lt = TRSimple [QName (T.unpack . text1ToText . showUnique $ plug)] `as` table2
+                  s = qName . tshow . attSQLColName . rsSrcAtt $ relstore
+                  t = qName . tshow . attSQLColName . rsTrgAtt $ relstore
+                  lt = TRSimple [qName (text1ToText . showUnique $ plug)] `as` table2
                in if isFlipped'
                     then (t, s, lt)
                     else (s, t, lt)
@@ -269,8 +271,8 @@ maybeSpecialCase fSpec expr =
                 targetAlias,
                 TRQueryExpr (toSQL (selectExpr fSpec (fun expr2))) `as` table2
               )
-        table1 = Name "t1"
-        table2 = Name "t2"
+        table1 = uName "t1"
+        table2 = uName "t2"
 
 nonSpecialSelectExpr :: FSpec -> Expression -> BinQueryExpr
 nonSpecialSelectExpr fSpec expr =
@@ -285,7 +287,7 @@ nonSpecialSelectExpr fSpec expr =
          -}
       case posVals of
         (_ {-a-} : _ {-b-} : _) ->
-          emptySet --since a /= b, there can be no result.
+          emptySet -- since a /= b, there can be no result.
         [val] ->
           if val `elem` negVals
             then emptySet
@@ -307,8 +309,8 @@ nonSpecialSelectExpr fSpec expr =
           [Expression] -> -- subexpressions of the intersection.  Mp1{} nor ECpl(Mp1{}) are allowed elements of this list.
           BinQueryExpr
         f specificValue subTerms =
-          traceComment ["case: EIsc{}"] $
-            case subTerms of
+          traceComment ["case: EIsc{}"]
+            $ case subTerms of
               [] -> case specificValue of
                 Nothing -> emptySet -- case might occur with only negMp1Terms??
                 Just singleton -> selectExpr fSpec (EMp1 singleton (source expr))
@@ -323,32 +325,33 @@ nonSpecialSelectExpr fSpec expr =
                       vs -> Just (conjunctSQL vs)
                   }
                 where
-                  mandatoryTuple :: Maybe ValueExpr
+                  mandatoryTuple :: Maybe ScalarExpr
                   mandatoryTuple =
                     case specificValue of
                       Nothing -> Nothing
                       Just val -> Just $ equalToValueClause val
                     where
-                      equalToValueClause :: PAtomValue -> ValueExpr
+                      equalToValueClause :: PAtomValue -> ScalarExpr
                       equalToValueClause singleton =
                         conjunctSQL
-                          [ BinOp (col2ValueExpr theSr') [Name "="] (singleton2SQL (source expr) singleton),
-                            BinOp (col2ValueExpr theTr') [Name "="] (singleton2SQL (source expr) singleton)
+                          [ BinOp (col2ScalarExpr theSr') [uName "="] (singleton2SQL (source expr) singleton),
+                            BinOp (col2ScalarExpr theTr') [uName "="] (singleton2SQL (source expr) singleton)
                           ]
 
-                  forbiddenTuples :: Maybe ValueExpr
+                  forbiddenTuples :: Maybe ScalarExpr
                   forbiddenTuples =
                     case negVals of
                       [] -> Nothing
                       _ ->
-                        Just . conjunctSQL $
-                          map notEqualToValueClause negVals
+                        Just
+                          . conjunctSQL
+                          $ map notEqualToValueClause negVals
                     where
-                      notEqualToValueClause :: PAtomValue -> ValueExpr
+                      notEqualToValueClause :: PAtomValue -> ScalarExpr
                       notEqualToValueClause singleton =
                         conjunctSQL
-                          [ BinOp (col2ValueExpr theSr') [Name "<>"] (singleton2SQL (source expr) singleton),
-                            BinOp (col2ValueExpr theTr') [Name "<>"] (singleton2SQL (source expr) singleton)
+                          [ BinOp (col2ScalarExpr theSr') [uName "<>"] (singleton2SQL (source expr) singleton),
+                            BinOp (col2ScalarExpr theTr') [uName "<>"] (singleton2SQL (source expr) singleton)
                           ]
 
                   theSr' = bseSrc (makeSelectable sResult)
@@ -359,7 +362,7 @@ nonSpecialSelectExpr fSpec expr =
                     BCQE {} -> fatal "makeSelectable is not doing what it is supposed to do!"
                     BQEComment {} -> fatal "makeSelectable is not doing what it is supposed to do!"
                   sResult = makeIntersectSelectExpr ts
-                  dummy = Name "someDummyNameBecauseMySQLNeedsOne"
+                  dummy = uName "someDummyNameBecauseMySQLNeedsOne"
                   makeSelectable :: BinQueryExpr -> BinQueryExpr
                   makeSelectable x =
                     case x of
@@ -424,21 +427,23 @@ nonSpecialSelectExpr fSpec expr =
                                                 cAlias = [],
                                                 cSpecial = Nothing
                                               },
-                                          bseTbl = [TRQueryExpr (toSQL part2) `as` Name "part2"],
+                                          bseTbl = [TRQueryExpr (toSQL part2) `as` uName "part2"],
                                           bseWhr =
-                                            Just . conjunctSQL $
-                                              [ BinOp (Iden [sourceAlias]) [Name "="] (Iden [targetAlias]),
-                                                In
-                                                  True
-                                                  (Iden [sourceAlias])
-                                                  ( InQueryExpr
-                                                      ( makeSelect
-                                                          { qeSelectList = [(Iden [sourceAlias], Nothing)],
-                                                            qeFrom = [TRQueryExpr (toSQL part1) `as` Name "part1"]
-                                                          }
-                                                      )
-                                                  )
-                                              ]
+                                            Just
+                                              . conjunctSQL
+                                              $ [ BinOp (Iden [sourceAlias]) [uName "="] (Iden [targetAlias]),
+                                                  In
+                                                    True
+                                                    (Iden [sourceAlias])
+                                                    ( InQueryExpr
+                                                        ( toQueryExpr
+                                                            $ makeSelect
+                                                              { msSelectList = [(Iden [sourceAlias], Nothing)],
+                                                                msFrom = [TRQueryExpr (toSQL part1) `as` uName "part1"]
+                                                              }
+                                                        )
+                                                    )
+                                                ]
                                         }
                             where
                               --    esI :: [(Expression,Name)] -- all conjunctions that are of the form I
@@ -450,14 +455,14 @@ nonSpecialSelectExpr fSpec expr =
                                   isR :: Expression -> Maybe (Expression, Name)
                                   isR e = case attInBroadQuery fSpec (source hexprs) e of
                                     Nothing -> Nothing
-                                    Just att -> Just (e, (QName . sqlColumNameToString . attSQLColName) att)
+                                    Just att -> Just (e, (qName . tshow . attSQLColName) att)
                               --    esRest :: [Expression] -- all other conjuctions
                               --    esRest = (exprs \\ (map fst esI)) \\ (map fst esR)
                               optimizedIntersectSelectExpr :: BinQueryExpr
                               optimizedIntersectSelectExpr =
                                 BQEComment
                                   [ BlockComment "Optimized intersection:",
-                                    BlockComment . T.unpack $ "   Expression: " <> (showA . foldr (./\.) hexprs $ tlexprs)
+                                    BlockComment $ "   Expression: " <> (showA . foldr (./\.) hexprs $ tlexprs)
                                   ]
                                   --    <>map (showComment "esI") esI
                                   --    <>map (showComment "esR") esR
@@ -480,12 +485,13 @@ nonSpecialSelectExpr fSpec expr =
                                           },
                                       bseTbl = [sqlConceptTable fSpec c],
                                       bseWhr =
-                                        Just . conjunctSQL $
-                                          [notNull (Iden [nm]) | nm <- nub (map snd esI <> map snd esR)]
-                                            <> [ BinOp (Iden [nm]) [Name "="] (Iden [sqlAttConcept fSpec c])
-                                                 | nm <- nub (map snd esR),
-                                                   nm /= sqlAttConcept fSpec c
-                                               ]
+                                        Just
+                                          . conjunctSQL
+                                          $ [notNull (Iden [nm]) | nm <- nub (map snd esI <> map snd esR)]
+                                          <> [ BinOp (Iden [nm]) [uName "="] (Iden [sqlAttConcept fSpec c])
+                                               | nm <- nub (map snd esR),
+                                                 nm /= sqlAttConcept fSpec c
+                                             ]
                                     }
                                 where
                                   c = case map fst esI of
@@ -530,18 +536,20 @@ nonSpecialSelectExpr fSpec expr =
                                       },
                                   bseTbl = zipWith tableRef [0 ..] es,
                                   bseWhr =
-                                    Just . conjunctSQL . concatMap constraintsOfTailExpression $
-                                      [1 .. length es -1]
+                                    Just
+                                      . conjunctSQL
+                                      . concatMap constraintsOfTailExpression
+                                      $ [1 .. length es - 1]
                                 }
                             where
                               iSect :: Int -> Name
-                              iSect n = Name ("subIntersect" <> show n)
+                              iSect n = uName ("subIntersect" <> tshow n)
                               tableRef :: Int -> BinQueryExpr -> TableRef
                               tableRef n e = TRQueryExpr (toSQL e) `as` iSect n
-                              constraintsOfTailExpression :: Int -> [ValueExpr]
+                              constraintsOfTailExpression :: Int -> [ScalarExpr]
                               constraintsOfTailExpression n =
-                                [ BinOp (Iden [iSect n, sourceAlias]) [Name "="] (Iden [iSect 0, sourceAlias]),
-                                  BinOp (Iden [iSect n, targetAlias]) [Name "="] (Iden [iSect 0, targetAlias])
+                                [ BinOp (Iden [iSect n, sourceAlias]) [uName "="] (Iden [iSect 0, sourceAlias]),
+                                  BinOp (Iden [iSect n, targetAlias]) [uName "="] (Iden [iSect 0, targetAlias])
                                 ]
     EUni (l, r) ->
       traceComment
@@ -587,7 +595,7 @@ nonSpecialSelectExpr fSpec expr =
             -}
             _ ->
               let fenceName :: Int -> Name
-                  fenceName n = Name ("fence" <> show n)
+                  fenceName n = uName ("fence" <> tshow n)
                   firstNr, lastNr :: Int
                   firstNr = 0
                   lastNr = firstNr + length es - 1
@@ -613,17 +621,17 @@ nonSpecialSelectExpr fSpec expr =
                         _ -> makeNormalFence
                     where
                       makeNormalFence = Just $ (TRQueryExpr . toSQL . selectExpr fSpec) (fenceExpr i) `as` fenceName i
-                  polesConstraints :: [Maybe ValueExpr]
-                  polesConstraints = map makePole [firstNr .. lastNr - 1] --there is one pole less than fences...
+                  polesConstraints :: [Maybe ScalarExpr]
+                  polesConstraints = map makePole [firstNr .. lastNr - 1] -- there is one pole less than fences...
                     where
-                      makePole :: Int -> Maybe ValueExpr
+                      makePole :: Int -> Maybe ScalarExpr
                       makePole i =
                         case (fenceTable i, fenceTable (i + 1)) of
                           (Just _, Just _) ->
                             Just
                               ( BinOp
                                   (Iden [fenceName i, targetAlias])
-                                  [Name "="]
+                                  [uName "="]
                                   (Iden [fenceName (i + 1), sourceAlias])
                               )
                           -- When one or both sides have no fenceTable, that is because of optimation of
@@ -636,7 +644,7 @@ nonSpecialSelectExpr fSpec expr =
                                 Just
                                   ( BinOp
                                       (Iden [fenceName i, targetAlias])
-                                      [Name "<>"]
+                                      [uName "<>"]
                                       (Iden [fenceName (i + 2), sourceAlias])
                                   )
                               _ -> fatal "there is no reason for having no fenceTable!"
@@ -649,7 +657,9 @@ nonSpecialSelectExpr fSpec expr =
                               _ -> fatal "there is no reason for having no fenceTable!"
                           (Nothing, Nothing) ->
                             -- This must be the special case: ...;V[A*B];V[B*C];....
-                            Just . SubQueryExpr SqExists . toSQL
+                            Just
+                              . SubQueryExpr SqExists
+                              . toSQL
                               . traceComment ["Case: ...;V[A*B];V[B*C];...."]
                               . selectExpr fSpec
                               . EDcI
@@ -688,10 +698,10 @@ nonSpecialSelectExpr fSpec expr =
                       }
     (EFlp x) -> flipped (selectExpr fSpec x)
       where
-        fTable = Name "flipped"
+        fTable = uName "flipped"
         flipped se =
-          traceComment ["case: EFlp x"] $
-            case se of
+          traceComment ["case: EFlp x"]
+            $ case se of
               BSE {} ->
                 BSE
                   { bseSetQuantifier = bseSetQuantifier se,
@@ -751,17 +761,17 @@ nonSpecialSelectExpr fSpec expr =
                   cSpecial = Nothing
                 },
             bseTbl = [sqlConceptTable fSpec c],
-            bseWhr = Just $ BinOp (Iden [sqlAttConcept fSpec c]) [Name "="] (singleton2SQL c val)
+            bseWhr = Just $ BinOp (Iden [sqlAttConcept fSpec c]) [uName "="] (singleton2SQL c val)
           }
     (EDcV (Sign s t)) ->
       let (psrc, fsrc) = fun s
           (ptgt, ftgt) = fun t
           fun :: A_Concept -> (Name, Name)
-          fun cpt = ((QName . T.unpack . text1ToText . showUnique) plug, (QName . sqlColumNameToString . attSQLColName) att)
+          fun cpt = ((qName . text1ToText . showUnique) plug, (qName . tshow . attSQLColName) att)
             where
               (plug, att) = getConceptTableInfo fSpec cpt
-       in traceComment ["case: (EDcV (Sign s t))"] $
-            case (s, t) of
+       in traceComment ["case: (EDcV (Sign s t))"]
+            $ case (s, t) of
               (ONE, ONE) -> one
               (_, ONE) ->
                 BSE
@@ -813,15 +823,15 @@ nonSpecialSelectExpr fSpec expr =
                         TRSimple [ptgt] `as` secnd
                       ],
                     bseWhr =
-                      Just $
-                        conjunctSQL
+                      Just
+                        $ conjunctSQL
                           [notNull (Iden [first', fsrc]), notNull (Iden [secnd, ftgt])]
                   }
                 where
-                  first' = Name "fst"
-                  secnd = Name "snd"
-    (EDcI c) -> traceComment ["case: EDcI c"] $
-      case c of
+                  first' = uName "fst"
+                  secnd = uName "snd"
+    (EDcI c) -> traceComment ["case: EDcI c"]
+      $ case c of
         ONE ->
           BSE
             { bseSetQuantifier = SQDefault,
@@ -852,8 +862,8 @@ nonSpecialSelectExpr fSpec expr =
                   bseWhr = Just (notNull cAtt)
                 }
     -- EEps behaves like I. The intersects are semantically relevant, because all semantic irrelevant EEps expressions have been filtered from es.
-    (EEps c _) -> traceComment ["case: EEps c _"] $
-      case c of -- select the population of the most specific concept, which is the source.
+    (EEps c _) -> traceComment ["case: EEps c _"]
+      $ case c of -- select the population of the most specific concept, which is the source.
         ONE ->
           BSE
             { bseSetQuantifier = SQDefault,
@@ -898,28 +908,28 @@ nonSpecialSelectExpr fSpec expr =
               { bseSetQuantifier = SQDefault,
                 bseSrc =
                   Col
-                    { cTable = [QName "concept0"],
+                    { cTable = [qName "concept0"],
                       cCol = [concpt],
                       cAlias = [],
                       cSpecial = Nothing
                     },
                 bseTrg =
                   Col
-                    { cTable = [QName "concept1"],
+                    { cTable = [qName "concept1"],
                       cCol = [concpt],
                       cAlias = [],
                       cSpecial = Nothing
                     },
                 bseTbl =
-                  [ sqlConceptTable fSpec c `as` QName "concept0",
-                    sqlConceptTable fSpec c `as` QName "concept1"
+                  [ sqlConceptTable fSpec c `as` qName "concept0",
+                    sqlConceptTable fSpec c `as` qName "concept1"
                   ],
                 bseWhr =
                   Just
                     ( BinOp
-                        (Iden [QName "concept0", concpt])
-                        [Name "<>"]
-                        (Iden [QName "concept1", concpt])
+                        (Iden [qName "concept0", concpt])
+                        [uName "<>"]
+                        (Iden [qName "concept1", concpt])
                     )
               }
           where
@@ -945,43 +955,47 @@ nonSpecialSelectExpr fSpec expr =
                     },
                 bseTbl = [(toTableRef . selectExpr fSpec) theClosedWorldExpression `as` closedWorldName],
                 bseWhr =
-                  Just $
-                    selectNotExists
+                  Just
+                    $ selectNotExists
                       (toTableRef (selectExpr fSpec e) `as` posName)
-                      ( Just . conjunctSQL $
-                          [ BinOp
-                              (Iden [closedWorldName, sourceAlias])
-                              [Name "="]
-                              (Iden [posName, sourceAlias]),
-                            BinOp
-                              (Iden [closedWorldName, targetAlias])
-                              [Name "="]
-                              (Iden [posName, targetAlias])
-                          ]
+                      ( Just
+                          . conjunctSQL
+                          $ [ BinOp
+                                (Iden [closedWorldName, sourceAlias])
+                                [uName "="]
+                                (Iden [posName, sourceAlias]),
+                              BinOp
+                                (Iden [closedWorldName, targetAlias])
+                                [uName "="]
+                                (Iden [posName, targetAlias])
+                            ]
                       )
               }
           where
-            posName = Name "pos"
+            posName = uName "pos"
             closedWorldName =
-              QName . T.unpack $
-                "cartesian product of " <> (tshow . source $ e) <> " and " <> (tshow . target $ e)
+              qName
+                $ "cartesian product of "
+                <> (tshow . source $ e)
+                <> " and "
+                <> (tshow . target $ e)
             theClosedWorldExpression = EDcV (sign e)
     EKl0 _ -> fatal "Sorry, there currently is no database support for * (Kleene star).\n It is used in your ampersand script, but it currently cannot be used in a prototype."
     EKl1 _ -> fatal "Sorry, there currently is no database support for + (Kleene plus).\n It is used in your ampersand script, but it currently cannot be used in a prototype."
     (EDif (EDcV _, x)) ->
-      traceComment ["case: EDif (EDcV _,x)"] $
-        selectExpr fSpec (notCpl x)
+      traceComment ["case: EDif (EDcV _,x)"]
+        $ selectExpr fSpec (notCpl x)
     -- The following definitions express code generation of the remaining cases in terms of the previously defined generators.
     -- As a result of this way of working, code generated for =, |-, -, !, *, \, and / may not be efficient, but at least it is correct.
     EEqu (l, r) ->
-      traceComment ["case: EEqu (l,r) "] $
-        selectExpr fSpec ((ECpl l .\/. r) ./\. (ECpl r .\/. l))
+      traceComment ["case: EEqu (l,r) "]
+        $ selectExpr fSpec ((ECpl l .\/. r) ./\. (ECpl r .\/. l))
     EInc (l, r) ->
-      traceComment ["case: EInc (l,r) "] $
-        selectExpr fSpec (ECpl l .\/. r)
+      traceComment ["case: EInc (l,r) "]
+        $ selectExpr fSpec (ECpl l .\/. r)
     EDif (l, r) ->
-      traceComment ["case: EDif (l,r) "] $
-        selectExpr fSpec (l ./\. ECpl r)
+      traceComment ["case: EDif (l,r) "]
+        $ selectExpr fSpec (l ./\. ECpl r)
     ERrs (l, r) ->
       -- The right residual l\r is defined by: for all x,y:   x(l\r)y  <=>  for all z in X, z l x implies z r y.
       {- In order to obtain an SQL-query, we make a Haskell derivation of the right residual:
@@ -1011,101 +1025,102 @@ nonSpecialSelectExpr fSpec expr =
             | target l == ONE = fatal ("ONE is unexpected as target of " <> showA l)
             | target r == ONE = fatal ("ONE is unexpected as target of " <> showA r)
             | otherwise =
-              BSE
-                { bseSetQuantifier = SQDefault,
-                  bseSrc =
-                    Col
-                      { cTable = [resLeft],
-                        cCol = [mainSrc],
-                        cAlias = [],
-                        cSpecial = Nothing
-                      },
-                  bseTrg =
-                    Col
-                      { cTable = [resRight],
-                        cCol = [mainTgt],
-                        cAlias = [],
-                        cSpecial = Nothing
-                      },
-                  bseTbl =
-                    [ sqlConceptTable fSpec (target l) `as` resLeft,
-                      sqlConceptTable fSpec (target r) `as` resRight
-                    ],
-                  bseWhr =
-                    Just . VEComment [BlockComment . T.unpack $ "Left hand side: " <> showA l] $
-                      selectNotExists
-                        (lCode `as` lhs)
-                        ( Just $
-                            conjunctSQL
-                              [ BinOp
-                                  (Iden [resLeft, mainSrc])
-                                  [Name "="]
-                                  (Iden [lhs, targetAlias]),
-                                VEComment [BlockComment . T.unpack $ "Right hand side: " <> showA r] $
-                                  selectNotExists
-                                    (rCode `as` rhs)
-                                    ( Just $
-                                        conjunctSQL
-                                          [ BinOp
-                                              (Iden [rhs, sourceAlias])
-                                              [Name "="]
-                                              (Iden [lhs, sourceAlias]),
-                                            BinOp
-                                              (Iden [rhs, targetAlias])
-                                              [Name "="]
-                                              (Iden [resRight, mainTgt])
-                                          ]
-                                    )
-                              ]
-                        )
-                }
+                BSE
+                  { bseSetQuantifier = SQDefault,
+                    bseSrc =
+                      Col
+                        { cTable = [resLeft],
+                          cCol = [mainSrc],
+                          cAlias = [],
+                          cSpecial = Nothing
+                        },
+                    bseTrg =
+                      Col
+                        { cTable = [resRight],
+                          cCol = [mainTgt],
+                          cAlias = [],
+                          cSpecial = Nothing
+                        },
+                    bseTbl =
+                      [ sqlConceptTable fSpec (target l) `as` resLeft,
+                        sqlConceptTable fSpec (target r) `as` resRight
+                      ],
+                    bseWhr =
+                      Just
+                        . VEComment [BlockComment $ "Left hand side: " <> showA l]
+                        $ selectNotExists
+                          (lCode `as` lhs)
+                          ( Just
+                              $ conjunctSQL
+                                [ BinOp
+                                    (Iden [resLeft, mainSrc])
+                                    [uName "="]
+                                    (Iden [lhs, targetAlias]),
+                                  VEComment [BlockComment $ "Right hand side: " <> showA r]
+                                    $ selectNotExists
+                                      (rCode `as` rhs)
+                                      ( Just
+                                          $ conjunctSQL
+                                            [ BinOp
+                                                (Iden [rhs, sourceAlias])
+                                                [uName "="]
+                                                (Iden [lhs, sourceAlias]),
+                                              BinOp
+                                                (Iden [rhs, targetAlias])
+                                                [uName "="]
+                                                (Iden [resRight, mainTgt])
+                                            ]
+                                      )
+                                ]
+                          )
+                  }
           mainSrc = (sqlAttConcept fSpec . target) l -- Note: this 'target' is not an error!!! It is part of the definition of right residu
           mainTgt = (sqlAttConcept fSpec . target) r
-          resLeft = Name "RResLeft"
-          resRight = Name "RResRight"
-          lhs = Name "lhs"
-          rhs = Name "rhs"
+          resLeft = uName "RResLeft"
+          resRight = uName "RResRight"
+          lhs = uName "lhs"
+          rhs = uName "rhs"
           lCode = toTableRef $ selectExpr fSpec l -- selectExprInFROM fSpec sourceAlias targetAlias l
           rCode = toTableRef $ selectExpr fSpec r -- selectExprInFROM fSpec sourceAlias targetAlias r
        in traceComment
             ["case: ERrs (l,r)"]
             rResiduClause
     ELrs (l, r) ->
-      traceComment ["case: ELrs (l,r)"] $
-        selectExpr fSpec (EFlp (flp r .\. flp l))
+      traceComment ["case: ELrs (l,r)"]
+        $ selectExpr fSpec (EFlp (flp r .\. flp l))
     EDia (l, r) ->
-      traceComment ["case: EDia (l,r)"] $
-        selectExpr fSpec ((flp l .\. r) ./\. (l ./. flp r))
+      traceComment ["case: EDia (l,r)"]
+        $ selectExpr fSpec ((flp l .\. r) ./\. (l ./. flp r))
     ERad (l, ECpl r) ->
-      traceComment ["case: ERad (l, ECpl r)"] $
-        selectExpr fSpec (EFlp (r .\. flp l))
+      traceComment ["case: ERad (l, ECpl r)"]
+        $ selectExpr fSpec (EFlp (r .\. flp l))
     ERad (l, r) ->
-      traceComment ["case: ERad (l,r)"] $
-        selectExpr fSpec (flp (notCpl l) .\. r)
+      traceComment ["case: ERad (l,r)"]
+        $ selectExpr fSpec (flp (notCpl l) .\. r)
     EPrd (l, r) ->
       let v = EDcV (Sign (target l) (source r))
-       in traceComment ["case: EPrd (l,r)"] $
-            selectExpr fSpec (l .:. v .:. r)
+       in traceComment ["case: EPrd (l,r)"]
+            $ selectExpr fSpec (l .:. v .:. r)
   where
     traceComment = traceExprComment expr
-    singleton2SQL :: A_Concept -> PAtomValue -> ValueExpr
+    singleton2SQL :: A_Concept -> PAtomValue -> ScalarExpr
     singleton2SQL cpt singleton =
       atomVal2InSQL (safePSingleton2AAtomVal (fcontextInfo fSpec) cpt singleton)
 
 traceExprComment :: Expression -> [Text] -> BinQueryExpr -> BinQueryExpr
 traceExprComment expr caseStr =
-  BQEComment $
-    map (BlockComment . T.unpack) caseStr
-      <> [ BlockComment . T.unpack $ "   Expression: " <> showA expr,
-           BlockComment . T.unpack $ "   Signature : " <> tshow (sign expr)
-         ]
+  BQEComment
+    $ map BlockComment caseStr
+    <> [ BlockComment $ "   Expression: " <> showA expr,
+         BlockComment $ "   Signature : " <> tshow (sign expr)
+       ]
 
-atomVal2InSQL :: AAtomValue -> ValueExpr
+atomVal2InSQL :: AAtomValue -> ScalarExpr
 atomVal2InSQL val =
   case val of
-    AAVString {} -> StringLit . T.unpack $ aavtxt val
-    AAVInteger _ int -> NumLit (show int)
-    AAVFloat _ d -> NumLit (show d)
+    AAVString {} -> stringLit $ aavtxt val
+    AAVInteger _ int -> NumLit (tshow int)
+    AAVFloat _ d -> NumLit (tshow d)
     AAVBoolean _ b -> NumLit $ if b then "1" else "0"
     _ ->
       fatal
@@ -1128,27 +1143,29 @@ selectRelation fSpec dcl =
           bseSrc =
             Col
               { cTable = [],
-                cCol = [QName . sqlColumNameToString . attSQLColName $ s],
+                cCol = [qName . tshow . attSQLColName $ s],
                 cAlias = [],
                 cSpecial = Nothing
               },
           bseTrg =
             Col
               { cTable = [],
-                cCol = [QName . sqlColumNameToString . attSQLColName $ t],
+                cCol = [qName . tshow . attSQLColName $ t],
                 cAlias = [],
                 cSpecial = Nothing
               },
-          bseTbl = [TRSimple [QName . T.unpack . text1ToText . showUnique $ plug]],
+          bseTbl = [TRSimple [qName . text1ToText . showUnique $ plug]],
           bseWhr =
-            Just . conjunctSQL . map notNull $
-              [Iden [QName . sqlColumNameToString . attSQLColName $ c] | c <- nub [s, t]]
+            Just
+              . conjunctSQL
+              . map notNull
+              $ [Iden [qName . tshow . attSQLColName $ c] | c <- nub [s, t]]
         }
       where
         s = rsSrcAtt relstore
         t = rsTrgAtt relstore
 
-isNotIn :: ValueExpr -> QueryExpr -> ValueExpr
+isNotIn :: ScalarExpr -> QueryExpr -> ScalarExpr
 isNotIn value = In False value . InQueryExpr
 
 -- | select only the source of a binary expression
@@ -1174,9 +1191,9 @@ selectExists,
     -- | tables
     TableRef ->
     -- | the (optional) WHERE clause
-    Maybe ValueExpr ->
-    ValueExpr
-selectNotExists tbl whr = PrefixOp [Name "NOT"] $ selectExists tbl whr
+    Maybe ScalarExpr ->
+    ScalarExpr
+selectNotExists tbl whr = PrefixOp [uName "NOT"] $ selectExists tbl whr
 selectExists tbl whr =
   SubQueryExpr
     SqExists
@@ -1186,7 +1203,7 @@ selectExists tbl whr =
         qeFrom =
           [ case tbl of
               TRAlias {} -> tbl
-              _ -> tbl `as` Name "aDummyName" -- MySQL requires you to label the "sub query" instead of just leaving it like many other implementations.
+              _ -> tbl `as` uName "aDummyName" -- MySQL requires you to label the "sub query" instead of just leaving it like many other implementations.
           ],
         qeWhere = whr,
         qeGroupBy = [],
@@ -1205,12 +1222,12 @@ data BinQueryExpr
         -- | tables
         bseTbl :: [TableRef],
         -- | the (optional) WHERE clause
-        bseWhr :: Maybe ValueExpr
+        bseWhr :: Maybe ScalarExpr
       }
   | BCQE
       { bseSetQuantifier :: SetQuantifier,
         -- | The combine operator
-        bcqeOper :: CombineOp,
+        bcqeOper :: SetOperatorName,
         -- | Left  expression
         bcqe0 :: BinQueryExpr,
         -- | Right expression
@@ -1222,11 +1239,11 @@ data Col = Col
   { cTable :: [Name],
     cCol :: [Name],
     cAlias :: [Name],
-    cSpecial :: Maybe ValueExpr
+    cSpecial :: Maybe ScalarExpr
   }
 
-col2ValueExpr :: Col -> ValueExpr
-col2ValueExpr col =
+col2ScalarExpr :: Col -> ScalarExpr
+col2ScalarExpr col =
   case cSpecial col of
     Nothing -> Iden x
     Just ve
@@ -1265,6 +1282,7 @@ stripCommentTableRef tr =
     TRQueryExpr qe -> TRQueryExpr (stripCommentQueryExpr qe)
     TRFunction _ _ -> tr
     TRLateral tr1 -> TRLateral (stripCommentTableRef tr1)
+    TROdbc tr1 -> TROdbc (stripCommentTableRef tr1)
 
 stripCommentQueryExpr :: QueryExpr -> QueryExpr
 stripCommentQueryExpr qe =
@@ -1279,8 +1297,8 @@ toSQL bqe =
       Select
         { qeSetQuantifier = bseSetQuantifier bqe,
           qeSelectList =
-            [ (col2ValueExpr (bseSrc bqe), Just sourceAlias),
-              (col2ValueExpr (bseTrg bqe), Just targetAlias)
+            [ (col2ScalarExpr (bseSrc bqe), Just sourceAlias),
+              (col2ScalarExpr (bseTrg bqe), Just targetAlias)
             ],
           qeFrom = bseTbl bqe,
           qeWhere = bseWhr bqe,
@@ -1291,7 +1309,7 @@ toSQL bqe =
           qeFetchFirst = Nothing
         }
     BCQE {} ->
-      CombineQueryExpr
+      QueryExprSetOp
         { qe0 = toSQL (bcqe0 bqe),
           qeCombOp = bcqeOper bqe,
           qeSetQuantifier = bseSetQuantifier bqe,
@@ -1326,34 +1344,31 @@ sqlConceptTable fSpec a = TRSimple [sqlConcept fSpec a]
 
 -- sqlConcept gives the SQL-name of the plug that contains all atoms of A_Concept c.
 sqlConcept :: FSpec -> A_Concept -> Name
-sqlConcept fSpec = QName . T.unpack . text1ToText . showUnique . getConceptTableFor fSpec
+sqlConcept fSpec = qName . text1ToText . showUnique . getConceptTableFor fSpec
 
 sqlAttConcept :: FSpec -> A_Concept -> Name
 sqlAttConcept fSpec c
-  | c == ONE = QName "ONE"
+  | c == ONE = qName "ONE"
   | otherwise =
-    case [ att | att <- NE.toList $ plugAttributes (getConceptTableFor fSpec c), c' <- toList $ concs att, c == c'
-         ] of
-      [] -> fatal ("A_Concept \"" <> tshow c <> "\" does not occur in its plug in fSpec \"" <> fullName fSpec <> "\"")
-      h : _ -> QName . sqlColumNameToString . attSQLColName $ h
+      case [ att | att <- NE.toList $ plugAttributes (getConceptTableFor fSpec c), c' <- toList $ concs att, c == c'
+           ] of
+        [] -> fatal ("A_Concept \"" <> tshow c <> "\" does not occur in its plug in fSpec \"" <> fullName fSpec <> "\"")
+        h : _ -> qName . tshow . attSQLColName $ h
 
 stringOfName :: Name -> Text
-stringOfName (Name s) = T.pack s
-stringOfName (QName s) = T.pack s
-stringOfName (UQName s) = T.pack s
-stringOfName _ = fatal "This kind of a Name wasn't used before in Ampersand."
+stringOfName = tshow
 
-conjunctSQL :: [ValueExpr] -> ValueExpr
+conjunctSQL :: [ScalarExpr] -> ScalarExpr
 conjunctSQL [] = fatal "nothing to `and`."
 conjunctSQL [ve] = bracketsSQL ve
-conjunctSQL (ve : ves) = BinOp (bracketsSQL ve) [Name "and"] (conjunctSQL ves)
+conjunctSQL (ve : ves) = BinOp (bracketsSQL ve) [uName "and"] (conjunctSQL ves)
 
-disjunctSQL :: [ValueExpr] -> ValueExpr
+disjunctSQL :: [ScalarExpr] -> ScalarExpr
 disjunctSQL [] = fatal "nothing to `or`."
 disjunctSQL [ve] = bracketsSQL ve
-disjunctSQL (ve : ves) = BinOp (bracketsSQL ve) [Name "or"] (conjunctSQL ves)
+disjunctSQL (ve : ves) = BinOp (bracketsSQL ve) [uName "or"] (conjunctSQL ves)
 
-bracketsSQL :: ValueExpr -> ValueExpr
+bracketsSQL :: ScalarExpr -> ScalarExpr
 bracketsSQL = Parens
 
 as :: TableRef -> Name -> TableRef
@@ -1366,11 +1381,11 @@ as ve a =
     withoutAlias = ve
     withAlias = TRAlias ve (Alias a Nothing)
 
-notNull :: ValueExpr -> ValueExpr
-notNull = PostfixOp [Name "is not null"]
+notNull :: ScalarExpr -> ScalarExpr
+notNull = PostfixOp [uName "is not null"]
 
-isNull :: ValueExpr -> ValueExpr
-isNull = PostfixOp [Name "is null"]
+isNull :: ScalarExpr -> ScalarExpr
+isNull = PostfixOp [uName "is null"]
 
 emptySet :: BinQueryExpr
 emptySet =
@@ -1411,11 +1426,11 @@ emptySet =
               )
               `as` nothing
           ],
-        bseWhr = Just (BinOp (Iden [a]) [Name "<>"] (NumLit "1"))
+        bseWhr = Just (BinOp (Iden [a]) [uName "<>"] (NumLit "1"))
       }
   where
-    a = Name "a"
-    nothing = Name "nothing"
+    a = uName "a"
+    nothing = uName "nothing"
 
 one :: BinQueryExpr
 one =
@@ -1438,13 +1453,13 @@ one =
                   qeOffset = Nothing,
                   qeFetchFirst = Nothing
                 }
-              `as` Name "ONE"
+              `as` uName "ONE"
           ],
         bseWhr = Nothing
       }
 
 theDialect :: Dialect
-theDialect = MySQL -- maybe in the future other dialects will be supported. This depends on package `simple-sql-parser`
+theDialect = mysql -- maybe in the future other dialects will be supported.
 
 broadQuery :: FSpec -> ObjectDef -> QueryExpr
 broadQuery fSpec obj =
@@ -1458,7 +1473,7 @@ broadQuery fSpec obj =
   --     the target of the contextExpression, we want to fetch them in this single query.
   --   c) We know the table that is used to get the tgt of the result of a) This could be some intermediate table!
   --   d) we know the conceptTable of the target concept of the expression.
-  --There are the following cases to consider:
+  -- There are the following cases to consider:
   -- 1) There is no subinterface, or the subinterface contains no expressions to consider
   -- 2) The only expression to consider is I[<target of contextExpression>]
   -- 3) The plug used to fetch the contextExpression is the same plug as the conceptTable of the target of that expression.
@@ -1509,31 +1524,32 @@ broadQuery fSpec obj =
                       qeFetchFirst = Nothing
                     }
 
-                makeCol :: Maybe Name -> ObjectDef -> (ValueExpr, Maybe Name)
+                makeCol :: Maybe Name -> ObjectDef -> (ScalarExpr, Maybe Name)
                 makeCol tableName col =
                   case attInBroadQuery fSpec (target . objExpression $ obj) (objExpression col) of
                     Nothing -> fatal ("this is unexpected behaviour. " <> tshow col)
                     Just att ->
                       ( Iden
                           ( case tableName of
-                              Nothing -> [QName . sqlColumNameToString . attSQLColName $ att]
-                              Just tab -> [tab, QName . sqlColumNameToString . attSQLColName $ att]
+                              Nothing -> [qName . tshow . attSQLColName $ att]
+                              Just tab -> [tab, qName . tshow . attSQLColName $ att]
                           ),
                         Just
-                          ( QName . T.unpack $
+                          ( qName
+                              $
                               -- The name is not sufficient for two reasons:
                               --   1) the columname must be unique. For that reason, it is prefixed:
                               "ifc_"
-                                <>
-                                --   2) It must be injective. Because SQL deletes trailing spaces,
-                                --      we have to cope with that:
-                                maybe mempty (text1ToText . escapeIdentifier) (objPlainName col)
+                              <>
+                              --   2) It must be injective. Because SQL deletes trailing spaces,
+                              --      we have to cope with that:
+                              maybe mempty (text1ToText . escapeIdentifier) (objPlainName col)
                           )
                       )
                 subThings ::
-                  ( [(ValueExpr, Maybe Name)],
+                  ( [(ScalarExpr, Maybe Name)],
                     [TableRef],
-                    Maybe ValueExpr
+                    Maybe ScalarExpr
                   )
                 subThings =
                   ( [ (Iden [org, sourceAlias], Just sourceAlias),
@@ -1546,13 +1562,13 @@ broadQuery fSpec obj =
                     Just
                       ( BinOp
                           (Iden [org, targetAlias])
-                          [Name "="]
+                          [uName "="]
                           (Iden [ct, sqlAttConcept fSpec tableCpt])
                       )
                   )
                   where
-                    org = Name "org"
-                    ct = Name "cptTbl"
+                    org = uName "org"
+                    ct = uName "cptTbl"
                 tableCpt = source . objExpression $ hobjs
 
 -- Iff the expression is implemented in the concepttable of the given concept
@@ -1610,3 +1626,12 @@ commentBlockSQL xs =
         hbar = T.replicate maxLength "-"
         addSpaces str = str <> T.replicate (T.length hbar - T.length str) " "
         maxLength = fromMaybe (T.length h) (maximumMaybe . map T.length $ tl)
+
+qName :: Text -> Name
+qName = Name (Just ("\"", "\""))
+
+uName :: Text -> Name -- Unquoted name
+uName = Name Nothing
+
+stringLit :: Text -> ScalarExpr
+stringLit = StringLit "'" "'"
\ No newline at end of file
diff --git a/src/Ampersand/Output/Population2Xlsx.hs b/src/Ampersand/Output/Population2Xlsx.hs
index 9086cafc0..1f6cb7ded 100644
--- a/src/Ampersand/Output/Population2Xlsx.hs
+++ b/src/Ampersand/Output/Population2Xlsx.hs
@@ -22,7 +22,7 @@ plugs2Sheets :: FSpec -> [(Text, Worksheet)]
 plugs2Sheets fSpec = mapMaybe plug2sheet $ plugInfos fSpec
   where
     plug2sheet :: PlugInfo -> Maybe (Text, Worksheet)
-    plug2sheet (InternalPlug plug) = fmap (sqlColumNameToText . sqlname $ plug,) sheet
+    plug2sheet (InternalPlug plug) = fmap (tshow . sqlname $ plug,) sheet
       where
         sheet :: Maybe Worksheet
         sheet = case matrix of
@@ -52,11 +52,11 @@ plugs2Sheets fSpec = mapMaybe plug2sheet $ plugInfos fSpec
                     toCell
                     [ if isFirstField -- In case of the first field of the table, we put the fieldname inbetween brackets,
                     -- to be able to find the population again by the reader of the .xlsx file
-                        then Just $ "[" <> (sqlColumNameToText . attSQLColName $ att) <> "]"
+                        then Just $ "[" <> (tshow . attSQLColName $ att) <> "]"
                         else Just
                           $ case plug of
-                            TblSQL {} -> sqlColumNameToText . attSQLColName $ att
-                            BinSQL {} -> sqlColumNameToText . sqlname $ plug,
+                            TblSQL {} -> tshow . attSQLColName $ att
+                            BinSQL {} -> tshow . sqlname $ plug,
                       Just . fullName . target . attExpr $ att
                     ]
             content = fmap record2Cells (tableContents fSpec plug)
diff --git a/src/Ampersand/Output/ToPandoc/SharedAmongChapters.hs b/src/Ampersand/Output/ToPandoc/SharedAmongChapters.hs
index 64d72da81..68d4ab3b4 100644
--- a/src/Ampersand/Output/ToPandoc/SharedAmongChapters.hs
+++ b/src/Ampersand/Output/ToPandoc/SharedAmongChapters.hs
@@ -76,14 +76,14 @@ data CustomSection
 ------ Symbolic referencing to a chapter/section. ---------------------------------
 
 -- | Things that can be referenced in a document.
-class Typeable a => Xreferenceable a where
+class (Typeable a) => Xreferenceable a where
   xDefBlck :: (HasDirOutput env, HasDocumentOpts env) => env -> FSpec -> a -> Blocks
-  xDefBlck _ _ a = fatal ("A " <> tshow (typeOf a) <> " cannot be labeled in <Blocks>.") --you should use xDefInln instead.
+  xDefBlck _ _ a = fatal ("A " <> tshow (typeOf a) <> " cannot be labeled in <Blocks>.") -- you should use xDefInln instead.
 
   -- ^ function that defines the target Blocks of something that can be referenced.
 
   xDefInln :: (HasOutputLanguage env) => env -> FSpec -> a -> Inlines
-  xDefInln _ _ a = fatal ("A " <> tshow (typeOf a) <> " cannot be labeled in an <Inlines>.") --you should use xDefBlck instead.
+  xDefInln _ _ a = fatal ("A " <> tshow (typeOf a) <> " cannot be labeled in an <Inlines>.") -- you should use xDefBlck instead.
 
   -- ^ function that defines the target Inlines of something that can be referenced.
 
@@ -141,22 +141,22 @@ hyperTarget env fSpec a =
     --                    <>printMeaning (outputLang env fSpec) r
     --                  )
     XRefConceptualAnalysisRelation _d ->
-      Right $
-        spanWith
+      Right
+        $ spanWith
           (xSafeLabel a, [], [])
           ( (text . l) (NL "Relatie ", EN "Relation ")
           --   <> (str . show . numberOf fSpec $ d)
           )
     XRefConceptualAnalysisRule _r ->
-      Right $
-        spanWith
+      Right
+        $ spanWith
           (xSafeLabel a, [], [])
           ( (text . l) (NL "Regel ", EN "Rule ")
           --   <> (str . show . numberOf fSpec $ r)
           )
     XRefConceptualAnalysisExpression _r ->
-      Right $
-        spanWith
+      Right
+        $ spanWith
           (xSafeLabel a, [], [])
           ( (text . l) (NL "Regel ", EN "Rule ")
           --   <> (str . show . numberOf fSpec $ r)
@@ -168,7 +168,7 @@ hyperTarget env fSpec a =
     l :: LocalizedStr -> Text
     l = localize (outputLang env fSpec)
 
-codeGen' :: Xreferenceable a => a -> Inlines
+codeGen' :: (Xreferenceable a) => a -> Inlines
 codeGen' a =
   cite
     [ Citation
@@ -232,13 +232,15 @@ data Ident
   = IdentByName Name
   | IdentRel Name Name Name
   | IdentOverig -- Used to print the
+  deriving (Eq)
 
 instance Hashable Ident where
   hashWithSalt s ident = case ident of
     IdentByName nm ->
       s `hashWithSalt` nm
     IdentRel n1 n2 n3 ->
-      s `hashWithSalt` n1
+      s
+        `hashWithSalt` n1
         `hashWithSalt` n2
         `hashWithSalt` n3
     IdentOverig -> s `hashWithSalt` tshow ident
@@ -333,7 +335,7 @@ data Numbered t = Nr
     theLoad :: t
   }
 
-instance Named t => Named (Numbered t) where
+instance (Named t) => Named (Numbered t) where
   name = name . theLoad
 
 data RuleCont = CRul
@@ -367,11 +369,12 @@ instance Named CptCont where
 instance Named ThemeContent where
   name tc =
     maybe
-      ( mkName PatternName . (:| []) $
-          ( case toNamePart "Outside_of_patterns" of
-              Nothing -> fatal "Not a valid NamePart."
-              Just np -> np
-          )
+      ( mkName PatternName
+          . (:| [])
+          $ ( case toNamePart "Outside_of_patterns" of
+                Nothing -> fatal "Not a valid NamePart."
+                Just np -> np
+            )
       )
       name
       (patOfTheme tc)
@@ -385,7 +388,7 @@ instance Named ThemeContent where
 --   The story: materials from the patterns are gathered in ruless, conceptss, and relationss.
 --   Numbering of each item is done recursively by `numbered`, while keeping the structure intact.
 --   Finally, the theme content is constructed.
-orderingByTheme :: HasOutputLanguage env => env -> FSpec -> [ThemeContent]
+orderingByTheme :: (HasOutputLanguage env) => env -> FSpec -> [ThemeContent]
 orderingByTheme env fSpec =
   [ Thm
       { themeNr = i,
@@ -491,8 +494,8 @@ dpRule' env fSpec = dpR
     dpR (r : rs) n seenConcs seenRelations =
       ( ( l (NL "Regel: ", EN "Rule: ") <> (text . tshow . mkId) r,
           [theBlocks]
-        ) :
-        dpNext,
+        )
+          : dpNext,
         n',
         seenCs,
         seenDs
@@ -508,7 +511,8 @@ dpRule' env fSpec = dpR
               ([d], English) -> plain ("In order to formalize this, a " <> (if isFunction d then "function" else "relation") <> " is introduced:")
               (_, Dutch) ->
                 plain
-                  ( "Om te komen tot de formalisatie van " <> hyperLinkTo (XRefSharedLangRule r)
+                  ( "Om te komen tot de formalisatie van "
+                      <> hyperLinkTo (XRefSharedLangRule r)
                       <> " ("
                       <> (singleQuoted . str . tshow . mkId) r
                       <> ") "
@@ -588,7 +592,7 @@ dpRule' env fSpec = dpR
         rds = ds `Set.intersection` seenRelations -- previously seen relations
         (dpNext, n', seenCs, seenDs) = dpR rs (n + length cds + length nds + 1) (ncs `Set.union` seenConcs) (nds `Set.union` seenRelations)
 
-printMeaning :: HasMeaning a => Lang -> a -> Blocks
+printMeaning :: (HasMeaning a) => Lang -> a -> Blocks
 printMeaning lang = maybe mempty (printMarkup . ameaMrk) . meaning lang
 
 printPurposes :: [Purpose] -> Blocks
@@ -618,7 +622,8 @@ purposes2Blocks env ps =
           ( texOnlyMarginNote
               (T.intercalate "; " (explRefIds purp) <> "\n")
           )
-        | view fspecFormatL env `elem` [Fpdf, Flatex]
+        | view fspecFormatL env
+            `elem` [Fpdf, Flatex]
             && (not . null . explRefIds) purp
       ]
 

From 4411427bcf33cc991653779f89f5ed5f0a3b81f7 Mon Sep 17 00:00:00 2001
From: hanjoosten <han.joosten@ordina.nl>
Date: Thu, 11 Apr 2024 13:22:03 +0200
Subject: [PATCH 11/43] solve a warning

---
 src/Ampersand/ADL1/Disambiguate.hs | 25 +++++++++++++------------
 1 file changed, 13 insertions(+), 12 deletions(-)

diff --git a/src/Ampersand/ADL1/Disambiguate.hs b/src/Ampersand/ADL1/Disambiguate.hs
index 4b9778755..dc41af506 100644
--- a/src/Ampersand/ADL1/Disambiguate.hs
+++ b/src/Ampersand/ADL1/Disambiguate.hs
@@ -32,7 +32,7 @@ data Constraints = Cnstr
   }
   deriving (Show)
 
-class Traversable d => Disambiguatable d where
+class (Traversable d) => Disambiguatable d where
   -- To make something Disambiguatable, do the following:
   -- (1) Make sure the type of the Disambiguatable thing has a type variable.
   --     Suppose "Thing" should become disambiguatable, then "Thing" has "TermPrim" inside somewhere.
@@ -60,7 +60,7 @@ class Traversable d => Disambiguatable d where
   --                (b', (ic2,ib)) = disambInfo cptMap b (ic1,ib1)
   disambInfo ::
     ConceptMap -> -- required to turn P_Concepts into proper A_Concepts (see issue #999)
-    d (TermPrim, DisambPrim) -> --the thing that is disabmiguated
+    d (TermPrim, DisambPrim) -> -- the thing that is disabmiguated
     Constraints -> -- the inferred types (from the environment = top down)
     ( d ((TermPrim, DisambPrim), Constraints), -- only the environment for the term (top down)
       Constraints -- the inferred type, bottom up (not including the environment, that is: not using the second argument: prevent loops!)
@@ -88,7 +88,7 @@ class Traversable d => Disambiguatable d where
 noConstraints :: Constraints
 noConstraints = Cnstr [] []
 
---TODO: Rename to a more meaningfull name
+-- TODO: Rename to a more meaningfull name
 fullConstraints :: Constraints -> Constraints
 fullConstraints cs =
   Cnstr
@@ -107,8 +107,8 @@ instance Disambiguatable P_IdentDf where
   disambInfo cptMap (P_Id orig nm lbl cpt atts) _ = (P_Id orig nm lbl cpt atts', Cnstr (concatMap bottomUpSourceTypes . NE.toList $ restr') [])
     where
       (atts', restr') =
-        NE.unzip $
-          fmap (\a -> disambInfo cptMap a (Cnstr [MustBe (pCpt2aCpt cptMap cpt)] [])) atts
+        NE.unzip
+          $ fmap (\a -> disambInfo cptMap a (Cnstr [MustBe (pCpt2aCpt cptMap cpt)] [])) atts
 
 instance Disambiguatable P_IdentSegmnt where
   disambInfo cptMap (P_IdentExp v) x = (P_IdentExp v', rt)
@@ -193,7 +193,9 @@ instance Disambiguatable P_SubIfc where
     (P_Box o cl' (a' : lst'), Cnstr (bottomUpSourceTypes envA ++ bottomUpSourceTypes envB) [])
     where
       (a', envA) = disambInfo cptMap a (Cnstr (bottomUpSourceTypes envB ++ bottomUpSourceTypes env1) [])
-      (P_Box _ cl' lst', envB) = disambInfo cptMap (P_Box o cl lst) (Cnstr (bottomUpSourceTypes env1 ++ bottomUpSourceTypes envA) [])
+      (cl', lst', envB) = case disambInfo cptMap (P_Box o cl lst) (Cnstr (bottomUpSourceTypes env1 ++ bottomUpSourceTypes envA) []) of
+        (P_Box _ cl'' lst'', envB'') -> (cl'', lst'', envB'')
+        (P_InterfaceRef {}, _) -> fatal "Unexpected result of disambInfo"
 
 instance Disambiguatable P_BoxItem where
   disambInfo
@@ -297,7 +299,7 @@ data DisambPrim
 instance Pretty DisambPrim where
   pretty = text . show
 
-instance Pretty a => Pretty (a, DisambPrim) where
+instance (Pretty a) => Pretty (a, DisambPrim) where
   pretty (t, _) = pretty t
 
 performUpdate ::
@@ -310,7 +312,7 @@ performUpdate ((t, unkn), Cnstr srcs' tgts') =
     Known _ -> pure (t, unkn)
     Rel xs ->
       determineBySize
-        (\x -> if length x == length xs then pure (Rel xs) else impure (Rel x))
+        (\x -> if length x == length xs then pure (Rel xs) else Change (Rel x))
         ( (findMatch' (mustBeSrc, mustBeTgt) xs `orWhenEmpty` findMatch' (mayBeSrc, mayBeTgt) xs)
             `orWhenEmpty` xs
         )
@@ -322,7 +324,7 @@ performUpdate ((t, unkn), Cnstr srcs' tgts') =
         [EDcV (Sign a b) | a <- Set.toList mustBeSrc, b <- Set.toList mustBeTgt]
   where
     suggest [] = pure unkn
-    suggest lst = impure (Rel lst) -- TODO: find out whether it is equivalent to put "pure" here (which could be faster).
+    suggest lst = Change (Rel lst) -- TODO: find out whether it is equivalent to put "pure" here (which could be faster).
     possibleConcs =
       (mustBeSrc `Set.intersection` mustBeTgt)
         `orWhenEmptyS` (mustBeSrc `Set.union` mustBeTgt)
@@ -343,9 +345,8 @@ performUpdate ((t, unkn), Cnstr srcs' tgts') =
     mustBe xs = Set.fromList [x | (MustBe x) <- xs]
     mayBe xs = Set.fromList [x | (MayBe x) <- xs]
     orWhenEmptyS a b = if Set.null a then b else a
-    determineBySize _ [a] = impure (t, Known a)
+    determineBySize _ [a] = Change (t, Known a)
     determineBySize err lst = fmap (t,) (err lst)
-    impure x = Change x
 
 orWhenEmpty :: [a] -> [a] -> [a]
 orWhenEmpty a b = if null a then b else a
@@ -366,4 +367,4 @@ instance Applicative Change where
   (<*>) (Change f) (Stable a) = Change (f a)
   (<*>) (Change f) (Change a) = Change (f a)
   (<*>) (Stable f) (Change a) = Change (f a)
-  pure a = Stable a
+  pure = Stable

From 528a53b3dc60a55acf7047d2effbb779a6e8abd3 Mon Sep 17 00:00:00 2001
From: hanjoosten <han.joosten@ordina.nl>
Date: Fri, 12 Apr 2024 12:35:05 +0200
Subject: [PATCH 12/43] Fixed issue due to upgrade optparse-applicative

---
 ampersand.cabal                 |  8 +++++++
 package.yaml                    |  4 +++-
 src/Ampersand/Basics/Exit.hs    | 10 ++++----
 src/Ampersand/Basics/Name.hs    |  2 +-
 src/Ampersand/Basics/Prelude.hs | 11 +++++----
 src/Ampersand/Basics/Version.hs | 20 +++++++++-------
 src/Ampersand/Misc/Commands.hs  | 41 +++++++++++++++++----------------
 7 files changed, 57 insertions(+), 39 deletions(-)

diff --git a/ampersand.cabal b/ampersand.cabal
index aeda10c5a..87edb514d 100644
--- a/ampersand.cabal
+++ b/ampersand.cabal
@@ -615,6 +615,8 @@ library
     , pandoc-crossref
     , pandoc-types
     , parsec
+    , prettyprinter
+    , prettyprinter-ansi-terminal
     , process
     , quickcheck-instances
     , rio
@@ -685,6 +687,8 @@ executable ampPreProc
     , pandoc-crossref
     , pandoc-types
     , parsec
+    , prettyprinter
+    , prettyprinter-ansi-terminal
     , process
     , quickcheck-instances
     , rio
@@ -758,6 +762,8 @@ executable ampersand
     , pandoc-crossref
     , pandoc-types
     , parsec
+    , prettyprinter
+    , prettyprinter-ansi-terminal
     , process
     , quickcheck-instances
     , rio
@@ -829,6 +835,8 @@ test-suite ampersand-test
     , pandoc-crossref
     , pandoc-types
     , parsec
+    , prettyprinter
+    , prettyprinter-ansi-terminal
     , process
     , quickcheck-instances
     , rio
diff --git a/package.yaml b/package.yaml
index 9788038d3..f0f665adf 100644
--- a/package.yaml
+++ b/package.yaml
@@ -65,6 +65,8 @@ dependencies:
   - pandoc-crossref
   - pandoc-types
   - parsec
+  - prettyprinter
+  - prettyprinter-ansi-terminal
   - process
   - QuickCheck
   - quickcheck-instances
@@ -81,7 +83,7 @@ dependencies:
   - transformers
   - typed-process
   - uri-encode
-  - wl-pprint
+  - wl-pprint # to be replaced with prettyprinter stuff
   - xlsx
   - yaml
   # - yaml-config
diff --git a/src/Ampersand/Basics/Exit.hs b/src/Ampersand/Basics/Exit.hs
index 61728b1e2..094587532 100644
--- a/src/Ampersand/Basics/Exit.hs
+++ b/src/Ampersand/Basics/Exit.hs
@@ -9,7 +9,7 @@ module Ampersand.Basics.Exit
 where
 
 import Control.Exception hiding (catch)
---import           Ampersand.Basics.Prelude
+-- import           Ampersand.Basics.Prelude
 import RIO hiding (exitWith, zipWith)
 import qualified RIO.Text as T
 import qualified System.Exit as SE
@@ -63,9 +63,11 @@ instance Exception AmpersandExit
 
 instance Show AmpersandExit where
   show x =
-    T.unpack $
-      "[" <> tshow exitcode <> "] "
-        <> T.concat (fmap ("    " <>) message)
+    T.unpack
+      $ "["
+      <> tshow exitcode
+      <> "] "
+      <> T.concat (fmap ("    " <>) message)
     where
       (exitcode, message) = info x
 
diff --git a/src/Ampersand/Basics/Name.hs b/src/Ampersand/Basics/Name.hs
index 42f974116..6a9d4e044 100644
--- a/src/Ampersand/Basics/Name.hs
+++ b/src/Ampersand/Basics/Name.hs
@@ -219,7 +219,7 @@ class Named a where
 newtype Label = Label Text
   deriving (Data, Ord, Eq)
 
-class Named a => Labeled a where
+class (Named a) => Labeled a where
   {-# MINIMAL mLabel #-}
   mLabel :: a -> Maybe Label
   label :: a -> Text
diff --git a/src/Ampersand/Basics/Prelude.hs b/src/Ampersand/Basics/Prelude.hs
index afa1c6abf..76efe486e 100644
--- a/src/Ampersand/Basics/Prelude.hs
+++ b/src/Ampersand/Basics/Prelude.hs
@@ -39,10 +39,11 @@ readUTF8File fp = (Right <$> readFileUtf8 fp) `catch` handler
   where
     handler :: IOException -> RIO env (Either [Text] a)
     handler err =
-      return . Left $
-        [ "File could not be read: " <> T.pack fp,
-          tshow err
-        ]
+      return
+        . Left
+        $ [ "File could not be read: " <> T.pack fp,
+            tshow err
+          ]
 
 zipWith :: (a -> b -> c) -> [a] -> [b] -> [c]
 zipWith fun = go
@@ -53,7 +54,7 @@ zipWith fun = go
 
 -- Redefine foldl to ensure that we use foldl' everywhere. But make the Haskeller
 -- aware that in fact you should use fold'.
-foldl :: Foldable t => (b -> a -> b) -> b -> t a -> b
+foldl :: (Foldable t) => (b -> a -> b) -> b -> t a -> b
 {-# WARNING foldl "Please do not use foldl. Use foldl' instead. It is more performant." #-}
 foldl = foldl'
 
diff --git a/src/Ampersand/Basics/Version.hs b/src/Ampersand/Basics/Version.hs
index 0f2ff229b..d20ff1f00 100644
--- a/src/Ampersand/Basics/Version.hs
+++ b/src/Ampersand/Basics/Version.hs
@@ -19,21 +19,25 @@ maxLen = 1500000 -- This trick is to make sure the process is terminated after t
 
 -- | a function to create error message in a structured way, containing the version of Ampersand.
 --   It throws an error, showing a (module)name and a number. This makes debugging pretty easy.
-fatal :: HasCallStack => Text -> a
+fatal :: (HasCallStack) => Text -> a
 fatal msg =
-  exitWith . Fatal . T.lines $
-    ( "!             " <> shortVersion appVersion <> "\n"
-        <> lazyCutoff maxLen msg
-        <> "\n"
-        <> T.pack (prettyCallStack callStack)
-    )
+  exitWith
+    . Fatal
+    . T.lines
+    $ ( "!             "
+          <> shortVersion appVersion
+          <> "\n"
+          <> lazyCutoff maxLen msg
+          <> "\n"
+          <> T.pack (prettyCallStack callStack)
+      )
   where
     lazyCutoff n txt = case T.uncons txt of
       Nothing -> mempty
       Just (h, tl)
         | T.null tl -> T.cons h mempty
         | n == 0 -> "\n<Ampersand's fatal-mechanism has removed the rest of this error message.>"
-        | otherwise -> T.cons h (lazyCutoff (n -1) tl)
+        | otherwise -> T.cons h (lazyCutoff (n - 1) tl)
 {-# NOINLINE fatal #-}
 
 data VersionInfo = VersionInfo
diff --git a/src/Ampersand/Misc/Commands.hs b/src/Ampersand/Misc/Commands.hs
index 4fabef220..26623e1be 100644
--- a/src/Ampersand/Misc/Commands.hs
+++ b/src/Ampersand/Misc/Commands.hs
@@ -55,8 +55,8 @@ import System.Environment (withArgs)
 
 -- Vertically combine only the error component of the first argument with the
 -- error component of the second.
---vcatErrorHelp :: ParserHelp -> ParserHelp -> ParserHelp
---vcatErrorHelp h1 h2 = h2 { helpError = vcatChunks [helpError h2, helpError h1] }
+-- vcatErrorHelp :: ParserHelp -> ParserHelp -> ParserHelp
+-- vcatErrorHelp h1 h2 = h2 { helpError = vcatChunks [helpError h2, helpError h1] }
 
 commandLineHandler ::
   FilePath ->
@@ -169,14 +169,14 @@ commandLineHandler currentDir _progName args =
       where
         -- addCommand hiding global options
         addCommand'' ::
-          HasOptions a =>
+          (HasOptions a) =>
           Command ->
           String ->
           (a -> RIO Runner ()) ->
           Parser a ->
           AddCommand
-        addCommand'' cmd title constr parser =
-          addCommand (map toLower . show $ cmd) title globalFooter constr' (\_ gom -> gom) globalOpts parser
+        addCommand'' cmd title constr =
+          addCommand (map toLower . show $ cmd) title globalFooter constr' (\_ gom -> gom) globalOpts
           where
             constr' opts = do
               runner <- ask
@@ -197,7 +197,7 @@ type AddCommand =
 
 -- | Generate and execute a complicated options parser.
 complicatedOptions ::
-  Monoid a =>
+  (Monoid a) =>
   -- | header
   Text ->
   -- | program description (displayed between usage and options listing in the help output)
@@ -233,13 +233,13 @@ complicatedOptions h pd footerStr args commonParser mOnFailure commandParser = d
         $ infoParser parser
     myPreferences :: ParserPrefs
     myPreferences =
-      prefs $
-        showHelpOnEmpty
-          <> noBacktrack
-          <> disambiguate
+      prefs
+        $ showHelpOnEmpty
+        <> noBacktrack
+        <> disambiguate
     myDescriptionFunction :: ArgumentReachability -> Option x -> Chunk Doc
     myDescriptionFunction _info' opt =
-      dullyellow
+      annotate (colorDull Green)
         <$> paragraph (show opt) -- optHelp opt -- "Een of andere optie."
     parser = info (helpOption <*> versionOptions <*> complicatedParser "COMMAND" commonParser commandParser) desc
     desc = fullDesc <> header (T.unpack h) <> progDesc (T.unpack pd) <> footer (T.unpack footerStr)
@@ -332,7 +332,7 @@ addCommand' cmd title footerStr constr commonParser inner =
 
 -- | Generate a complicated options parser.
 complicatedParser ::
-  Monoid a =>
+  (Monoid a) =>
   -- | metavar for the sub-command
   String ->
   -- | common settings
@@ -353,8 +353,8 @@ hsubparser' :: String -> Mod CommandFields a -> Parser a
 hsubparser' commandMetavar m = mkParser d g rdr
   where
     Mod _ d g = metavar commandMetavar `mappend` m
-    (groupName, cmds, subs) = mkCommand m
-    rdr = CmdReader groupName cmds (fmap add_helper . subs)
+    (groupName, cmds) = mkCommand m
+    rdr = CmdReader groupName ((fmap . fmap) add_helper cmds)
     add_helper pinfo =
       pinfo
         { infoParser = infoParser pinfo <**> helpOption
@@ -363,9 +363,9 @@ hsubparser' commandMetavar m = mkParser d g rdr
 -- | Non-hidden help option.
 helpOption :: Parser (a -> a)
 helpOption =
-  abortOption (ShowHelpText $ Just "This is some text, but when does it show??") $
-    long "help"
-      <> help "Show this help text"
+  abortOption (ShowHelpText $ Just "This is some text, but when does it show??")
+    $ long "help"
+    <> help "Show this help text"
 
 daemonCmd :: DaemonOpts -> RIO Runner ()
 daemonCmd daemonOpts =
@@ -375,8 +375,8 @@ documentationCmd :: DocOpts -> RIO Runner ()
 documentationCmd docOpts = do
   (extendWith docOpts . forceAllowInvariants . doOrDie) doGenDocument
   where
-    forceAllowInvariants :: HasFSpecGenOpts env => RIO env a -> RIO env a
-    forceAllowInvariants env = local (set allowInvariantViolationsL True) env
+    forceAllowInvariants :: (HasFSpecGenOpts env) => RIO env a -> RIO env a
+    forceAllowInvariants = local (set allowInvariantViolationsL True)
 
 testCmd :: TestOpts -> RIO Runner ()
 testCmd testOpts =
@@ -408,7 +408,8 @@ doOrDie theAction = do
       mapM_ (logWarn . displayShow) ws
       theAction a
     Errors err ->
-      exitWith . NoValidFSpec
+      exitWith
+        . NoValidFSpec
         . T.lines
         . T.intercalate (T.replicate 30 "=" <> "\n")
         . NE.toList

From c5f0674e2ec7f1eead55a14ca1bc768fbce0cd18 Mon Sep 17 00:00:00 2001
From: hanjoosten <han.joosten@ordina.nl>
Date: Fri, 12 Apr 2024 22:12:18 +0200
Subject: [PATCH 13/43] Removed a warning

---
 src/Ampersand/ADL1/Lattices.hs | 30 +++++++++++++++++-------------
 1 file changed, 17 insertions(+), 13 deletions(-)

diff --git a/src/Ampersand/ADL1/Lattices.hs b/src/Ampersand/ADL1/Lattices.hs
index e88a18ab8..30fb69500 100644
--- a/src/Ampersand/ADL1/Lattices.hs
+++ b/src/Ampersand/ADL1/Lattices.hs
@@ -24,11 +24,12 @@ module Ampersand.ADL1.Lattices
 where
 
 import Ampersand.Basics hiding (toList)
+import Data.IntMap (Key)
 import qualified Data.IntMap as IntMap
 import qualified Data.IntSet as IntSet
 import qualified RIO.List as L
 import qualified RIO.Map as Map
-import qualified RIO.Map.Partial as PARTIAL --TODO: Get rid of partial functions
+import qualified RIO.Map.Partial as PARTIAL -- TODO: Get rid of partial functions
 import qualified RIO.Set as Set
 
 -- optimisations possible for the EqualitySystem(s):
@@ -98,7 +99,7 @@ findUpperbounds :: (Ord a) => Op1EqualitySystem a -> FreeLattice a -> [Set.Set a
 findUpperbounds = findWith findSubsetInRevMap (\x -> [fromList [x]])
 
 findWith ::
-  Ord a =>
+  (Ord a) =>
   ([Int] -> RevMap a -> b) -> -- Function that finds the normalized form
   (a -> b) -> -- Shorthand in case the FreeLattice does not need to go through the translation process
   Op1EqualitySystem a -> -- system in which the FreeLattice elements can be found
@@ -135,7 +136,7 @@ findWith f f2 es@(ES1 _ back _) trmUnsimplified =
 simplifySet :: Op1EqualitySystem t -> IntSet.IntSet -> IntSet.IntSet
 simplifySet (ES1 _ _ imap) x = imapTranslate imap x IntSet.empty
 
-latticeToTranslatable :: Ord a => Op1EqualitySystem a -> FreeLattice a -> Maybe [IntSet.IntSet]
+latticeToTranslatable :: (Ord a) => Op1EqualitySystem a -> FreeLattice a -> Maybe [IntSet.IntSet]
 latticeToTranslatable (ES1 m _ _) = t
   where
     t (Atom a) = do r <- Map.lookup a m; return [r]
@@ -212,10 +213,13 @@ reverseMap lst =
   RevMap (Set.fromList (map fst empties)) (buildMap rest)
   where
     (empties, rest) = L.partition (null . snd) lst
-    buildMap [] = IntMap.empty
-    buildMap o@((_, ~(f : _)) : _) =
-      IntMap.insert f (reverseMap (map tail2 h)) (buildMap tl)
-      where
+    buildMap :: (Ord a) => [(a, [Key])] -> IntMap (RevMap a)
+    buildMap o = case o of
+      [] -> IntMap.empty
+      ((_,[]) : _ ) -> fatal "This should be impossible, for the empties are taken out before."
+      ((_,f:_) : _ ) -> IntMap.insert f (reverseMap (map tail2 h)) (buildMap tl)
+        where
+        tail2 :: (a, [IntMap.Key]) -> (a, [IntMap.Key])
         tail2 (a, b) = (a, tail b)
         (h, tl) = L.partition ((== f) . head . snd) o
         tail [] = fatal "tail called on empty list"
@@ -224,7 +228,7 @@ reverseMap lst =
         head (x : _) = x
 
 -- | Change the system into one with fast reverse lookups
-optimize1 :: Ord a => EqualitySystem a -> Op1EqualitySystem a
+optimize1 :: (Ord a) => EqualitySystem a -> Op1EqualitySystem a
 optimize1 (ES oldmap oldimap) =
   ES1
     newmap
@@ -308,10 +312,10 @@ instance SetLike Set.Set where
 
 -- | A single set of operations to use both for ordered lists and for sets
 class SetLike x where -- I dislike having to put Ord everywhere, is there another way? (Without including a in the class)
-  toList :: Ord a => x a -> [a]
-  fromList :: Ord a => [a] -> x a
-  fromSet :: Ord a => Set.Set a -> x a
-  slEmpty :: Ord a => x a
+  toList :: (Ord a) => x a -> [a]
+  fromList :: (Ord a) => [a] -> x a
+  fromSet :: (Ord a) => Set.Set a -> x a
+  slEmpty :: (Ord a) => x a
   slEmpty = fromList []
-  slNull :: Ord a => x a -> Bool
+  slNull :: (Ord a) => x a -> Bool
   slNull = null . toList

From d326a822671968ed345c70e3e09cae739a9361e8 Mon Sep 17 00:00:00 2001
From: hanjoosten <han.joosten@ordina.nl>
Date: Sat, 13 Apr 2024 00:17:32 +0200
Subject: [PATCH 14/43] Removed some warnings because of stricter pattern
 matching with new ghc

---
 src/Ampersand/Commands/Daemon.hs       |  81 +++----
 src/Ampersand/Input/ADL1/Lexer.hs      | 301 +++++++++++++------------
 src/Ampersand/Input/ADL1/LexerMonad.hs |   1 -
 src/Ampersand/Output/PredLogic.hs      |  25 +-
 4 files changed, 220 insertions(+), 188 deletions(-)

diff --git a/src/Ampersand/Commands/Daemon.hs b/src/Ampersand/Commands/Daemon.hs
index 1cc419da8..ed9d7b3f0 100644
--- a/src/Ampersand/Commands/Daemon.hs
+++ b/src/Ampersand/Commands/Daemon.hs
@@ -47,8 +47,9 @@ mainWithTerminal :: IO TermSize -> ([String] -> RIO (ExtendedRunner DaemonOpts)
 mainWithTerminal termSize termOutput = goForever
   where
     goForever = work `catch` errorHandler
-    work = forever $
-      withWindowIcon $ do
+    work = forever
+      $ withWindowIcon
+      $ do
         -- On certain Cygwin terminals stdout defaults to BlockBuffering
         hSetBuffering stdout LineBuffering
         hSetBuffering stderr NoBuffering
@@ -58,16 +59,17 @@ mainWithTerminal termSize termOutput = goForever
         logDebug $ "%VERSION: " <> display (shortVersion appVersion)
         env <- ask
         withCurrentDirectory curDir $ do
-          termSize' <- liftIO $
-            return $ do
+          termSize' <- liftIO
+            $ return
+            $ do
               term <- termSize
               -- if we write to the final column of the window then it wraps automatically
               -- so logInfo width 'x' uses up two lines.
               -- Logging *always* ends the line, so we need to substract 1 of the hight as well.
-              return $
-                TermSize
+              return
+                $ TermSize
                   (termWidth term - 1)
-                  (termHeight term -1)
+                  (termHeight term - 1)
                   (termWrap term)
 
           restyle <- liftIO $ do
@@ -76,8 +78,9 @@ mainWithTerminal termSize termOutput = goForever
               --    Always -> return True
               --    Never -> return False
               Auto -> liftIO $ hSupportsANSI stdout
-            when useStyle $
-              liftIO $ do
+            when useStyle
+              $ liftIO
+              $ do
                 h <- lookupEnv "HSPEC_OPTIONS"
                 when (isNothing h) $ setEnv "HSPEC_OPTIONS" "--color" -- see https://github.com/ndmitchell/ghcid/issues/87
             return $ if useStyle then id else map unescape
@@ -154,32 +157,32 @@ runAmpersand app waiter termSize termOutput = do
         logDebug $ "%LOADED: " <> (displayShow . loaded $ ad)
 
         let (countErrors, countWarnings) =
-              both sum $
-                L.unzip
+              both sum
+                $ L.unzip
                   [if loadSeverity == Error then (1 :: Int, 0 :: Int) else (0, 1) | Message {..} <- messages ad, loadMessage /= []]
 
-        liftIO $
-          unless no_title $
-            setWindowIcon $
-              if countErrors > 0 then IconError else if countWarnings > 0 then IconWarning else IconOK
+        liftIO
+          $ unless no_title
+          $ setWindowIcon
+          $ if countErrors > 0 then IconError else if countWarnings > 0 then IconWarning else IconOK
 
         let updateTitle extra =
-              unless no_title $
-                setTitle $
-                  unescape $
-                    let f n msg = if n == 0 then "" else show n ++ " " ++ msg ++ ['s' | n > 1]
-                     in ( if countErrors == 0 && countWarnings == 0
-                            then allGoodMessage ++ ", at " ++ currTime
-                            else
-                              f countErrors "error"
-                                ++ (if countErrors > 0 && countWarnings > 0 then ", " else "")
-                                ++ f countWarnings "warning"
-                        )
-                          ++ " "
-                          ++ extra
-                          ++ [' ' | extra /= ""]
-                          ++ "- "
-                          ++ project
+              unless no_title
+                $ setTitle
+                $ unescape
+                $ let f n msg = if n == 0 then "" else show n ++ " " ++ msg ++ ['s' | n > 1]
+                   in ( if countErrors == 0 && countWarnings == 0
+                          then allGoodMessage ++ ", at " ++ currTime
+                          else
+                            f countErrors "error"
+                              ++ (if countErrors > 0 && countWarnings > 0 then ", " else "")
+                              ++ f countWarnings "warning"
+                      )
+                        ++ " "
+                        ++ extra
+                        ++ [' ' | extra /= ""]
+                        ++ "- "
+                        ++ project
 
         liftIO $ updateTitle ""
 
@@ -211,7 +214,7 @@ prettyOutput _ _ xs = concatMap loadMessage xs
 -- | A version of 'nubOrd' which operates on a portion of the value.
 --
 -- > nubOrdOn length ["a","test","of","this"] == ["a","test","of"]
-nubOrdOn :: Ord b => (a -> b) -> [a] -> [a]
+nubOrdOn :: (Ord b) => (a -> b) -> [a] -> [a]
 nubOrdOn f = map snd . nubOrdBy (compare `on` fst) . map (f &&& id)
 
 -- | A version of 'nubOrd' with a custom predicate.
@@ -240,7 +243,9 @@ insertRB :: (a -> a -> Ordering) -> a -> RB a -> RB a
 insertRB cmp x s =
   T B a z b
   where
-    T _ a z b = ins s
+    (a, z, b) = case ins s of
+      T _ a' z' b' -> (a', z', b')
+      _ -> fatal "This is not supposed to happen"
     ins E = T R E x E
     ins s'@(T B a' y b') = case cmp x y of
       LT -> balance (ins a') y b'
@@ -279,19 +284,19 @@ balance a x b = T B a x b
 -- > withTempDir $ \dir -> do writeFile (dir </> "foo.txt") ""; withCurrentDirectory dir $ doesFileExist "foo.txt"
 withCurrentDirectory :: FilePath -> RIO env a -> RIO env a
 withCurrentDirectory dir act =
-  bracket' getCurrentDirectory setCurrentDirectory $
-    const
+  bracket' getCurrentDirectory setCurrentDirectory
+    $ const
       ( do
           liftIO $ setCurrentDirectory dir
           act
       )
   where
     bracket' ::
-      -- | computation to run first (\"acquire resource\")
+      -- \| computation to run first (\"acquire resource\")
       IO a ->
-      -- | computation to run last (\"release resource\")
+      -- \| computation to run last (\"release resource\")
       (a -> IO b) ->
-      -- | computation to run in-between
+      -- \| computation to run in-between
       (a -> RIO env c) ->
       RIO env c -- returns the value from the in-between computation
     bracket' before after thing =
diff --git a/src/Ampersand/Input/ADL1/Lexer.hs b/src/Ampersand/Input/ADL1/Lexer.hs
index 42fd7974b..309a39ee8 100644
--- a/src/Ampersand/Input/ADL1/Lexer.hs
+++ b/src/Ampersand/Input/ADL1/Lexer.hs
@@ -39,90 +39,91 @@ keywords ::
   -- | The keywords
   [Text1]
 keywords =
-  fmap toText1Unsafe . L.nub $
-    [ "CONTEXT",
-      "ENDCONTEXT",
-      "IN"
-    ]
-      ++ [ T.toUpper $ tshow x | x :: Lang <- [minBound ..]
-         ]
-      ++ [ "INCLUDE",
-           "META",
-           "PATTERN",
-           "ENDPATTERN",
-           "CONCEPT",
-           "LABEL",
-           -- Keywords for Relation-statements
-           "RELATION",
-           "PRAGMA",
-           "MEANING",
-           "ASY",
-           "INJ",
-           "IRF",
-           "RFX",
-           "SUR",
-           "SYM",
-           "TOT",
-           "TRN",
-           "UNI",
-           "PROP",
-           "VALUE",
-           "EVALPHP",
-           "POPULATION",
-           "CONTAINS",
-           -- Keywords for rules
-           "RULE",
-           "MESSAGE",
-           "VIOLATION",
-           "TXT"
-         ]
-      ++ [ T.toUpper $ tshow x | x :: SrcOrTgt <- [minBound ..]
-         ]
-      ++ [ "I",
-           "V",
-           "ONE",
-           "ROLE",
-           "MAINTAINS",
-           -- Keywords for purposes
-           "PURPOSE",
-           "REF"
-         ]
-      ++ [ T.toUpper $ tshow x | x :: PandocFormat <- [minBound ..]
-         ]
-      ++
-      -- Keywords for interfaces
-      [ "INTERFACE",
-        "FOR",
-        "LINKTO",
-        "API",
-        "BOX",
-        -- Keywords for identitys
-        "IDENT",
-        -- Keywords for views
-        "VIEW",
-        "ENDVIEW",
-        "DEFAULT",
-        "TEMPLATE",
-        "HTML",
-        -- Keywords for generalisations:
-        "CLASSIFY",
-        "ISA",
-        "IS",
-        -- Keywords for TType:
-        "REPRESENT",
-        "TYPE"
-      ]
-      ++ [ T.toUpper $ tshow tt | tt :: TType <- [minBound ..], tt /= TypeOfOne
-         ]
-      ++
-      -- Keywords for values of atoms:
-      [ "TRUE",
-        "FALSE", --for booleans
-        -- Experimental stuff:
-        "SERVICE",
-        -- Enforce statement:
-        "ENFORCE" -- TODO: "BY", "INVARIANT" (See issue #1204)
+  fmap toText1Unsafe
+    . L.nub
+    $ [ "CONTEXT",
+        "ENDCONTEXT",
+        "IN"
       ]
+    ++ [ T.toUpper $ tshow x | x :: Lang <- [minBound ..]
+       ]
+    ++ [ "INCLUDE",
+         "META",
+         "PATTERN",
+         "ENDPATTERN",
+         "CONCEPT",
+         "LABEL",
+         -- Keywords for Relation-statements
+         "RELATION",
+         "PRAGMA",
+         "MEANING",
+         "ASY",
+         "INJ",
+         "IRF",
+         "RFX",
+         "SUR",
+         "SYM",
+         "TOT",
+         "TRN",
+         "UNI",
+         "PROP",
+         "VALUE",
+         "EVALPHP",
+         "POPULATION",
+         "CONTAINS",
+         -- Keywords for rules
+         "RULE",
+         "MESSAGE",
+         "VIOLATION",
+         "TXT"
+       ]
+    ++ [ T.toUpper $ tshow x | x :: SrcOrTgt <- [minBound ..]
+       ]
+    ++ [ "I",
+         "V",
+         "ONE",
+         "ROLE",
+         "MAINTAINS",
+         -- Keywords for purposes
+         "PURPOSE",
+         "REF"
+       ]
+    ++ [ T.toUpper $ tshow x | x :: PandocFormat <- [minBound ..]
+       ]
+    ++
+    -- Keywords for interfaces
+    [ "INTERFACE",
+      "FOR",
+      "LINKTO",
+      "API",
+      "BOX",
+      -- Keywords for identitys
+      "IDENT",
+      -- Keywords for views
+      "VIEW",
+      "ENDVIEW",
+      "DEFAULT",
+      "TEMPLATE",
+      "HTML",
+      -- Keywords for generalisations:
+      "CLASSIFY",
+      "ISA",
+      "IS",
+      -- Keywords for TType:
+      "REPRESENT",
+      "TYPE"
+    ]
+    ++ [ T.toUpper $ tshow tt | tt :: TType <- [minBound ..], tt /= TypeOfOne
+       ]
+    ++
+    -- Keywords for values of atoms:
+    [ "TRUE",
+      "FALSE", -- for booleans
+      -- Experimental stuff:
+      "SERVICE",
+      -- Enforce statement:
+      "ENFORCE" -- TODO: "BY", "INVARIANT" (See issue #1204)
+    ]
 
 -- | Retrieves a list of operators accepted by the Ampersand language
 operators ::
@@ -193,12 +194,12 @@ mainLexer _ [] = return []
 mainLexer p ('-' : '-' : s) = mainLexer p (skipLine s)
 mainLexer p (c : s)
   | isSpace c =
-    let (spc, next) = span isSpaceNoTab s
-        isSpaceNoTab x = isSpace x && (not . isTab) x
-        isTab = ('\t' ==)
-     in do
-          when (isTab c) (lexerWarning TabCharacter p)
-          mainLexer (foldl' updatePos p (c : spc)) next
+      let (spc, next) = span isSpaceNoTab s
+          isSpaceNoTab x = isSpace x && (not . isTab) x
+          isTab = ('\t' ==)
+       in do
+            when (isTab c) (lexerWarning TabCharacter p)
+            mainLexer (foldl' updatePos p (c : spc)) next
 mainLexer p ('{' : '-' : s) = lexNestComment mainLexer (addPos 2 p) s
 mainLexer p ('{' : '+' : s) = lexMarkup mainLexer (addPos 2 p) s
 mainLexer p ('"' : ss) =
@@ -218,26 +219,26 @@ mainLexer p ('<' : d : s) =
         else returnToken (LexSymbol '<') p mainLexer (addPos 1 p) (d : s)
 mainLexer p cs@(c : s)
   | isSafeIdChar True c =
-    let (name', p', s') = scanIdent (addPos 1 p) s
-        name'' = Text1 c $ T.pack name'
-        tokt
-          | iskeyword name'' = LexKeyword name''
-          | otherwise = LexSafeID name''
-     in returnToken tokt p mainLexer p' s'
+      let (name', p', s') = scanIdent (addPos 1 p) s
+          name'' = Text1 c $ T.pack name'
+          tokt
+            | iskeyword name'' = LexKeyword name''
+            | otherwise = LexSafeID name''
+       in returnToken tokt p mainLexer p' s'
   | prefixIsOperator (T.pack cs) =
-    let (name', s') = getOp cs
-     in returnToken (LexOperator name') p mainLexer (foldl' updatePos p (T.unpack . text1ToText $ name')) (T.unpack s')
+      let (name', s') = getOp cs
+       in returnToken (LexOperator name') p mainLexer (foldl' updatePos p (T.unpack . text1ToText $ name')) (T.unpack s')
   | isSymbol c = returnToken (LexSymbol c) p mainLexer (addPos 1 p) s
   | isDigit c =
-    case getDateTime cs of
-      Just (Right (tk, _, width, s')) -> returnToken tk p mainLexer (addPos width p) s'
-      Just (Left msg) -> lexerError msg p
-      Nothing ->
-        case getDate cs of
-          Just (tk, _, width, s') -> returnToken tk p mainLexer (addPos width p) s'
-          Nothing ->
-            let (tk, _, width, s') = getNumber cs
-             in returnToken tk p mainLexer (addPos width p) s'
+      case getDateTime cs of
+        Just (Right (tk, _, width, s')) -> returnToken tk p mainLexer (addPos width p) s'
+        Just (Left msg) -> lexerError msg p
+        Nothing ->
+          case getDate cs of
+            Just (tk, _, width, s') -> returnToken tk p mainLexer (addPos width p) s'
+            Nothing ->
+              let (tk, _, width, s') = getNumber cs
+               in returnToken tk p mainLexer (addPos width p) s'
   -- Ignore unexpected characters in the beginning of the file because of the UTF-8 BOM marker.
   -- TODO: Find out the right way of handling the BOM marker.
   | beginFile p = do lexerWarning UtfChar p; mainLexer p s
@@ -323,12 +324,13 @@ getDateTime cs =
           _ -> getDateTime' cs -- Here we try the ohter notation of time
         Just (timeOfDay, tzoneOffset, lt, rt) ->
           let ucttime = addUTCTime tzoneOffset (UTCTime day timeOfDay)
-           in Just . Right $
-                ( LexDateTime ucttime,
-                  ucttime,
-                  ld + lt,
-                  rt
-                )
+           in Just
+                . Right
+                $ ( LexDateTime ucttime,
+                    ucttime,
+                    ld + lt,
+                    rt
+                  )
 
 getTime :: String -> Maybe (DiffTime, NominalDiffTime, Int, String)
 getTime cs =
@@ -336,8 +338,12 @@ getTime cs =
     'T' : h1 : h2 : ':' : m1 : m2 : rest ->
       if all isDigit [h1, h2, m1, m2]
         then
-          let (_, Left hours, _, _) = getNumber [h1, h2]
-              (_, Left minutes, _, _) = getNumber [m1, m2]
+          let hours = case getNumber [h1, h2] of
+                (_, Left val, _, _) -> val
+                _ -> fatal "Impossible, for h1 and h2 are digits"
+              minutes = case getNumber [m1, m2] of
+                (_, Left val, _, _) -> val
+                _ -> fatal "Impossible, for m1 and m2 are digits"
               (seconds, ls, rs) = getSeconds rest
            in case getTZD rs of
                 Nothing -> Nothing
@@ -345,12 +351,14 @@ getTime cs =
                   if hours < 24 && minutes < 60 && seconds < 60
                     then
                       Just
-                        ( fromRational . toRational $
-                            ( fromIntegral hours * 60
-                                + fromIntegral minutes
-                            )
-                              * 60
-                              + seconds,
+                        ( fromRational
+                            . toRational
+                            $ ( fromIntegral hours
+                                  * 60
+                                  + fromIntegral minutes
+                              )
+                            * 60
+                            + seconds,
                           offset,
                           1 + 5 + ls + lo,
                           ro
@@ -373,7 +381,7 @@ getSeconds cs =
 getFraction :: String -> (Float, Int, String)
 getFraction cs =
   case readFloat cs of
-    [(a, str)] -> (a, length cs - length str, str) --TODO: Make more efficient.
+    [(a, str)] -> (a, length cs - length str, str) -- TODO: Make more efficient.
     _ -> (0, 0, cs)
 
 getTZD :: String -> Maybe (NominalDiffTime, Int, String)
@@ -386,17 +394,26 @@ getTZD cs =
   where
     mkOffset :: String -> String -> String -> (Int -> Int -> Int) -> Maybe (NominalDiffTime, Int, String)
     mkOffset hs ms rest op =
-      let (_, Left hours, _, _) = getNumber hs
-          (_, Left minutes, _, _) = getNumber ms
-          total = hours * 60 + minutes
-       in if hours <= 24 && minutes < 60
+      join $ total <$> hours <*> minutes
+      where
+        hours = case getNumber hs of
+          (_, Left val, _, _) -> Just val
+          _ -> Nothing
+        minutes = case getNumber ms of
+          (_, Left val, _, _) -> Just val
+          _ -> Nothing
+        total :: Int -> Int -> Maybe (NominalDiffTime, Int, String)
+        total hs' ms' =
+          if tot < 24 * 60
             then
               Just
-                ( fromRational . toRational $ 0 `op` total,
+                ( fromRational . toRational $ 0 `op` tot,
                   6,
                   rest
                 )
             else Nothing
+          where
+            tot = hs' * 60 + ms'
 
 getDateTime' :: String -> Maybe (Either LexerErrorInfo (Lexeme, UTCTime, Int, String))
 getDateTime' cs = case readUniversalTime cs of
@@ -409,7 +426,7 @@ getDateTime' cs = case readUniversalTime cs of
     best candidates = case reverse . L.sortBy myOrdering $ candidates of
       [] -> Nothing
       (h : _) -> Just h
-    myOrdering :: Show a => (a, b) -> (a, b) -> Ordering
+    myOrdering :: (Show a) => (a, b) -> (a, b) -> Ordering
     myOrdering (x, _) (y, _) = compare (length . show $ x) (length . show $ y)
 
 getDate :: String -> Maybe (Lexeme, Day, Int, String)
@@ -422,9 +439,15 @@ getDate cs =
           Just d -> Just (LexDate d, d, 10, rest)
         else Nothing
       where
-        (_, Left year, _, _) = getNumber [y1, y2, y3, y4]
-        (_, Left month, _, _) = getNumber [m1, m2]
-        (_, Left day, _, _) = getNumber [d1, d2]
+        year = case getNumber [y1, y2, y3, y4] of
+          (_, Left x, _, _) -> x
+          _ -> fatal "Impossible, [y1, y2, y3, y4] are digits."
+        month = case getNumber [m1, m2] of
+          (_, Left x, _, _) -> x
+          _ -> fatal "Impossible, [m1, m2] are digits."
+        day = case getNumber [d1, d2] of
+          (_, Left x, _, _) -> x
+          _ -> fatal "Impossible, [d1, d2] are digits."
     _ -> Nothing
 
 -----------------------------------------------------------
@@ -440,9 +463,9 @@ getNumber str =
     [(dec, rest)] -> (LexDecimal dec, Left dec, length str - length rest, rest)
     _ -> fatal $ "No number to read!\n  " <> T.take 40 (T.pack str)
 
---getNumber :: String -> (Lexeme, (Either Int Double), Int, String)
---getNumber [] = fatal "getNumber"
---getNumber cs@(c:s)
+-- getNumber :: String -> (Lexeme, (Either Int Double), Int, String)
+-- getNumber [] = fatal "getNumber"
+-- getNumber cs@(c:s)
 --  | c /= '0'         = num10
 --  | null s           = const0
 --  | hs `elem` "xX"   = num16
@@ -514,14 +537,14 @@ getEscChar :: String -> (Maybe Char, Int, String)
 getEscChar [] = (Nothing, 0, [])
 getEscChar s@(x : xs)
   | isDigit x = case readDec s of
-    [(val, rest)]
-      | val >= 0 && val <= ord (maxBound :: Char) -> (Just (Partial.chr val), length s - length rest, rest)
-      | otherwise -> (Nothing, 1, rest)
-    _ -> fatal $ "Impossible! first char is a digit.. " <> T.take 40 (T.pack s)
+      [(val, rest)]
+        | val >= 0 && val <= ord (maxBound :: Char) -> (Just (Partial.chr val), length s - length rest, rest)
+        | otherwise -> (Nothing, 1, rest)
+      _ -> fatal $ "Impossible! first char is a digit.. " <> T.take 40 (T.pack s)
   | x `elem` ['\"', '\''] = (Just x, 2, xs)
   | otherwise = case x `lookup` cntrChars of
-    Nothing -> (Nothing, 0, s)
-    Just c -> (Just c, 1, xs)
+      Nothing -> (Nothing, 0, s)
+      Just c -> (Just c, 1, xs)
   where
     cntrChars =
       [ ('a', '\a'),
diff --git a/src/Ampersand/Input/ADL1/LexerMonad.hs b/src/Ampersand/Input/ADL1/LexerMonad.hs
index f2f1426f5..a2ce88031 100644
--- a/src/Ampersand/Input/ADL1/LexerMonad.hs
+++ b/src/Ampersand/Input/ADL1/LexerMonad.hs
@@ -54,7 +54,6 @@ returnLM x = LM (\pos brackets -> Right (x, [], pos, brackets))
 
 instance Monad LexerMonad where
   (>>=) = bindLM
-  return = returnLM
 
 instance Functor LexerMonad where
   -- fmap :: (a -> b) -> LexerMonad a -> LexerMonad b
diff --git a/src/Ampersand/Output/PredLogic.hs b/src/Ampersand/Output/PredLogic.hs
index 0440bf12b..948af0708 100644
--- a/src/Ampersand/Output/PredLogic.hs
+++ b/src/Ampersand/Output/PredLogic.hs
@@ -6,9 +6,12 @@ where
 import Ampersand.ADL1
 import Ampersand.Basics hiding (toList)
 import Ampersand.Classes
-import qualified RIO.List as L
-import qualified RIO.List.Partial as P -- TODO Use NonEmpty
+-- TODO Use NonEmpty
 -- import qualified RIO.Map as M
+
+import qualified Data.List.NonEmpty as NE
+import qualified RIO.List as L
+import qualified RIO.List.Partial as P
 import qualified RIO.NonEmpty as NE
 import qualified RIO.Set as Set
 import qualified RIO.Text as T
@@ -52,7 +55,7 @@ showPredLogic lang expr = text $ predLshow lang varMap (predNormalize predL)
     -- For printing a variable we use varMap
     -- A variable is represented by the first character of its concept name, followed by a number of primes to distinguish from similar variables.
     varMap :: Var -> Text
-    varMap (Var n c) = vChar c <> (T.pack . replicate (length vars -1)) '\''
+    varMap (Var n c) = vChar c <> (T.pack . replicate (length vars - 1)) '\''
       where
         vars = Set.filter (\(Var i c') -> i <= n && vChar c == vChar c') varSet
         vChar = T.toLower . T.take 1 . namePartToText . localName
@@ -111,10 +114,10 @@ predLshow lang vMap = charshow 0
         R pexpr rel pexpr'
           | isIdent (EDcD rel) -> wrap i 5 (charshow 2 pexpr) <> T.pack " = " <> wrap i 2 (charshow 5 pexpr')
           | otherwise ->
-            wrap i 5 $
-              if T.null (decprL <> decprM <> decprR)
-                then d <> T.pack " " <> fullName rel <> T.pack " " <> c
-                else decprL <> d <> decprM <> c <> decprR
+              wrap i 5
+                $ if T.null (decprL <> decprM <> decprR)
+                  then d <> T.pack " " <> fullName rel <> T.pack " " <> c
+                  else decprL <> d <> decprM <> c <> decprR
           where
             d = wrap i 5 (charshow 5 pexpr)
             c = wrap i 5 (charshow 5 pexpr')
@@ -131,7 +134,7 @@ predLshow lang vMap = charshow 0
         Not rs -> wrap i 8 (l (toNL " niet ", toEN " not ") <> charshow 1 rs)
 
 predNormalize :: PredLogic -> PredLogic
-predNormalize predlogic = predlogic --TODO: Fix normalization of PredLogic
+predNormalize predlogic = predlogic -- TODO: Fix normalization of PredLogic
 
 -- The function 'toPredLogic' translates an expression to predicate logic for two purposes:
 -- The first purpose is that it is a step towards generating natural language.
@@ -156,7 +159,7 @@ toPredLogic expr =
         s = mkVar Set.empty (source expr) :: Var
         ss = addVar Set.empty s :: VarSet
         t = mkVar ss (target expr) :: Var
-        Just vars = NE.nonEmpty [s, t]
+        vars = s NE.:| [t]
         vM = addVar ss t :: VarSet
   where
     oneVar :: Var
@@ -242,7 +245,9 @@ toPredLogic expr =
     fencePoles varSet fences (a, b) = (polVs, predLs, varSet'')
       where
         poles = (map source . NE.tail) fences :: [A_Concept] -- the "in between concepts"
-        Just polVs = NE.nonEmpty vars
+        polVs = case vars of
+          [] -> fatal "Can this happen??"
+          (h : tl) -> h NE.:| tl
         (varSet', vars) -- (VarSet,[Var])
           =
           foldr g (varSet, []) poles

From 7669f6cdd6be3ffdcdfb2654fe40428161cbe97c Mon Sep 17 00:00:00 2001
From: hanjoosten <han.joosten@ordina.nl>
Date: Sat, 13 Apr 2024 00:23:28 +0200
Subject: [PATCH 15/43] Remove unused import

---
 src/Ampersand/Output/PredLogic.hs | 3 +--
 1 file changed, 1 insertion(+), 2 deletions(-)

diff --git a/src/Ampersand/Output/PredLogic.hs b/src/Ampersand/Output/PredLogic.hs
index 948af0708..35c06910f 100644
--- a/src/Ampersand/Output/PredLogic.hs
+++ b/src/Ampersand/Output/PredLogic.hs
@@ -9,7 +9,6 @@ import Ampersand.Classes
 -- TODO Use NonEmpty
 -- import qualified RIO.Map as M
 
-import qualified Data.List.NonEmpty as NE
 import qualified RIO.List as L
 import qualified RIO.List.Partial as P
 import qualified RIO.NonEmpty as NE
@@ -70,7 +69,7 @@ predLshow lang vMap = charshow 0
     l :: LocalizedStr -> Text
     l = localize lang
     listVars :: Text -> NE.NonEmpty Var -> Text
-    listVars sep vars = T.intercalate sep . NE.toList . fmap vMap $ vars
+    listVars sep = T.intercalate sep . NE.toList . fmap vMap
 
     wrap :: Integer -> Integer -> Text -> Text
     wrap i j txt = if i <= j then txt else T.pack "(" <> txt <> T.pack ")"

From 5158d875080508e76f3d66f0b30388d727438d02 Mon Sep 17 00:00:00 2001
From: hanjoosten <han.joosten@ordina.nl>
Date: Sat, 13 Apr 2024 00:26:43 +0200
Subject: [PATCH 16/43] fix hlint hint

---
 src/Ampersand/Core/ParseTree.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/Ampersand/Core/ParseTree.hs b/src/Ampersand/Core/ParseTree.hs
index ddc00ef9e..2d7fa711a 100644
--- a/src/Ampersand/Core/ParseTree.hs
+++ b/src/Ampersand/Core/ParseTree.hs
@@ -177,7 +177,7 @@ data P_RoleRule = Maintain
   deriving (Show) -- deriving (Show) is just for debugging
 
 instance Traced P_RoleRule where
-  origin (Maintain {pos = orig}) = orig
+  origin Maintain {pos = orig} = orig
 
 data Role = Role
   { pos :: !Origin,

From abe5b809412d5c9561556254afa239ae8042408e Mon Sep 17 00:00:00 2001
From: hanjoosten <han.joosten@ordina.nl>
Date: Sun, 14 Apr 2024 11:27:05 +0200
Subject: [PATCH 17/43] show build time with version command

---
 src/Ampersand/Misc/Commands.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/Ampersand/Misc/Commands.hs b/src/Ampersand/Misc/Commands.hs
index 26623e1be..dde12ff2b 100644
--- a/src/Ampersand/Misc/Commands.hs
+++ b/src/Ampersand/Misc/Commands.hs
@@ -249,7 +249,7 @@ complicatedOptions h pd footerStr args commonParser mOnFailure commandParser = d
         normal :: Parser (a -> a)
         normal =
           infoOption
-            (T.unpack $ shortVersion appVersion)
+            (T.unpack $ longVersion appVersion)
             ( short 'V'
                 <> long "version"
                 <> help "Show version"

From f185b940207172cf0318f6182c9c6d22ac2bb3eb Mon Sep 17 00:00:00 2001
From: hanjoosten <han.joosten@ordina.nl>
Date: Sun, 14 Apr 2024 11:48:42 +0200
Subject: [PATCH 18/43] fix lexer for date/time stuff

---
 src/Ampersand/Input/ADL1/Lexer.hs | 35 +++++++++++++------------------
 1 file changed, 15 insertions(+), 20 deletions(-)

diff --git a/src/Ampersand/Input/ADL1/Lexer.hs b/src/Ampersand/Input/ADL1/Lexer.hs
index 309a39ee8..661ab385c 100644
--- a/src/Ampersand/Input/ADL1/Lexer.hs
+++ b/src/Ampersand/Input/ADL1/Lexer.hs
@@ -394,26 +394,21 @@ getTZD cs =
   where
     mkOffset :: String -> String -> String -> (Int -> Int -> Int) -> Maybe (NominalDiffTime, Int, String)
     mkOffset hs ms rest op =
-      join $ total <$> hours <*> minutes
-      where
-        hours = case getNumber hs of
-          (_, Left val, _, _) -> Just val
-          _ -> Nothing
-        minutes = case getNumber ms of
-          (_, Left val, _, _) -> Just val
-          _ -> Nothing
-        total :: Int -> Int -> Maybe (NominalDiffTime, Int, String)
-        total hs' ms' =
-          if tot < 24 * 60
+      let hours = case getNumber hs of
+            (_, Left val, _, _) -> val
+            _ -> fatal "Impossible, for h1 and h2 are digits"
+          minutes = case getNumber ms of
+            (_, Left val, _, _) -> val
+            _ -> fatal "Impossible, for m1 and m2 are digits"
+          total = hours * 60 + minutes
+       in if hours <= 24 && minutes < 60
             then
               Just
-                ( fromRational . toRational $ 0 `op` tot,
+                ( fromRational . toRational $ 0 `op` total,
                   6,
                   rest
                 )
             else Nothing
-          where
-            tot = hs' * 60 + ms'
 
 getDateTime' :: String -> Maybe (Either LexerErrorInfo (Lexeme, UTCTime, Int, String))
 getDateTime' cs = case readUniversalTime cs of
@@ -440,14 +435,14 @@ getDate cs =
         else Nothing
       where
         year = case getNumber [y1, y2, y3, y4] of
-          (_, Left x, _, _) -> x
-          _ -> fatal "Impossible, [y1, y2, y3, y4] are digits."
+          (_, Left val, _, _) -> val
+          _ -> fatal "Impossible, for [y1, y2, y3, y4] are digits"
         month = case getNumber [m1, m2] of
-          (_, Left x, _, _) -> x
-          _ -> fatal "Impossible, [m1, m2] are digits."
+          (_, Left val, _, _) -> val
+          _ -> fatal "Impossible, for m1 and m2 are digits"
         day = case getNumber [d1, d2] of
-          (_, Left x, _, _) -> x
-          _ -> fatal "Impossible, [d1, d2] are digits."
+          (_, Left val, _, _) -> val
+          _ -> fatal "Impossible, for d1 and d2 are digits"
     _ -> Nothing
 
 -----------------------------------------------------------

From 56a1520648b3057d14c43b7741923cded71fa1f2 Mon Sep 17 00:00:00 2001
From: hanjoosten <han.joosten@ordina.nl>
Date: Sun, 14 Apr 2024 16:09:34 +0200
Subject: [PATCH 19/43] remove optional " UTC" at end of datetime

---
 .devcontainer/devcontainer.json   | 3 ++-
 src/Ampersand/Input/ADL1/Lexer.hs | 1 +
 2 files changed, 3 insertions(+), 1 deletion(-)

diff --git a/.devcontainer/devcontainer.json b/.devcontainer/devcontainer.json
index dfca0a558..c4a64b1b1 100644
--- a/.devcontainer/devcontainer.json
+++ b/.devcontainer/devcontainer.json
@@ -24,7 +24,8 @@
         "mhutchie.git-graph",
         "editorconfig.editorconfig",
         // Because of bug (see https://github.com/Microsoft/vscode/issues/45997):
-        "bdsoftware.format-on-auto-save"
+        "bdsoftware.format-on-auto-save",
+        "rcook.ghci-helper"
       ],
       "settings": {
         "editor.formatonsave": true,
diff --git a/src/Ampersand/Input/ADL1/Lexer.hs b/src/Ampersand/Input/ADL1/Lexer.hs
index 661ab385c..ff26a1ad0 100644
--- a/src/Ampersand/Input/ADL1/Lexer.hs
+++ b/src/Ampersand/Input/ADL1/Lexer.hs
@@ -390,6 +390,7 @@ getTZD cs =
     'Z' : rest -> Just (0, 1, rest)
     '+' : h1 : h2 : ':' : m1 : m2 : rest -> mkOffset [h1, h2] [m1, m2] rest (+)
     '-' : h1 : h2 : ':' : m1 : m2 : rest -> mkOffset [h1, h2] [m1, m2] rest (-)
+    ' ' : 'U' : 'T' : 'C' : rest -> Just (0, T.length " UTC", rest)
     _ -> Nothing
   where
     mkOffset :: String -> String -> String -> (Int -> Int -> Int) -> Maybe (NominalDiffTime, Int, String)

From b6267a657ac51efd959bdf4bb8520bb08867f06a Mon Sep 17 00:00:00 2001
From: hanjoosten <han.joosten@ordina.nl>
Date: Sun, 14 Apr 2024 21:24:49 +0200
Subject: [PATCH 20/43] read away " UTC" as postfix of datetime values

---
 src/Ampersand/Input/ADL1/Lexer.hs | 37 ++++++--------
 src/Ampersand/Input/Parsing.hs    | 84 +++++++++++++++----------------
 2 files changed, 57 insertions(+), 64 deletions(-)

diff --git a/src/Ampersand/Input/ADL1/Lexer.hs b/src/Ampersand/Input/ADL1/Lexer.hs
index ff26a1ad0..9e744bb82 100644
--- a/src/Ampersand/Input/ADL1/Lexer.hs
+++ b/src/Ampersand/Input/ADL1/Lexer.hs
@@ -317,20 +317,13 @@ getDateTime :: String -> Maybe (Either LexerErrorInfo (Lexeme, UTCTime, Int, Str
 getDateTime cs =
   case getDate cs of
     Nothing -> Nothing
-    Just (_, day, ld, rd) ->
-      case getTime rd of
-        Nothing -> case rd of
-          'T' : _ -> Just . Left $ ProblematicISO8601DateTime
-          _ -> getDateTime' cs -- Here we try the ohter notation of time
-        Just (timeOfDay, tzoneOffset, lt, rt) ->
-          let ucttime = addUTCTime tzoneOffset (UTCTime day timeOfDay)
-           in Just
-                . Right
-                $ ( LexDateTime ucttime,
-                    ucttime,
-                    ld + lt,
-                    rt
-                  )
+    Just (_, day, ld, rd) -> case getTime rd of
+      Nothing -> case rd of
+        'T' : _ -> Just . Left $ ProblematicISO8601DateTime
+        _ -> getDateTime' cs -- Here we try the ohter notation of time
+      Just (timeOfDay, tzoneOffset, lt, rt) ->
+        let ucttime = addUTCTime tzoneOffset (UTCTime day timeOfDay)
+         in Just . Right $ (LexDateTime ucttime, ucttime, ld + lt, rt)
 
 getTime :: String -> Maybe (DiffTime, NominalDiffTime, Int, String)
 getTime cs =
@@ -385,13 +378,11 @@ getFraction cs =
     _ -> (0, 0, cs)
 
 getTZD :: String -> Maybe (NominalDiffTime, Int, String)
-getTZD cs =
-  case cs of
-    'Z' : rest -> Just (0, 1, rest)
-    '+' : h1 : h2 : ':' : m1 : m2 : rest -> mkOffset [h1, h2] [m1, m2] rest (+)
-    '-' : h1 : h2 : ':' : m1 : m2 : rest -> mkOffset [h1, h2] [m1, m2] rest (-)
-    ' ' : 'U' : 'T' : 'C' : rest -> Just (0, T.length " UTC", rest)
-    _ -> Nothing
+getTZD cs = case cs of
+  'Z' : rest -> Just (0, 1, rest)
+  '+' : h1 : h2 : ':' : m1 : m2 : rest -> mkOffset [h1, h2] [m1, m2] rest (+)
+  '-' : h1 : h2 : ':' : m1 : m2 : rest -> mkOffset [h1, h2] [m1, m2] rest (-)
+  _ -> Nothing
   where
     mkOffset :: String -> String -> String -> (Int -> Int -> Int) -> Maybe (NominalDiffTime, Int, String)
     mkOffset hs ms rest op =
@@ -421,7 +412,9 @@ getDateTime' cs = case readUniversalTime cs of
     best :: [(UTCTime, String)] -> Maybe (UTCTime, String)
     best candidates = case reverse . L.sortBy myOrdering $ candidates of
       [] -> Nothing
-      (h : _) -> Just h
+      ((tim, rst) : _) -> case rst of
+        ' ' : 'U' : 'T' : 'C' : x -> Just (tim, x)
+        _ -> Just (tim, rst)
     myOrdering :: (Show a) => (a, b) -> (a, b) -> Ordering
     myOrdering (x, _) (y, _) = compare (length . show $ x) (length . show $ y)
 
diff --git a/src/Ampersand/Input/Parsing.hs b/src/Ampersand/Input/Parsing.hs
index 1db389e3c..72aec0e34 100644
--- a/src/Ampersand/Input/Parsing.hs
+++ b/src/Ampersand/Input/Parsing.hs
@@ -185,7 +185,7 @@ parseADLs ns parsedFilePaths fpIncludes =
         parseTheRest (ctx, includes) =
           whenCheckedM
             (parseADLs ns (parsedFilePaths <> [x]) (includes <> xs))
-            (\rst -> pure . pure $ (x, ctx) : rst) --return . pure . (:) (x,ctx)
+            (\rst -> pure . pure $ (x, ctx) : rst) -- return . pure . (:) (x,ctx)
 
 -- | ParseCandidate is intended to represent an INCLUDE-statement.
 --   This information is gathered while parsing and returned alongside the parse result.
@@ -217,8 +217,8 @@ parseSingleADL ns pc =
     if isJust (pcFileKind pc) || exists
       then parseSingleADL'
       else
-        return $
-          mkErrorReadingINCLUDE
+        return
+          $ mkErrorReadingINCLUDE
             (pcOrigin pc)
             [ "While looking for " <> T.pack filePath,
               "   File does not exist."
@@ -229,49 +229,49 @@ parseSingleADL ns pc =
     parseSingleADL'
       | -- This feature enables the parsing of Excel files, that are prepared for Ampersand.
         extension == ".xlsx" = do
-        popFromExcel <- catchInvalidXlsx $ parseXlsxFile (pcFileKind pc) filePath
-        return ((,[]) <$> popFromExcel) -- An Excel file does not contain include files
+          popFromExcel <- catchInvalidXlsx $ parseXlsxFile (pcFileKind pc) filePath
+          return ((,[]) <$> popFromExcel) -- An Excel file does not contain include files
       | -- This feature enables the parsing of Archimate models in ArchiMate® Model Exchange File Format
         extension == ".archimate" = do
-        ctxFromArchi <- archi2PContext filePath -- e.g. "CA repository.xml"
-        logInfo (display (T.pack filePath) <> " has been interpreted as an Archi-repository.")
-        case ctxFromArchi of
-          Checked ctx _ -> do
-            writeFileUtf8 "ArchiMetaModel.adl" (showP ctx)
-            logInfo "ArchiMetaModel.adl written"
-          Errors _ -> pure ()
-        return ((,[]) <$> ctxFromArchi) -- An Archimate file does not contain include files
+          ctxFromArchi <- archi2PContext filePath -- e.g. "CA repository.xml"
+          logInfo (display (T.pack filePath) <> " has been interpreted as an Archi-repository.")
+          case ctxFromArchi of
+            Checked ctx _ -> do
+              writeFileUtf8 "ArchiMetaModel.adl" (showP ctx)
+              logInfo "ArchiMetaModel.adl written"
+            Errors _ -> pure ()
+          return ((,[]) <$> ctxFromArchi) -- An Archimate file does not contain include files
       | otherwise = do
-        mFileContents <-
-          case pcFileKind pc of
-            Just fileKind ->
-              case getStaticFileContent fileKind filePath of
-                Just cont -> return (Right . stripBom . decodeUtf8 $ cont)
-                Nothing -> fatal ("Statically included " <> tshow fileKind <> " files. \n  Cannot find `" <> T.pack filePath <> "`.")
-            Nothing ->
-              Right <$> readFileUtf8 filePath
-        case mFileContents of
-          Left err -> return $ mkErrorReadingINCLUDE (pcOrigin pc) (map T.pack err)
-          Right fileContents ->
-            let -- TODO: This should be cleaned up. Probably better to do all the file reading
-                --       first, then parsing and typechecking of each module, building a tree P_Contexts
-                meat :: Guarded (P_Context, [Include])
-                meat = preProcess filePath (pcDefineds pc) (T.unpack fileContents) >>= parseCtx ns filePath . T.pack
-                proces :: Guarded (P_Context, [Include]) -> RIO env (Guarded (P_Context, [ParseCandidate]))
-                proces (Errors err) = pure (Errors err)
-                proces (Checked (ctxts, includes) ws) =
-                  addWarnings ws . foo <$> mapM include2ParseCandidate includes
-                  where
-                    foo :: [Guarded ParseCandidate] -> Guarded (P_Context, [ParseCandidate])
-                    foo xs = (ctxts,) <$> sequence xs
-             in proces meat
+          mFileContents <-
+            case pcFileKind pc of
+              Just fileKind ->
+                case getStaticFileContent fileKind filePath of
+                  Just cont -> return (Right . stripBom . decodeUtf8 $ cont)
+                  Nothing -> fatal ("Statically included " <> tshow fileKind <> " files. \n  Cannot find `" <> T.pack filePath <> "`.")
+              Nothing ->
+                Right <$> readFileUtf8 filePath
+          case mFileContents of
+            Left err -> return $ mkErrorReadingINCLUDE (pcOrigin pc) (map T.pack err)
+            Right fileContents ->
+              let -- TODO: This should be cleaned up. Probably better to do all the file reading
+                  --       first, then parsing and typechecking of each module, building a tree P_Contexts
+                  meat :: Guarded (P_Context, [Include])
+                  meat = preProcess filePath (pcDefineds pc) (T.unpack fileContents) >>= parseCtx ns filePath . T.pack
+                  proces :: Guarded (P_Context, [Include]) -> RIO env (Guarded (P_Context, [ParseCandidate]))
+                  proces (Errors err) = pure (Errors err)
+                  proces (Checked (ctxts, includes) ws) =
+                    addWarnings ws . foo <$> mapM include2ParseCandidate includes
+                    where
+                      foo :: [Guarded ParseCandidate] -> Guarded (P_Context, [ParseCandidate])
+                      foo xs = (ctxts,) <$> sequence xs
+               in proces meat
       where
         include2ParseCandidate :: Include -> RIO env (Guarded ParseCandidate)
         include2ParseCandidate (Include org str defs) = do
           let canonical = myNormalise (takeDirectory filePath </> str)
               defineds = processFlags (pcDefineds pc) (map T.unpack defs)
-          return $
-            Checked
+          return
+            $ Checked
               ParseCandidate
                 { pcBasePath = Just filePath,
                   pcOrigin = Just org,
@@ -296,15 +296,15 @@ parseSingleADL ns pc =
             f ds (x : xs)
               | is "." x = f ds xs -- reduce /a/b/./c to /a/b/c/
               | is ".." x = case reverse ds of
-                [] -> fatal ("Illegal filePath: " <> tshow fp)
-                _ : reverseInit -> f (reverse reverseInit) xs --reduce a/b/c/../d/ to a/b/d/
+                  [] -> fatal ("Illegal filePath: " <> tshow fp)
+                  _ : reverseInit -> f (reverse reverseInit) xs -- reduce a/b/c/../d/ to a/b/d/
               | otherwise = f (ds <> [x]) xs
         is :: FilePath -> FilePath -> Bool
         is str fp = case L.stripPrefix str fp of
           Just [chr] -> chr `elem` pathSeparators
           _ -> False
         stripBom :: Text -> Text
-        stripBom s = T.dropPrefix (T.pack ['\239', '\187', '\191']) s
+        stripBom = T.dropPrefix (T.pack ['\239', '\187', '\191'])
         extension = map toLower $ takeExtension filePath
         catchInvalidXlsx :: RIO env a -> RIO env a
         catchInvalidXlsx m = catch m f
@@ -316,7 +316,7 @@ parse :: AmpParser a -> FilePath -> [Token] -> Guarded a
 parse p fn ts =
   -- runP :: Parsec s u a -> u -> FilePath -> s -> Either ParseError a
   case runP p initialParserState fn ts of
-    --TODO: Add language support to the parser errors
+    -- TODO: Add language support to the parser errors
     Left err -> Errors $ pure $ PE err
     Right a -> pure a
 

From c2e8fdab9830fe852cb4613ee18c543652ab8e0b Mon Sep 17 00:00:00 2001
From: hanjoosten <han.joosten@ordina.nl>
Date: Sun, 14 Apr 2024 21:54:02 +0200
Subject: [PATCH 21/43] fix quotes from tableName

---
 src/Ampersand/Prototype/PHP.hs       | 44 ++++++++--------
 src/Ampersand/Prototype/TableSpec.hs | 77 +++++++++++++++-------------
 2 files changed, 65 insertions(+), 56 deletions(-)

diff --git a/src/Ampersand/Prototype/PHP.hs b/src/Ampersand/Prototype/PHP.hs
index 2ecda9d4e..9a643ccb6 100644
--- a/src/Ampersand/Prototype/PHP.hs
+++ b/src/Ampersand/Prototype/PHP.hs
@@ -94,7 +94,7 @@ executePHPStr phpStr = do
   writeFileUtf8 phpPath phpStr
   executePHP phpPath
 
-executePHP :: HasLogFunc env => FilePath -> RIO env Text
+executePHP :: (HasLogFunc env) => FilePath -> RIO env Text
 executePHP phpPath = do
   let cp =
         (shell command)
@@ -103,12 +103,12 @@ executePHP phpPath = do
       inputFile = phpPath
       outputFile = inputFile <> "Result"
       command = "php " <> show inputFile <> " > " <> show outputFile
-      errorHandler :: HasLogFunc env => IOException -> RIO env String
+      errorHandler :: (HasLogFunc env) => IOException -> RIO env String
       errorHandler err = do
         logError . display $ "Could not execute PHP: " <> tshow err
         fileContents <- readUTF8File phpPath
-        mapM_ (logError . display) $
-          case fileContents of
+        mapM_ (logError . display)
+          $ case fileContents of
             Left msg -> msg
             Right txt -> addLineNumbers . T.lines $ txt
         return "ERROR"
@@ -119,9 +119,10 @@ executePHP phpPath = do
       liftIO $ removeFile outputFile
       return content
     Left err ->
-      exitWith . PHPExecutionFailed $
-        "PHP execution failed:" :
-        fmap ("  " <>) err
+      exitWith
+        . PHPExecutionFailed
+        $ "PHP execution failed:"
+        : fmap ("  " <>) err
 
 addLineNumbers :: [Text] -> [Text]
 addLineNumbers = zipWith (curry withNumber) [0 ..]
@@ -193,18 +194,18 @@ createTempDatabase fSpec = do
     executePHPStr
       . showPHP
       $ phpStr
-  logInfo $
-    if T.null result
+  logInfo
+    $ if T.null result
       then "Temp database created succesfully."
       else
-        display $
-          T.intercalate "\n" $
-            [ "Temp database creation failed! :",
+        display
+          $ T.intercalate "\n"
+          $ [ "Temp database creation failed! :",
               "The result:",
               result,
               "The statements:"
             ]
-              <> addLineNumbers phpStr
+          <> addLineNumbers phpStr
 
   return (T.null result)
   where
@@ -267,19 +268,22 @@ createTempDatabase fSpec = do
       where
         dropDB :: SqlQuery
         dropDB =
-          SqlQuerySimple $
-            "DROP DATABASE IF EXISTS " <> singleQuote (tempDbName fSpec)
+          SqlQuerySimple
+            $ "DROP DATABASE IF EXISTS "
+            <> singleQuote (tempDbName fSpec)
         createDB :: SqlQuery
         createDB =
-          SqlQuerySimple $
-            "CREATE DATABASE " <> singleQuote (tempDbName fSpec) <> " DEFAULT CHARACTER SET UTF8MB4 COLLATE UTF8MB4_NOPAD_BIN"
+          SqlQuerySimple
+            $ "CREATE DATABASE "
+            <> singleQuote (tempDbName fSpec)
+            <> " DEFAULT CHARACTER SET UTF8MB4 COLLATE UTF8MB4_NOPAD_BIN"
         populatePlugPHP plug =
           case tableContents fSpec plug of
             [] -> []
             tblRecords ->
               ( "mysqli_query($DB_link, " <> queryAsPHP query <> ");"
-              ) :
-              ["if($err=mysqli_error($DB_link)) { $error=true; echo $err.'<br />'; }"]
+              )
+                : ["if($err=mysqli_error($DB_link)) { $error=true; echo $err.'<br />'; }"]
               where
-                query = insertQuery True (tshow . sqlname $ plug) attrNames tblRecords
+                query = insertQuery True (sqlname plug) attrNames tblRecords
                 attrNames = attSQLColName <$> plugAttributes plug
diff --git a/src/Ampersand/Prototype/TableSpec.hs b/src/Ampersand/Prototype/TableSpec.hs
index 43bf36e1b..7d91708b1 100644
--- a/src/Ampersand/Prototype/TableSpec.hs
+++ b/src/Ampersand/Prototype/TableSpec.hs
@@ -78,16 +78,16 @@ plug2TableSpec plug =
 createTableSql :: Bool -> TableSpec -> SqlQuery
 createTableSql withComment tSpec
   | withComment =
-    SqlQueryPretty $
-      ( commentBlockSQL . tsCmnt $ tSpec
-      )
+      SqlQueryPretty
+        $ ( commentBlockSQL . tsCmnt $ tSpec
+          )
         <> [header]
         <> wrap cols
         <> wrap (maybeToList mKey)
         <> wrap endings
   | otherwise =
-    SqlQueryPlain $
-      header
+      SqlQueryPlain
+        $ header
         <> " "
         <> T.intercalate " " cols
         <> " "
@@ -117,7 +117,8 @@ createTableSql withComment tSpec
     indnt = 5
     addColumn :: AttributeSpec -> Text
     addColumn att =
-      doubleQuote (fsname att) <> " "
+      doubleQuote (fsname att)
+        <> " "
         <> (showSQL . fstype) att
         <> (if fsIsPrimKey att then " UNIQUE" else "")
         <> (if fsDbNull att then " DEFAULT NULL" else " NOT NULL")
@@ -127,13 +128,15 @@ createTableSql withComment tSpec
 
 showColumsSql :: TableSpec -> SqlQuery
 showColumsSql tSpec =
-  SqlQuerySimple $
-    "SHOW COLUMNS FROM " <> (doubleQuote . tsName $ tSpec)
+  SqlQuerySimple
+    $ "SHOW COLUMNS FROM "
+    <> (doubleQuote . tsName $ tSpec)
 
 dropTableIfExistsSql :: TableSpec -> SqlQuery
 dropTableIfExistsSql tSpec =
-  SqlQuerySimple $
-    "DROP TABLE IF EXISTS " <> (doubleQuote . tsName $ tSpec)
+  SqlQuerySimple
+    $ "DROP TABLE IF EXISTS "
+    <> (doubleQuote . tsName $ tSpec)
 
 fld2AttributeSpec :: SqlAttribute -> AttributeSpec
 fld2AttributeSpec att =
@@ -145,31 +148,32 @@ fld2AttributeSpec att =
     }
 
 insertQuery ::
-  SomeValue val =>
+  (SomeValue val) =>
   Bool -> -- prettyprinted?
-  Text -> -- The name of the table
+  SqlName -> -- The name of the table
   NE.NonEmpty SqlName -> -- The names of the attributes
   [[Maybe val]] -> -- The rows to insert
   SqlQuery
 insertQuery withComments tableName attNames tblRecords
   | withComments =
-    SqlQueryPretty $
-      [ "INSERT INTO " <> doubleQuote tableName,
-        "   (" <> T.intercalate ", " (NE.toList $ fmap (doubleQuote . text1ToText . sqlColumNameToText1) attNames) <> ")",
-        "VALUES "
-      ]
+      SqlQueryPretty
+        $ [ "INSERT INTO " <> tshow tableName,
+            "   (" <> T.intercalate ", " (NE.toList $ fmap (doubleQuote . text1ToText . sqlColumNameToText1) attNames) <> ")",
+            "VALUES "
+          ]
         <> (T.lines . ("   " <>) . T.intercalate "\n , " $ ["(" <> valuechain md <> ")" | md <- tblRecords])
         <> [""]
   | otherwise =
-    SqlQueryPlain $
-      "INSERT INTO " <> doubleQuote tableName
+      SqlQueryPlain
+        $ "INSERT INTO "
+        <> tshow tableName
         <> " ("
         <> T.intercalate ", " (NE.toList $ fmap (doubleQuote . text1ToText . sqlColumNameToText1) attNames)
         <> ")"
         <> " VALUES "
         <> T.intercalate ", " ["(" <> valuechain md <> ")" | md <- tblRecords]
   where
-    valuechain :: SomeValue val => [Maybe val] -> Text
+    valuechain :: (SomeValue val) => [Maybe val] -> Text
     valuechain record = T.intercalate ", " [maybe "NULL" repr att | att <- record]
 
 class SomeValue a where
@@ -183,24 +187,25 @@ instance SomeValue Text where
 
 tableSpec2Queries :: Bool -> TableSpec -> [SqlQuery]
 tableSpec2Queries withComment tSpec =
-  createTableSql withComment tSpec :
-    [ SqlQuerySimple
-        ( "CREATE INDEX " <> doubleQuote (tsName tSpec <> "_" <> tshow i)
-            <> " ON "
-            <> doubleQuote (tsName tSpec)
-            <> " ("
-            <> doubleQuote (fsname fld)
-            <> ")"
-        )
-      | (i, fld) <-
-          zip [0 .. (maxIndexes - 1)]
-            . filter (suitableAsKey . fstype)
-            . filter (not . fsIsPrimKey)
-            $ tsflds tSpec
-    ]
+  createTableSql withComment tSpec
+    : [ SqlQuerySimple
+          ( "CREATE INDEX "
+              <> doubleQuote (tsName tSpec <> "_" <> tshow i)
+              <> " ON "
+              <> doubleQuote (tsName tSpec)
+              <> " ("
+              <> doubleQuote (fsname fld)
+              <> ")"
+          )
+        | (i, fld) <-
+            zip [0 .. (maxIndexes - 1)]
+              . filter (suitableAsKey . fstype)
+              . filter (not . fsIsPrimKey)
+              $ tsflds tSpec
+      ]
   where
     maxIndexes :: Int
-    maxIndexes = 62 --Limit the amount of indexes in edgecases causing mysql error 1069. (Issue #758)
+    maxIndexes = 62 -- Limit the amount of indexes in edgecases causing mysql error 1069. (Issue #758)
 
 additionalDatabaseSettings :: [SqlQuery]
 additionalDatabaseSettings = [SqlQuerySimple "SET TRANSACTION ISOLATION LEVEL SERIALIZABLE"]

From d584215be00129a510828ba24828d610d681180c Mon Sep 17 00:00:00 2001
From: hanjoosten <han.joosten@ordina.nl>
Date: Mon, 15 Apr 2024 07:48:50 +0200
Subject: [PATCH 22/43] Bugfix show

---
 src/Ampersand/FSpec/FSpec.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/Ampersand/FSpec/FSpec.hs b/src/Ampersand/FSpec/FSpec.hs
index 6abd5d2b5..d9233ec68 100644
--- a/src/Ampersand/FSpec/FSpec.hs
+++ b/src/Ampersand/FSpec/FSpec.hs
@@ -399,7 +399,7 @@ instance Eq SqlName where
   a == b = compare a b == EQ
 
 instance Show SqlName where
-  show (SqlName t) = show t
+  show (SqlName t) = T.unpack (text1ToText t)
 
 sqlColumNameToText1 :: SqlName -> Text1
 sqlColumNameToText1 (SqlName t) = t

From 140edcd84c0ce06f854b7c194ad454de91f0c00c Mon Sep 17 00:00:00 2001
From: hanjoosten <han.joosten@ordina.nl>
Date: Mon, 15 Apr 2024 08:14:05 +0200
Subject: [PATCH 23/43] wip

---
 src/Ampersand/Prototype/TableSpec.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/src/Ampersand/Prototype/TableSpec.hs b/src/Ampersand/Prototype/TableSpec.hs
index 7d91708b1..f23997bd2 100644
--- a/src/Ampersand/Prototype/TableSpec.hs
+++ b/src/Ampersand/Prototype/TableSpec.hs
@@ -158,7 +158,7 @@ insertQuery withComments tableName attNames tblRecords
   | withComments =
       SqlQueryPretty
         $ [ "INSERT INTO " <> tshow tableName,
-            "   (" <> T.intercalate ", " (NE.toList $ fmap (doubleQuote . text1ToText . sqlColumNameToText1) attNames) <> ")",
+            "   (" <> T.intercalate ", " (NE.toList $ fmap (text1ToText . sqlColumNameToText1) attNames) <> ")",
             "VALUES "
           ]
         <> (T.lines . ("   " <>) . T.intercalate "\n , " $ ["(" <> valuechain md <> ")" | md <- tblRecords])
@@ -168,7 +168,7 @@ insertQuery withComments tableName attNames tblRecords
         $ "INSERT INTO "
         <> tshow tableName
         <> " ("
-        <> T.intercalate ", " (NE.toList $ fmap (doubleQuote . text1ToText . sqlColumNameToText1) attNames)
+        <> T.intercalate ", " (NE.toList $ fmap (text1ToText . sqlColumNameToText1) attNames)
         <> ")"
         <> " VALUES "
         <> T.intercalate ", " ["(" <> valuechain md <> ")" | md <- tblRecords]

From 6f340342d0336b845b678d2c05575ba4f8a99dd2 Mon Sep 17 00:00:00 2001
From: hanjoosten <han.joosten@ordina.nl>
Date: Mon, 15 Apr 2024 09:35:18 +0200
Subject: [PATCH 24/43] wip

---
 src/Ampersand/Prototype/TableSpec.hs | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/src/Ampersand/Prototype/TableSpec.hs b/src/Ampersand/Prototype/TableSpec.hs
index f23997bd2..381730cfe 100644
--- a/src/Ampersand/Prototype/TableSpec.hs
+++ b/src/Ampersand/Prototype/TableSpec.hs
@@ -157,8 +157,8 @@ insertQuery ::
 insertQuery withComments tableName attNames tblRecords
   | withComments =
       SqlQueryPretty
-        $ [ "INSERT INTO " <> tshow tableName,
-            "   (" <> T.intercalate ", " (NE.toList $ fmap (text1ToText . sqlColumNameToText1) attNames) <> ")",
+        $ [ "INSERT INTO " <> doubleQuote (tshow tableName),
+            "   (" <> T.intercalate ", " (NE.toList $ fmap (doubleQuote . text1ToText . sqlColumNameToText1) attNames) <> ")",
             "VALUES "
           ]
         <> (T.lines . ("   " <>) . T.intercalate "\n , " $ ["(" <> valuechain md <> ")" | md <- tblRecords])
@@ -166,9 +166,9 @@ insertQuery withComments tableName attNames tblRecords
   | otherwise =
       SqlQueryPlain
         $ "INSERT INTO "
-        <> tshow tableName
+        <> doubleQuote (tshow tableName)
         <> " ("
-        <> T.intercalate ", " (NE.toList $ fmap (text1ToText . sqlColumNameToText1) attNames)
+        <> T.intercalate ", " (NE.toList $ fmap (doubleQuote . text1ToText . sqlColumNameToText1) attNames)
         <> ")"
         <> " VALUES "
         <> T.intercalate ", " ["(" <> valuechain md <> ")" | md <- tblRecords]

From a0698fa67439bf8799b6abade6a966308c283c4b Mon Sep 17 00:00:00 2001
From: hanjoosten <han.joosten@ordina.nl>
Date: Mon, 15 Apr 2024 12:30:04 +0200
Subject: [PATCH 25/43] Upgrade to ormolu-action@v4

---
 .github/workflows/ormolu-formatting-code.yml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/.github/workflows/ormolu-formatting-code.yml b/.github/workflows/ormolu-formatting-code.yml
index 02944b03a..4af083f2e 100644
--- a/.github/workflows/ormolu-formatting-code.yml
+++ b/.github/workflows/ormolu-formatting-code.yml
@@ -19,4 +19,4 @@ jobs:
       # The checkout step is needed since the enforcer relies on local git commands
       - uses: actions/checkout@v3
 
-      - uses: mrkkrp/ormolu-action@v2 # BEWARE: Do not upgrade unless we use ghc 9 or higher. v4 does not work for ghc less then 9.
+      - uses: mrkkrp/ormolu-action@v4 # BEWARE: Do not upgrade unless we use ghc 9 or higher. v4 does not work for ghc less then 9.

From dff4b99c1eb7d1dfd79155b201492cddec8c345b Mon Sep 17 00:00:00 2001
From: hanjoosten <han.joosten@ordina.nl>
Date: Mon, 15 Apr 2024 21:23:35 +0200
Subject: [PATCH 26/43] try hexpat flag (for windows build)

---
 stack.yaml | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/stack.yaml b/stack.yaml
index 6f16458da..f055f2f04 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -33,6 +33,8 @@ flags:
   #   unicode_collation: false
   #   test_citeproc: false
   #   debug: false
+  hexpat:
+    bundle: true
   mintty:
     Win32-2-13-1: false # see https://github.com/RyanGlScott/mintty/issues/4 for the reason to set this flag. TODO: This should probably be removed when upgrading to something higher than LTS-18.18
 

From 68d6dea4cfc12a39c8aca0cefa11c65dfad1c437 Mon Sep 17 00:00:00 2001
From: hanjoosten <han.joosten@ordina.nl>
Date: Fri, 19 Apr 2024 16:48:22 +0200
Subject: [PATCH 27/43] download expat library

---
 .github/workflows/ci2.yml | 15 ++++++---------
 1 file changed, 6 insertions(+), 9 deletions(-)

diff --git a/.github/workflows/ci2.yml b/.github/workflows/ci2.yml
index 1490b764d..afad592e8 100644
--- a/.github/workflows/ci2.yml
+++ b/.github/workflows/ci2.yml
@@ -75,15 +75,12 @@ jobs:
     steps:
       - name: Checkout project contents 📡
         uses: actions/checkout@v3
-      # - name: Use cache (manually) 📦 # See https://github.com/freckle/stack-cache-action/issues/5
-      #   uses: actions/cache@v3.3.2
-      #   # TODO: Cache might be done better, see for inspiration:  https://github.com/godu/advent-of-code-2020/blob/46796832f59d185457a8edf8de043a54a451d688/.github/workflows/ci.yml
-      #   with:
-      #     path: |
-      #       ~/.ghc
-      #       ~/.stack
-      #       ~/.stack-work
-      #     key: ${{ runner.os }}-stack
+      - uses: suisei-cn/actions-download-file@818d6b7dc8fe73f2f924b6241f2b1134ca1377d9 # 1.6.0
+        id: expatLibraryZip  # Remember to give an ID if you need the output filename
+        name: Download the expat library
+        with:
+          url: "https://github.com/libexpat/libexpat/releases/download/R_2_6_2/expat-win32bin-2.6.2.zip"
+          target: public/
       - name: Set up Mariadb 🧰
         uses: shogo82148/actions-setup-mysql@v1
         with:

From 671390dbaf560c3c7713e8208454b2610c1f7043 Mon Sep 17 00:00:00 2001
From: hanjoosten <han.joosten@ordina.nl>
Date: Fri, 19 Apr 2024 16:49:29 +0200
Subject: [PATCH 28/43] New version of ormolu. Layout changes

---
 .github/workflows/ormolu-formatting-code.yml  |   2 +-
 Setup.hs                                      |  20 +-
 src/Ampersand/ADL1/Lattices.hs                |  18 +-
 src/Ampersand/ADL1/Rule.hs                    |  15 +-
 src/Ampersand/Basics/Auxiliaries.hs           |  34 +-
 src/Ampersand/Basics/Languages.hs             |   2 +-
 src/Ampersand/Basics/Name.hs                  |   2 +-
 src/Ampersand/Basics/Unique.hs                |   4 +-
 src/Ampersand/Classes/ConceptStructure.hs     |   6 +-
 src/Ampersand/Classes/Relational.hs           |  21 +-
 src/Ampersand/Classes/ViewPoint.hs            |  16 +-
 src/Ampersand/Commands/Documentation.hs       |   8 +-
 src/Ampersand/Commands/Proof.hs               |   2 +-
 src/Ampersand/Commands/Proto.hs               |   2 +-
 src/Ampersand/Core/ShowPStruct.hs             |   2 +-
 src/Ampersand/Daemon/Daemon.hs                |  24 +-
 src/Ampersand/Daemon/Escape.hs                |   4 +-
 src/Ampersand/FSpec/Crud.hs                   |  37 +-
 src/Ampersand/FSpec/FPA.hs                    |   2 +-
 src/Ampersand/FSpec/FSpecAux.hs               |   2 +-
 src/Ampersand/FSpec/GenerateUML.hs            | 138 +++---
 src/Ampersand/FSpec/Instances.hs              |   7 +-
 src/Ampersand/FSpec/Motivations.hs            |   6 +-
 src/Ampersand/FSpec/SQL.hs                    |   2 +-
 src/Ampersand/FSpec/ToFSpec/ADL2FSpec.hs      | 118 ++---
 src/Ampersand/FSpec/ToFSpec/ADL2Plug.hs       |  72 +--
 src/Ampersand/FSpec/ToFSpec/Calc.hs           |   6 +-
 src/Ampersand/FSpec/ToFSpec/NormalForms.hs    | 401 +++++++++--------
 src/Ampersand/FSpec/ToFSpec/Populated.hs      |  19 +-
 src/Ampersand/FSpec/Transformers.hs           |  46 +-
 src/Ampersand/Graphic/ClassDiag2Dot.hs        |  19 +-
 src/Ampersand/Graphic/Fspec2ClassDiagrams.hs  |  35 +-
 src/Ampersand/Graphic/Graphics.hs             | 116 ++---
 src/Ampersand/Input/ADL1/CtxError.hs          | 410 ++++++++++--------
 src/Ampersand/Input/ADL1/LexerTexts.hs        |   2 +-
 src/Ampersand/Input/ADL1/LexerToken.hs        |   2 +-
 src/Ampersand/Input/ADL1/ParsingLib.hs        |  52 ++-
 src/Ampersand/Input/PreProcessor.hs           |  14 +-
 src/Ampersand/Misc/HasClasses.hs              |  24 +-
 src/Ampersand/Options/DocOptsParser.hs        |  57 +--
 src/Ampersand/Options/FSpecGenOptsParser.hs   |  11 +-
 src/Ampersand/Options/GlobalParser.hs         |  20 +-
 src/Ampersand/Options/LogLevelParser.hs       |   3 +-
 src/Ampersand/Options/PopulationOptsParser.hs |  13 +-
 src/Ampersand/Options/UmlOptsParser.hs        |   2 +-
 src/Ampersand/Output/FSpec2Pandoc.hs          |  86 ++--
 src/Ampersand/Output/FSpec2SQL.hs             |  30 +-
 src/Ampersand/Output/PandocAux.hs             | 178 ++++----
 src/Ampersand/Output/ToJSON/JSONutils.hs      |   2 +-
 src/Ampersand/Output/ToJSON/Rules.hs          |   2 +-
 src/Ampersand/Output/ToJSON/ToJson.hs         |   2 +-
 .../ToPandoc/ChapterConceptualAnalysis.hs     |  85 ++--
 .../Output/ToPandoc/ChapterDataAnalysis.hs    |  49 ++-
 .../Output/ToPandoc/ChapterDiagnosis.hs       | 222 +++++-----
 .../Output/ToPandoc/ChapterNatLangReqs.hs     |  46 +-
 src/Ampersand/Prototype/GenAngularFrontend.hs |  98 +++--
 .../Prototype/GenAngularJSFrontend.hs         |  98 +++--
 src/Ampersand/Prototype/GenFrontend.hs        |   4 +-
 src/Ampersand/Prototype/ProtoUtil.hs          |  68 +--
 src/Ampersand/Prototype/ValidateSQL.hs        |  10 +-
 src/Ampersand/Test/Parser/QuickChecks.hs      |   7 +-
 src/Ampersand/Test/Regression.hs              |  53 +--
 src/Ampersand/Types/Config.hs                 |  32 +-
 src/MainApps.hs                               |   5 +-
 src/Options/Applicative/Builder/Extra.hs      |  41 +-
 65 files changed, 1550 insertions(+), 1386 deletions(-)

diff --git a/.github/workflows/ormolu-formatting-code.yml b/.github/workflows/ormolu-formatting-code.yml
index 4af083f2e..ceaf35d67 100644
--- a/.github/workflows/ormolu-formatting-code.yml
+++ b/.github/workflows/ormolu-formatting-code.yml
@@ -19,4 +19,4 @@ jobs:
       # The checkout step is needed since the enforcer relies on local git commands
       - uses: actions/checkout@v3
 
-      - uses: mrkkrp/ormolu-action@v4 # BEWARE: Do not upgrade unless we use ghc 9 or higher. v4 does not work for ghc less then 9.
+      - uses: mrkkrp/ormolu-action@v4
diff --git a/Setup.hs b/Setup.hs
index da81527ef..f36357bcd 100644
--- a/Setup.hs
+++ b/Setup.hs
@@ -6,7 +6,7 @@
 -- Note that in order for this Setup.hs to be used by cabal, the build-type should be Custom.
 module Main where
 
---import qualified Codec.Compression.GZip as GZip  --TODO replace by Codec.Archive.Zip from package zip-archive. This reduces the amount of packages. (We now use two for zipping/unzipping)
+-- import qualified Codec.Compression.GZip as GZip  --TODO replace by Codec.Archive.Zip from package zip-archive. This reduces the amount of packages. (We now use two for zipping/unzipping)
 import Codec.Archive.Zip
 import Distribution.PackageDescription
 import Distribution.Pretty (prettyShow)
@@ -56,7 +56,8 @@ generateBuildInfoModule cabalVersionStr = do
   content <-
     buildInfoModule cabalVersionStr
       <$> getGitInfoStr
-      <*> ( T.pack . formatTime defaultTimeLocale "%d-%b-%y %H:%M:%S %Z"
+      <*> ( T.pack
+              . formatTime defaultTimeLocale "%d-%b-%y %H:%M:%S %Z"
               <$> (getCurrentTime >>= utcToLocalZonedTime)
           )
   writeFileUtf8 (pathFromModuleName buildInfoModuleName) content
@@ -190,8 +191,8 @@ generateStaticFileModule = do
         reader = readFileUtf8 sfModulePath
         errorHandler err = do
           -- old generated module exists, but we can't read the file or read the contents
-          putStrLn $
-            unlines
+          putStrLn
+            $ unlines
               [ "",
                 "Info: No cache for static files: " <> show (err :: SomeException),
                 ""
@@ -225,11 +226,12 @@ generateStaticFileModule = do
             stripbase fp = case L.stripPrefix (base ++ "/") fp of
               Just stripped -> stripped
               Nothing ->
-                error . L.intercalate "\n" $
-                  [ "ERROR: Reading static files failed:",
-                    "  base: " <> base,
-                    "  fp  : " <> fp
-                  ]
+                error
+                  . L.intercalate "\n"
+                  $ [ "ERROR: Reading static files failed:",
+                      "  base: " <> base,
+                      "  fp  : " <> fp
+                    ]
         base = case fkind of
           PandocTemplates -> "outputTemplates"
           FormalAmpersand -> "AmpersandData/FormalAmpersand"
diff --git a/src/Ampersand/ADL1/Lattices.hs b/src/Ampersand/ADL1/Lattices.hs
index 30fb69500..4a78e4864 100644
--- a/src/Ampersand/ADL1/Lattices.hs
+++ b/src/Ampersand/ADL1/Lattices.hs
@@ -216,16 +216,16 @@ reverseMap lst =
     buildMap :: (Ord a) => [(a, [Key])] -> IntMap (RevMap a)
     buildMap o = case o of
       [] -> IntMap.empty
-      ((_,[]) : _ ) -> fatal "This should be impossible, for the empties are taken out before."
-      ((_,f:_) : _ ) -> IntMap.insert f (reverseMap (map tail2 h)) (buildMap tl)
+      ((_, []) : _) -> fatal "This should be impossible, for the empties are taken out before."
+      ((_, f : _) : _) -> IntMap.insert f (reverseMap (map tail2 h)) (buildMap tl)
         where
-        tail2 :: (a, [IntMap.Key]) -> (a, [IntMap.Key])
-        tail2 (a, b) = (a, tail b)
-        (h, tl) = L.partition ((== f) . head . snd) o
-        tail [] = fatal "tail called on empty list"
-        tail (_ : t) = t
-        head [] = fatal "head used on empty list."
-        head (x : _) = x
+          tail2 :: (a, [IntMap.Key]) -> (a, [IntMap.Key])
+          tail2 (a, b) = (a, tail b)
+          (h, tl) = L.partition ((== f) . head . snd) o
+          tail [] = fatal "tail called on empty list"
+          tail (_ : t) = t
+          head [] = fatal "head used on empty list."
+          head (x : _) = x
 
 -- | Change the system into one with fast reverse lookups
 optimize1 :: (Ord a) => EqualitySystem a -> Op1EqualitySystem a
diff --git a/src/Ampersand/ADL1/Rule.hs b/src/Ampersand/ADL1/Rule.hs
index 5fa07413b..3abba5917 100644
--- a/src/Ampersand/ADL1/Rule.hs
+++ b/src/Ampersand/ADL1/Rule.hs
@@ -85,8 +85,10 @@ rulefromProp prp rel =
           Markup
             { amLang = lang,
               amPandoc =
-                string2Blocks ReST $
-                  showDcl <> " is " <> propFullName False lang prop
+                string2Blocks ReST
+                  $ showDcl
+                  <> " is "
+                  <> propFullName False lang prop
             }
 
     violMsg prop = [msg lang | lang <- [English, Dutch]]
@@ -97,8 +99,9 @@ rulefromProp prp rel =
           Markup
             { amLang = lang,
               amPandoc =
-                string2Blocks ReST . text1ToText $
-                  case lang of
+                string2Blocks ReST
+                  . text1ToText
+                  $ case lang of
                     English ->
                       case prop of
                         Sym -> explByFullName lang
@@ -138,8 +141,8 @@ propFullName isAdjective lang prop =
         Sur -> "surjective"
         Inj -> "injective"
         Tot -> "total"
-    Dutch -> (if isAdjective then snd else fst) $
-      case prop of
+    Dutch -> (if isAdjective then snd else fst)
+      $ case prop of
         Sym -> ("symmetrisch", "symmetrische")
         Asy -> ("antisymmetrisch", "antisymmetrische")
         Trn -> ("transitief", "transitieve")
diff --git a/src/Ampersand/Basics/Auxiliaries.hs b/src/Ampersand/Basics/Auxiliaries.hs
index fccc9bcbb..b007cdd34 100644
--- a/src/Ampersand/Basics/Auxiliaries.hs
+++ b/src/Ampersand/Basics/Auxiliaries.hs
@@ -26,7 +26,7 @@ import Data.Typeable
 import RIO.List (intersect, nub, union)
 import qualified RIO.List as L
 import qualified RIO.Map as Map
-import qualified RIO.Map.Partial as PARTIAL --TODO: Get rid of partial functions.
+import qualified RIO.Map.Partial as PARTIAL -- TODO: Get rid of partial functions.
 import qualified RIO.NonEmpty as NE
 import qualified RIO.NonEmpty.Partial as PARTIAL
 import qualified RIO.Set as Set
@@ -45,7 +45,7 @@ eqClass f (x : xs) = (x NE.:| [e | e <- xs, f x e]) : eqClass f [e | e <- xs, no
 --   For instance, if you want to have persons with the same name:
 --    'eqCl name persons' produces a list,in which each element is a list of persons with the same name.
 -- Example> eqCl (=='s') "Mississippi" = ["ssss","Miiippi"]
-eqCl :: Ord b => (a -> b) -> [a] -> [NE.NonEmpty a]
+eqCl :: (Ord b) => (a -> b) -> [a] -> [NE.NonEmpty a]
 eqCl _ [] = []
 eqCl f lst = Map.elems (Map.fromListWith (<>) [(f e, e NE.:| []) | e <- lst])
 
@@ -53,7 +53,7 @@ eqCl f lst = Map.elems (Map.fromListWith (<>) [(f e, e NE.:| []) | e <- lst])
 eqClassNE :: (a -> a -> Bool) -> NE.NonEmpty a -> NE.NonEmpty (NE.NonEmpty a)
 eqClassNE f = PARTIAL.fromList . eqClass f . NE.toList
 
-eqClNE :: Ord b => (a -> b) -> NE.NonEmpty a -> NE.NonEmpty (NE.NonEmpty a)
+eqClNE :: (Ord b) => (a -> b) -> NE.NonEmpty a -> NE.NonEmpty (NE.NonEmpty a)
 eqClNE f = PARTIAL.fromList . eqCl f . NE.toList
 
 -- | getCycles returns a list of cycles in the edges list (each edge is a pair of a from-vertex
@@ -71,34 +71,34 @@ getCycles edges' =
     keyFor v = fromMaybe fatalError $ L.elemIndex v allVertices
       where
         fatalError =
-          fatal $
-            T.intercalate "\n" $
-              [ "v (" <> tshow (typeOf v) <> ") = " <> tshow v,
+          fatal
+            $ T.intercalate "\n"
+            $ [ "v (" <> tshow (typeOf v) <> ") = " <> tshow v,
                 "length edges = " <> tshow (length edges),
                 "edges = "
               ]
-                <> map (("  " <>) . tshow) edges
-                <> [ "allVertices ="
-                   ]
-                <> map (("  " <>) . tshow) allVertices
-                <> [ "graphEdges ="
-                   ]
-                <> map (("  " <>) . tshow) graphEdges
+            <> map (("  " <>) . tshow) edges
+            <> [ "allVertices ="
+               ]
+            <> map (("  " <>) . tshow) allVertices
+            <> [ "graphEdges ="
+               ]
+            <> map (("  " <>) . tshow) graphEdges
 
 -- |  Warshall's transitive closure algorithm
-transClosureMap' :: Ord a => Map.Map a [a] -> Map.Map a [a]
+transClosureMap' :: (Ord a) => Map.Map a [a] -> Map.Map a [a]
 transClosureMap' xs =
   foldl' f xs (Map.keys xs `intersect` nub (concat (Map.elems xs)))
   where
-    f :: Ord a => Map.Map a [a] -> a -> Map.Map a [a] -- The type is given for documentation purposes only
+    f :: (Ord a) => Map.Map a [a] -> a -> Map.Map a [a] -- The type is given for documentation purposes only
     f q x = Map.unionWith union q (Map.fromListWith union (pleasefixthisname q x)) -- FIXME @Stefjoosten: what whould be a good name for this function?
 
 -- |  Warshall's transitive closure algorithm
-transClosureMap :: Ord a => Map.Map a (Set.Set a) -> Map.Map a (Set.Set a)
+transClosureMap :: (Ord a) => Map.Map a (Set.Set a) -> Map.Map a (Set.Set a)
 transClosureMap xs =
   foldl' f xs (Map.keysSet xs `Set.intersection` mconcat (Map.elems xs))
   where
-    f :: Ord a => Map.Map a (Set.Set a) -> a -> Map.Map a (Set.Set a)
+    f :: (Ord a) => Map.Map a (Set.Set a) -> a -> Map.Map a (Set.Set a)
     f q x = Map.unionWith Set.union q (Map.fromListWith Set.union (pleasefixthisname q x))
 
 pleasefixthisname :: (Foldable t, Ord k) => Map k (t k) -> k -> [(k, t k)]
diff --git a/src/Ampersand/Basics/Languages.hs b/src/Ampersand/Basics/Languages.hs
index ae7377d60..c2e6f970a 100644
--- a/src/Ampersand/Basics/Languages.hs
+++ b/src/Ampersand/Basics/Languages.hs
@@ -49,7 +49,7 @@ plural Dutch str =
           | "ij" `T.isSuffixOf` str = str <> "en"
           | "io" `T.isSuffixOf` str = str <> "'s"
           | klinker last = str <> "s"
-          | (T.take 2 . T.drop 1 . T.reverse) str `elem` ["aa", "oo", "ee", "uu"] = (T.reverse . T.drop 2 . T.reverse) str <> mede (T.drop (T.length str -1) str) <> "en"
+          | (T.take 2 . T.drop 1 . T.reverse) str `elem` ["aa", "oo", "ee", "uu"] = (T.reverse . T.drop 2 . T.reverse) str <> mede (T.drop (T.length str - 1) str) <> "en"
           | otherwise = str <> "en"
         last = case T.uncons . T.reverse $ tl of
           Nothing -> h
diff --git a/src/Ampersand/Basics/Name.hs b/src/Ampersand/Basics/Name.hs
index 6a9d4e044..67564af4d 100644
--- a/src/Ampersand/Basics/Name.hs
+++ b/src/Ampersand/Basics/Name.hs
@@ -268,4 +268,4 @@ prependList ls ne = case ls of
   (x : xs) -> x :| xs <> toList ne
 
 singleton :: a -> NonEmpty a
-singleton a = a :| []
\ No newline at end of file
+singleton a = a :| []
diff --git a/src/Ampersand/Basics/Unique.hs b/src/Ampersand/Basics/Unique.hs
index a2546d44d..781710307 100644
--- a/src/Ampersand/Basics/Unique.hs
+++ b/src/Ampersand/Basics/Unique.hs
@@ -98,11 +98,11 @@ newtype UniqueObj a = UniqueObj
   }
   deriving (Typeable)
 
-instance Unique a => Unique [a] where
+instance (Unique a) => Unique [a] where
   showUnique [] = toText1Unsafe "[]"
   showUnique xs = toText1Unsafe $ "[" <> T.intercalate ", " (text1ToText . showUnique <$> xs) <> "]"
 
-instance Unique a => Unique (Set.Set a) where
+instance (Unique a) => Unique (Set.Set a) where
   showUnique = showUnique . toList
 
 instance Unique Bool where
diff --git a/src/Ampersand/Classes/ConceptStructure.hs b/src/Ampersand/Classes/ConceptStructure.hs
index df05d33b5..6f3391740 100644
--- a/src/Ampersand/Classes/ConceptStructure.hs
+++ b/src/Ampersand/Classes/ConceptStructure.hs
@@ -52,15 +52,15 @@ instance (ConceptStructure a, ConceptStructure b) => ConceptStructure (a, b) whe
   concs (a, b) = concs a `Set.union` concs b
   expressionsIn (a, b) = expressionsIn a `Set.union` expressionsIn b
 
-instance ConceptStructure a => ConceptStructure (Maybe a) where
+instance (ConceptStructure a) => ConceptStructure (Maybe a) where
   concs = maybe Set.empty concs
   expressionsIn = maybe Set.empty expressionsIn
 
-instance ConceptStructure a => ConceptStructure [a] where
+instance (ConceptStructure a) => ConceptStructure [a] where
   concs = Set.unions . map concs
   expressionsIn = Set.unions . map expressionsIn
 
-instance ConceptStructure a => ConceptStructure (NE.NonEmpty a) where
+instance (ConceptStructure a) => ConceptStructure (NE.NonEmpty a) where
   concs = Set.unions . fmap concs
   expressionsIn = Set.unions . fmap expressionsIn
 
diff --git a/src/Ampersand/Classes/Relational.hs b/src/Ampersand/Classes/Relational.hs
index 415751661..c90d695ca 100644
--- a/src/Ampersand/Classes/Relational.hs
+++ b/src/Ampersand/Classes/Relational.hs
@@ -54,15 +54,16 @@ instance HasProps Expression where
     EDcI {} -> Set.fromList [Uni, Tot, Inj, Sur, Sym, Asy, Trn, Rfx]
     EEps a sgn -> Set.fromList $ [Tot | a == source sgn] ++ [Sur | a == target sgn] ++ [Uni, Inj]
     EDcV sgn ->
-      Set.fromList $
-        --NOT totaal
-        --NOT surjective
+      Set.fromList
+        $
+        -- NOT totaal
+        -- NOT surjective
         [Inj | isONE (source sgn)]
-          ++ [Uni | isONE (target sgn)]
-          ++ [Asy | isEndo sgn, isONE (source sgn)]
-          ++ [Sym | isEndo sgn]
-          ++ [Rfx | isEndo sgn]
-          ++ [Trn | isEndo sgn]
+        ++ [Uni | isONE (target sgn)]
+        ++ [Asy | isEndo sgn, isONE (source sgn)]
+        ++ [Sym | isEndo sgn]
+        ++ [Rfx | isEndo sgn]
+        ++ [Trn | isEndo sgn]
     EBrk f -> properties f
     ECps (l, r) -> Set.filter (\x -> x `elem` [Uni, Tot, Inj, Sur]) (properties l `Set.intersection` properties r)
     EPrd (l, r) -> Set.fromList $ [Tot | isTot l] ++ [Sur | isSur r] ++ [Rfx | isRfx l && isRfx r] ++ [Trn]
@@ -83,8 +84,8 @@ instance Relational Expression where -- TODO: see if we can find more property c
       EDif (l, r) -> isTrue l && isFalse r
       ECps (l, r)
         | isUni l && isTot l -> isTrue r
-        | isInj r && isSur r -> isTrue l --HJO, 20180331: Disabled this statement, for it has probably been bitrotted???
-        --SJO, 20220603: Restored this statement because this is the symmetric version of the former
+        | isInj r && isSur r -> isTrue l -- HJO, 20180331: Disabled this statement, for it has probably been bitrotted???
+        -- SJO, 20220603: Restored this statement because this is the symmetric version of the former
         | otherwise -> isTrue l && isTrue r
       EPrd (l, r) -> isTrue l && isTrue r -- SJ, 20220604: if you refine this, please consider issue #1293
       EKl0 e -> isTrue e
diff --git a/src/Ampersand/Classes/ViewPoint.hs b/src/Ampersand/Classes/ViewPoint.hs
index b460bc5e0..5b12e4672 100644
--- a/src/Ampersand/Classes/ViewPoint.hs
+++ b/src/Ampersand/Classes/ViewPoint.hs
@@ -31,8 +31,8 @@ class Language a where
     -- | all property rules that are maintained within this viewpoint.
     Rules
   proprules x =
-    Set.fromList $
-      [rulefromProp p d | d <- toList $ relsDefdIn x, p <- toList (properties d)]
+    Set.fromList
+      $ [rulefromProp p d | d <- toList $ relsDefdIn x, p <- toList (properties d)]
   identityRules :: a -> Rules -- all identity rules that are maintained within this viewpoint.
   identityRules x = Set.fromList . map ruleFromIdentity $ identities x
   enforceRules :: a -> Rules -- all enforcement rules that are maintained within this viewpoint.
@@ -65,9 +65,9 @@ class Language a where
 
 ruleFromIdentity :: IdentityRule -> Rule
 ruleFromIdentity identity =
-  mkKeyRule $
-    foldr (./\.) h t
-      .|-. EDcI (idCpt identity)
+  mkKeyRule
+    $ foldr (./\.) h t
+    .|-. EDcI (idCpt identity)
   where
     {-    diamond e1 e2 = (flp e1 .\. e2) ./\. (e1 ./. flp e2)  -}
     (h NE.:| t) =
@@ -95,8 +95,10 @@ ruleFromIdentity identity =
         }
       where
         toMeaning lang =
-          Meaning . Markup lang . string2Blocks ReST $
-            case lang of
+          Meaning
+            . Markup lang
+            . string2Blocks ReST
+            $ case lang of
               English -> "Identity rule, following from identity " <> fullName identity
               Dutch -> "Identiteitsregel, volgend uit identiteit " <> fullName identity
 
diff --git a/src/Ampersand/Commands/Documentation.hs b/src/Ampersand/Commands/Documentation.hs
index 1ac1806e2..c10b94b4a 100644
--- a/src/Ampersand/Commands/Documentation.hs
+++ b/src/Ampersand/Commands/Documentation.hs
@@ -26,8 +26,8 @@ doGenDocument fSpec = do
   -- First we need to output the pictures, because they should be present
   -- before the actual document is written
   genGraphics <- view genGraphicsL
-  when (genGraphics && fspecFormat /= FPandoc) $
-    mapM_ writePicture thePictures
+  when (genGraphics && fspecFormat /= FPandoc)
+    $ mapM_ writePicture thePictures
   genText <- view genTextL
-  when genText $
-    writepandoc fSpec thePandoc
+  when genText
+    $ writepandoc fSpec thePandoc
diff --git a/src/Ampersand/Commands/Proof.hs b/src/Ampersand/Commands/Proof.hs
index 3bd6609c8..59a4ad8a9 100644
--- a/src/Ampersand/Commands/Proof.hs
+++ b/src/Ampersand/Commands/Proof.hs
@@ -36,4 +36,4 @@ proof fSpec = do
     title = text $ "Proofs for " <> fullName fSpec
     theDoc = fDeriveProofs fSpec
 
---theDoc = plain (text "Aap")  -- use for testing...
+-- theDoc = plain (text "Aap")  -- use for testing...
diff --git a/src/Ampersand/Commands/Proto.hs b/src/Ampersand/Commands/Proto.hs
index 62a707ffa..00183d517 100644
--- a/src/Ampersand/Commands/Proto.hs
+++ b/src/Ampersand/Commands/Proto.hs
@@ -39,7 +39,7 @@ proto fSpec = do
     then do doGenBackend fSpec
     else do logDebug "  Skipping generating backend files"
   generateMetamodel <- view generateMetamodelL
-  if generateMetamodel --TODO @stefjoosten, Why should this be generated at the proto command??
+  if generateMetamodel -- TODO @stefjoosten, Why should this be generated at the proto command??
     then do doGenMetaModel fSpec
     else do logDebug "  Skipping generating metamodel.adl"
 
diff --git a/src/Ampersand/Core/ShowPStruct.hs b/src/Ampersand/Core/ShowPStruct.hs
index 6defcfb82..cd9cdcff0 100644
--- a/src/Ampersand/Core/ShowPStruct.hs
+++ b/src/Ampersand/Core/ShowPStruct.hs
@@ -3,5 +3,5 @@ module Ampersand.Core.ShowPStruct (Pretty, showP) where
 import Ampersand.ADL1.PrettyPrinters
 import Ampersand.Basics
 
-showP :: Pretty a => a -> Text
+showP :: (Pretty a) => a -> Text
 showP = prettyPrint . pretty
diff --git a/src/Ampersand/Daemon/Daemon.hs b/src/Ampersand/Daemon/Daemon.hs
index 4801664ce..b7c07816d 100644
--- a/src/Ampersand/Daemon/Daemon.hs
+++ b/src/Ampersand/Daemon/Daemon.hs
@@ -57,11 +57,12 @@ initialState = do
             map T.unpack
               . filter
                 ( \fn ->
-                    T.length fn > 0 --discard empty lines
+                    T.length fn
+                      > 0 -- discard empty lines
                       && not ("#" `T.isPrefixOf` fn) -- line commented out yaml style
                       && not ("--" `T.isPrefixOf` fn) -- line commented out haskellish style
                 )
-              . L.nub --discard doubles
+              . L.nub -- discard doubles
               . T.lines
               $ content
       (ls, loadedFiles) <- do
@@ -70,17 +71,18 @@ initialState = do
           ( L.nub . concatMap fst $ xs,
             L.nub . concatMap snd $ xs
           )
-      return $
-        Right
+      return
+        $ Right
           DaemonState
             { loads = ls,
               loadResults = L.nub $ dotAmpersand : loadedFiles
             }
     Left err ->
-      return . Left $
-        [ tshow err,
-          "File not found: " <> T.pack dotAmpersand,
-          "  Your workspace should contain a file called .ampersand. However,",
-          "  it could not be found. Please provide that file, containing the ",
-          "  name of the top file(s) of your Ampersand project. One name per line."
-        ]
+      return
+        . Left
+        $ [ tshow err,
+            "File not found: " <> T.pack dotAmpersand,
+            "  Your workspace should contain a file called .ampersand. However,",
+            "  it could not be found. Please provide that file, containing the ",
+            "  name of the top file(s) of your Ampersand project. One name per line."
+          ]
diff --git a/src/Ampersand/Daemon/Escape.hs b/src/Ampersand/Daemon/Escape.hs
index 2da163e29..f05f1354f 100644
--- a/src/Ampersand/Daemon/Escape.hs
+++ b/src/Ampersand/Daemon/Escape.hs
@@ -15,7 +15,7 @@ module Ampersand.Daemon.Escape
   )
 where
 
---import Data.Either.Extra(rights)
+-- import Data.Either.Extra(rights)
 
 import Ampersand.Basics
 import Data.List.Extra (unfoldr)
@@ -94,7 +94,7 @@ splitAtE i e = case unesc e of
   _ | i <= 0 -> (Esc "", e)
   Nothing -> (e, e)
   Just (Left code, rest) -> first (app code) $ splitAtE i rest
-  Just (Right c, rest) -> first (app $ Esc [c]) $ splitAtE (i -1) rest
+  Just (Right c, rest) -> first (app $ Esc [c]) $ splitAtE (i - 1) rest
 
 reverseE :: Esc -> Esc
 reverseE = implode . reverse . explode
diff --git a/src/Ampersand/FSpec/Crud.hs b/src/Ampersand/FSpec/Crud.hs
index 2a501fdc5..e218c15ce 100644
--- a/src/Ampersand/FSpec/Crud.hs
+++ b/src/Ampersand/FSpec/Crud.hs
@@ -37,9 +37,10 @@ mkCrudInfo allConceptsPrim decls allIfcs =
 
     transSurjClosureMap :: Map.Map A_Concept [A_Concept]
     transSurjClosureMap =
-      transClosureMap' . Map.fromListWith L.union $
-        (map (mkMapItem . flp) . filter isSur . map EDcD $ toList decls)
-          <> (map mkMapItem . filter isTot . map EDcD $ toList decls)
+      transClosureMap'
+        . Map.fromListWith L.union
+        $ (map (mkMapItem . flp) . filter isSur . map EDcD $ toList decls)
+        <> (map mkMapItem . filter isTot . map EDcD $ toList decls)
       where
         -- TODO: use transClosureMap instead of transClosureMap', it's faster, and this is transClosureMap's last occurrence
 
@@ -95,21 +96,21 @@ getAllInterfaceExprs allIfcs ifc = getExprs $ ifcObj ifc
   where
     getExprs :: ObjectDef -> [Expression]
     getExprs objExpr =
-      objExpression objExpr :
-      case objmsub objExpr of
-        Nothing -> []
-        Just si -> case si of
-          InterfaceRef {siIsLink = True} -> []
-          InterfaceRef {siIsLink = False} ->
-            case filter (\rIfc -> name rIfc == siIfcId si) allIfcs of -- Follow interface ref
-              [] -> fatal ("Referenced interface " <> referencedInterface <> " missing")
-              (_ : _ : _) -> fatal ("Multiple relations of referenced interface " <> referencedInterface)
-              [i] -> getAllInterfaceExprs allIfcs i
-          Box {} -> concatMap getExprs' (siObjs si)
-          where
-            referencedInterface = fullName . siIfcId $ si
-            getExprs' (BxExpr e) = getExprs e
-            getExprs' (BxTxt _) = []
+      objExpression objExpr
+        : case objmsub objExpr of
+          Nothing -> []
+          Just si -> case si of
+            InterfaceRef {siIsLink = True} -> []
+            InterfaceRef {siIsLink = False} ->
+              case filter (\rIfc -> name rIfc == siIfcId si) allIfcs of -- Follow interface ref
+                [] -> fatal ("Referenced interface " <> referencedInterface <> " missing")
+                (_ : _ : _) -> fatal ("Multiple relations of referenced interface " <> referencedInterface)
+                [i] -> getAllInterfaceExprs allIfcs i
+            Box {} -> concatMap getExprs' (siObjs si)
+            where
+              referencedInterface = fullName . siIfcId $ si
+              getExprs' (BxExpr e) = getExprs e
+              getExprs' (BxTxt _) = []
 
 getCrudObjsPerConcept ::
   [(Interface, [(A_Concept, Bool, Bool, Bool, Bool)])] ->
diff --git a/src/Ampersand/FSpec/FPA.hs b/src/Ampersand/FSpec/FPA.hs
index 5f9282e6b..06685f685 100644
--- a/src/Ampersand/FSpec/FPA.hs
+++ b/src/Ampersand/FSpec/FPA.hs
@@ -64,7 +64,7 @@ fpaDataModel fSpec = mapMaybe fpaPlugInfo $ plugInfos fSpec
 fpaPlugInfo :: PlugInfo -> Maybe FP
 fpaPlugInfo p@(InternalPlug TblSQL {attributes = atts})
   | Just cmplxty <- ilgvComplexity $ length atts =
-    Just $ FP ILGV (showUnique p) cmplxty
+      Just $ FP ILGV (showUnique p) cmplxty
   where
     ilgvComplexity :: Int -> Maybe Complexity
     ilgvComplexity n
diff --git a/src/Ampersand/FSpec/FSpecAux.hs b/src/Ampersand/FSpec/FSpecAux.hs
index 2b794df24..63453599a 100644
--- a/src/Ampersand/FSpec/FSpecAux.hs
+++ b/src/Ampersand/FSpec/FSpecAux.hs
@@ -24,5 +24,5 @@ getConceptTableInfo :: FSpec -> A_Concept -> (PlugSQL, SqlAttribute)
 getConceptTableInfo fSpec cpt =
   case lookupCpt fSpec cpt of
     [] -> fatal ("No plug found for concept '" <> fullName cpt <> "'.")
-    [x] -> x --Any of the resulting plugs should do.
+    [x] -> x -- Any of the resulting plugs should do.
     xs -> fatal ("Only one result expected:" <> tshow xs)
diff --git a/src/Ampersand/FSpec/GenerateUML.hs b/src/Ampersand/FSpec/GenerateUML.hs
index afbe90ec6..a24a65322 100644
--- a/src/Ampersand/FSpec/GenerateUML.hs
+++ b/src/Ampersand/FSpec/GenerateUML.hs
@@ -2,7 +2,7 @@ module Ampersand.FSpec.GenerateUML (generateUML) where
 
 import Ampersand.ADL1
 import Ampersand.Basics
---TODO: Replace by RIO state
+-- TODO: Replace by RIO state
 import Ampersand.Basics.BuildInfo_Generated (cabalVersionStr)
 import Ampersand.FSpec
 import Ampersand.Graphic.ClassDiagram
@@ -40,53 +40,53 @@ fSpec2UML env fSpec =
     diagramElements <- genDiagramElements
     customProfileElements <- genCustomProfileElements
     customReqElements <- genCustomReqElements env fSpec packageId2
-    return $ -- The following XMI-template has been borrowed from Enterprise Architect vs. 6.5
-      [ "<?xml version=\"1.0\" encoding=\"UTF-8\"?>",
-        "<!-- Generated by " <> longVersion appVersion <> " -->",
-        "<xmi:XMI xmi:version=\"2.1\" xmlns:uml=\"http://schema.omg.org/spec/UML/2.1\" xmlns:xmi=\"http://schema.omg.org/spec/XMI/2.1\" xmlns:thecustomprofile=\"http://www.sparxsystems.com/profiles/thecustomprofile/1.0\">",
-        -- WHY is the exporter not something like `Ampersand` (in the string below)?
-        -- BECAUSE then for some reason the importer doesn't show the properties of the requirements.
-        " <xmi:Documentation exporter=\"Ampersand\" exporterVersion=\"" <> cabalVersionStr <> "\"/>",
-        " <uml:Model xmi:type=\"uml:Model\" name=\"" <> fullName contextName <> "\" visibility=\"public\">",
-        "  <packagedElement xmi:type=\"uml:Package\" xmi:id=" <> tshow packageId0 <> " name=" <> fullName contextName <> " visibility=\"public\">"
-      ]
-        <> ["   <packagedElement xmi:type=\"uml:Package\" xmi:id=" <> tshow packageId1 <> " name=" <> fullName (prependToPlainName "classesOf_" contextName) <> " visibility=\"public\">"]
-        <> concat datatypesUML
-        <> concat classesUML
-        <> concat assocsUML
-        <> ["   </packagedElement>"]
-        <> ["   <packagedElement xmi:type=\"uml:Package\" xmi:id=" <> tshow packageId2 <> " name=" <> fullName (prependToPlainName "RequirementsOf_" contextName) <> " visibility=\"public\">"]
-        <> concat requirementsUML
-        <> ["   </packagedElement>"]
-        <> ["  </packagedElement>"]
-        <> customProfileElements
-        <> [ " </uml:Model>",
-             " <xmi:Extension extender=\"Enterprise Architect\" extenderID=\"6.5\">",
-             "  <elements>"
-           ]
-        <> ["    <element xmi:idref=" <> tshow packageId0 <> " xmi:type=\"uml:Package\" name=" <> fullName contextName <> " scope=\"public\">"]
-        <> ["    </element>"]
-        <> ["    <element xmi:idref=" <> tshow packageId1 <> " xmi:type=\"uml:Package\" name=" <> fullName (prependToPlainName "classesOf_" contextName) <> " scope=\"public\">"]
-        <> ["     <model package2=" <> tshow packageId1 <> " package=" <> tshow packageId0 <> " tpos=\"0\" ea_eleType=\"package\"/>"]
-        <> ["    </element>"]
-        <> ["    <element xmi:idref=" <> tshow packageId2 <> " xmi:type=\"uml:Package\" name=" <> fullName (prependToPlainName "RequirementsOf_" contextName) <> " scope=\"public\">"]
-        <> ["     <model package2=" <> tshow packageId2 <> " package=" <> tshow packageId0 <> " tpos=\"0\" ea_eleType=\"package\"/>"]
-        <> ["    </element>"]
-        <> customReqElements
-        <> [ "  </elements>",
-             "  <diagrams>",
-             "   <diagram xmi:id=\"" <> diagramId <> "\">",
-             "    <model package=\"" <> packageId1 <> "\" owner=\"" <> packageId1 <> "\"/>",
-             "    <properties name=\"Data Model\" type=\"Logical\"/>",
-             "    <elements>"
-           ]
-        <> diagramElements
-        <> [ "    </elements>",
-             "   </diagram>",
-             "  </diagrams>",
-             " </xmi:Extension>",
-             "</xmi:XMI>"
-           ]
+    return
+      $ [ "<?xml version=\"1.0\" encoding=\"UTF-8\"?>", -- The following XMI-template has been borrowed from Enterprise Architect vs. 6.5
+          "<!-- Generated by " <> longVersion appVersion <> " -->",
+          "<xmi:XMI xmi:version=\"2.1\" xmlns:uml=\"http://schema.omg.org/spec/UML/2.1\" xmlns:xmi=\"http://schema.omg.org/spec/XMI/2.1\" xmlns:thecustomprofile=\"http://www.sparxsystems.com/profiles/thecustomprofile/1.0\">",
+          -- WHY is the exporter not something like `Ampersand` (in the string below)?
+          -- BECAUSE then for some reason the importer doesn't show the properties of the requirements.
+          " <xmi:Documentation exporter=\"Ampersand\" exporterVersion=\"" <> cabalVersionStr <> "\"/>",
+          " <uml:Model xmi:type=\"uml:Model\" name=\"" <> fullName contextName <> "\" visibility=\"public\">",
+          "  <packagedElement xmi:type=\"uml:Package\" xmi:id=" <> tshow packageId0 <> " name=" <> fullName contextName <> " visibility=\"public\">"
+        ]
+      <> ["   <packagedElement xmi:type=\"uml:Package\" xmi:id=" <> tshow packageId1 <> " name=" <> fullName (prependToPlainName "classesOf_" contextName) <> " visibility=\"public\">"]
+      <> concat datatypesUML
+      <> concat classesUML
+      <> concat assocsUML
+      <> ["   </packagedElement>"]
+      <> ["   <packagedElement xmi:type=\"uml:Package\" xmi:id=" <> tshow packageId2 <> " name=" <> fullName (prependToPlainName "RequirementsOf_" contextName) <> " visibility=\"public\">"]
+      <> concat requirementsUML
+      <> ["   </packagedElement>"]
+      <> ["  </packagedElement>"]
+      <> customProfileElements
+      <> [ " </uml:Model>",
+           " <xmi:Extension extender=\"Enterprise Architect\" extenderID=\"6.5\">",
+           "  <elements>"
+         ]
+      <> ["    <element xmi:idref=" <> tshow packageId0 <> " xmi:type=\"uml:Package\" name=" <> fullName contextName <> " scope=\"public\">"]
+      <> ["    </element>"]
+      <> ["    <element xmi:idref=" <> tshow packageId1 <> " xmi:type=\"uml:Package\" name=" <> fullName (prependToPlainName "classesOf_" contextName) <> " scope=\"public\">"]
+      <> ["     <model package2=" <> tshow packageId1 <> " package=" <> tshow packageId0 <> " tpos=\"0\" ea_eleType=\"package\"/>"]
+      <> ["    </element>"]
+      <> ["    <element xmi:idref=" <> tshow packageId2 <> " xmi:type=\"uml:Package\" name=" <> fullName (prependToPlainName "RequirementsOf_" contextName) <> " scope=\"public\">"]
+      <> ["     <model package2=" <> tshow packageId2 <> " package=" <> tshow packageId0 <> " tpos=\"0\" ea_eleType=\"package\"/>"]
+      <> ["    </element>"]
+      <> customReqElements
+      <> [ "  </elements>",
+           "  <diagrams>",
+           "   <diagram xmi:id=\"" <> diagramId <> "\">",
+           "    <model package=\"" <> packageId1 <> "\" owner=\"" <> packageId1 <> "\"/>",
+           "    <properties name=\"Data Model\" type=\"Logical\"/>",
+           "    <elements>"
+         ]
+      <> diagramElements
+      <> [ "    </elements>",
+           "   </diagram>",
+           "  </diagrams>",
+           " </xmi:Extension>",
+           "</xmi:XMI>"
+         ]
   where
     classDiag = cdAnalysis False fSpec fSpec
     contextName = name classDiag
@@ -115,10 +115,10 @@ genUMLClass cl =
     classId <- refLabeledId . fullName $ clName cl
     addToDiagram classId
     attributesUML <- mapM genUMAttribute (clAtts cl)
-    return $
-      ["    <packagedElement xmi:type=\"uml:Class\" xmi:id=\"" <> classId <> "\" name=\"" <> fullName (clName cl) <> "\" visibility=\"public\">"]
-        <> concat attributesUML
-        <> ["    </packagedElement>"]
+    return
+      $ ["    <packagedElement xmi:type=\"uml:Class\" xmi:id=\"" <> classId <> "\" name=\"" <> fullName (clName cl) <> "\" visibility=\"public\">"]
+      <> concat attributesUML
+      <> ["    </packagedElement>"]
 
 genUMAttribute :: CdAttribute -> UML
 genUMAttribute (OOAttr nm attrType isOptional) =
@@ -128,7 +128,11 @@ genUMAttribute (OOAttr nm attrType isOptional) =
     uIntId <- mkUnlabeledId "Int"
     classId <- refLabeledId . fullName $ attrType
     return
-      [ "       <ownedAttribute xmi:type=\"uml:Property\" xmi:id=\"" <> attrId <> "\" name=\"" <> fullName nm <> "\" visibility=\"public\" isStatic=\"false\""
+      [ "       <ownedAttribute xmi:type=\"uml:Property\" xmi:id=\""
+          <> attrId
+          <> "\" name=\""
+          <> fullName nm
+          <> "\" visibility=\"public\" isStatic=\"false\""
           <> " isReadOnly=\"false\" isDerived=\"false\" isOrdered=\"false\" isUnique=\"true\" isDerivedUnion=\"false\">",
         "        <type xmi:idref=\"" <> classId <> "\"/>",
         "        <lowerValue xmi:type=\"uml:LiteralInteger\" xmi:id=\"" <> lIntId <> "\" value=\"" <> (if isOptional then "0" else "1") <> "\"/>",
@@ -142,13 +146,13 @@ genUMLAssociation ass =
     assocId <- mkUnlabeledId "Assoc"
     lMemberAndOwnedEnd <- genMemberAndOwnedEnd (asslhm ass) assocId (fullName $ assSrc ass)
     rMemberAndOwnedEnd <- genMemberAndOwnedEnd (assrhm ass) assocId (fullName $ assTgt ass)
-    return $
-      [ "    <packagedElement xmi:type=\"uml:Association\" xmi:id=\"" <> assocId <> "\" name=\"" <> maybe "" fullName (assrhr ass) <> "\" visibility=\"public\">"
-      ]
-        <> lMemberAndOwnedEnd
-        <> rMemberAndOwnedEnd
-        <> [ "    </packagedElement>"
-           ]
+    return
+      $ [ "    <packagedElement xmi:type=\"uml:Association\" xmi:id=\"" <> assocId <> "\" name=\"" <> maybe "" fullName (assrhr ass) <> "\" visibility=\"public\">"
+        ]
+      <> lMemberAndOwnedEnd
+      <> rMemberAndOwnedEnd
+      <> [ "    </packagedElement>"
+         ]
   where
     genMemberAndOwnedEnd (Mult minVal maxVal) assocId type' =
       do
@@ -158,7 +162,11 @@ genUMLAssociation ass =
         uIntId <- mkUnlabeledId "Int"
         return
           [ "     <memberEnd xmi:idref=\"" <> endId <> "\"/>",
-            "     <ownedEnd xmi:type=\"uml:Property\" xmi:id=\"" <> endId <> "\" visibility=\"public\" association=\"" <> assocId <> "\" isStatic=\"false\""
+            "     <ownedEnd xmi:type=\"uml:Property\" xmi:id=\""
+              <> endId
+              <> "\" visibility=\"public\" association=\""
+              <> assocId
+              <> "\" isStatic=\"false\""
               <> " isReadOnly=\"false\" isDerived=\"false\" isOrdered=\"false\" isUnique=\"true\" isDerivedUnion=\"false\" aggregation=\"none\">",
             "      <type xmi:idref=\"" <> typeId <> "\"/>",
             "      <lowerValue xmi:type=\"uml:LiteralInteger\" xmi:id=\"" <> lIntId <> "\" value=\"" <> (if minVal == MinZero then "0" else "1") <> "\"/>",
@@ -184,10 +192,10 @@ genCustomProfileElements =
     reqUML (xmiId, req) =
       T.intercalate
         "\n"
-        ( ("   <thecustomprofile:Functional base_Requirement=" <> tshow xmiId <> "/>") :
-            [ tagUML xmiId count' puprtxt reftxt
-              | (count', (puprtxt, reftxt)) <- zip [0 :: Int ..] [(aMarkup2String (explMarkup p), T.intercalate ";" (explRefIds p)) | p <- reqPurposes req]
-            ]
+        ( ("   <thecustomprofile:Functional base_Requirement=" <> tshow xmiId <> "/>")
+            : [ tagUML xmiId count' puprtxt reftxt
+                | (count', (puprtxt, reftxt)) <- zip [0 :: Int ..] [(aMarkup2String (explMarkup p), T.intercalate ";" (explRefIds p)) | p <- reqPurposes req]
+              ]
         )
     tagUML xmiId nr value reftxt =
       T.intercalate
diff --git a/src/Ampersand/FSpec/Instances.hs b/src/Ampersand/FSpec/Instances.hs
index 7cb0967b5..a374d6321 100644
--- a/src/Ampersand/FSpec/Instances.hs
+++ b/src/Ampersand/FSpec/Instances.hs
@@ -18,7 +18,7 @@ import qualified RIO.Set as Set
 --   These 'things' are instances (elements / atoms) of some
 --   Concept. They are the atoms of the concepts, as looked
 --   upon from the Formal Ampersand viewpoint.
-class Typeable a => Instances a where
+class (Typeable a) => Instances a where
   instances :: FSpec -> Set.Set a
   instanceList :: FSpec -> [a]
   instanceList = Set.toList . instances
@@ -51,7 +51,7 @@ instance Instances Rule where
 instance Instances Interface where
   instances = interfaceInstances
 
---instance Instances Meaning where
+-- instance Instances Meaning where
 --  instances = meaningInstances
 instance Instances Markup where
   instances fSpec =
@@ -60,7 +60,8 @@ instance Instances Markup where
 
 instance Instances ObjectDef where
   instances fSpec =
-    Set.fromList . concatMap (objects . ifcObj)
+    Set.fromList
+      . concatMap (objects . ifcObj)
       . interfaceInstances
       $ fSpec
     where
diff --git a/src/Ampersand/FSpec/Motivations.hs b/src/Ampersand/FSpec/Motivations.hs
index afcc0ac51..ea8bd7de1 100644
--- a/src/Ampersand/FSpec/Motivations.hs
+++ b/src/Ampersand/FSpec/Motivations.hs
@@ -1,4 +1,4 @@
---TODO -> Maybe this module is useful at more places than just func spec rendering.
+-- TODO -> Maybe this module is useful at more places than just func spec rendering.
 --        In that case it's not a Rendering module and it needs to be replaced
 
 module Ampersand.FSpec.Motivations
@@ -24,7 +24,7 @@ import qualified RIO.Set as Set
 -- The other functions in this class are solely meant to be used in the definition of purpose.
 -- They are defined once for each instance of Explainable, not be used in other code.
 
-class Named a => Motivated a where
+class (Named a) => Motivated a where
   isForObject ::
     a ->
     ExplObj ->
@@ -66,7 +66,7 @@ instance Motivated Interface where
   isForObject x (ExplInterface str) = name x == str
   isForObject _ _ = False
 
-class Named a => HasMeaning a where
+class (Named a) => HasMeaning a where
   meaning :: Lang -> a -> Maybe Meaning
   meaning l x =
     case filter (\(Meaning m) -> l == amLang m) (meanings x) of
diff --git a/src/Ampersand/FSpec/SQL.hs b/src/Ampersand/FSpec/SQL.hs
index 791e3dd93..7dbd53dff 100644
--- a/src/Ampersand/FSpec/SQL.hs
+++ b/src/Ampersand/FSpec/SQL.hs
@@ -1634,4 +1634,4 @@ uName :: Text -> Name -- Unquoted name
 uName = Name Nothing
 
 stringLit :: Text -> ScalarExpr
-stringLit = StringLit "'" "'"
\ No newline at end of file
+stringLit = StringLit "'" "'"
diff --git a/src/Ampersand/FSpec/ToFSpec/ADL2FSpec.hs b/src/Ampersand/FSpec/ToFSpec/ADL2FSpec.hs
index 23572d80c..73ee44ecf 100644
--- a/src/Ampersand/FSpec/ToFSpec/ADL2FSpec.hs
+++ b/src/Ampersand/FSpec/ToFSpec/ADL2FSpec.hs
@@ -39,8 +39,11 @@ makeFSpec env context =
       interfaceS = fSpecAllInterfaces, -- interfaces specified in the Ampersand script
       roleInterfaces = fSpecRoleInterfaces,
       interfaceG =
-        [ ifc | ifc <- interfaceGen, let ctxrel = objExpression (ifcObj ifc), isIdent ctxrel && source ctxrel == ONE
-                                                                                || ctxrel `notElem` map (objExpression . ifcObj) fSpecAllInterfaces, view genInterfacesL env -- generated interfaces
+        [ ifc | ifc <- interfaceGen, let ctxrel = objExpression (ifcObj ifc), isIdent ctxrel
+                                                                                && source ctxrel
+                                                                                == ONE
+                                                                                || ctxrel
+                                                                                `notElem` map (objExpression . ifcObj) fSpecAllInterfaces, view genInterfacesL env -- generated interfaces
         ],
       fDeriveProofs = deriveProofs env context,
       fRoleRuls =
@@ -84,7 +87,7 @@ makeFSpec env context =
       fSexpls = Set.fromList $ ctxps context <> concatMap ptxps (patterns context),
       metas = ctxmetas context,
       crudInfo = mkCrudInfo fSpecAllConcepts relsDefdInContext fSpecAllInterfaces,
-      atomsInCptIncludingSmaller = atomValuesOf contextinfo initialpopsDefinedInScript, --TODO: Write in a nicer way, like `atomsBySmallestConcept`
+      atomsInCptIncludingSmaller = atomValuesOf contextinfo initialpopsDefinedInScript, -- TODO: Write in a nicer way, like `atomsBySmallestConcept`
       atomsBySmallestConcept = \cpt ->
         Set.map apLeft
           . pairsinexpr
@@ -183,7 +186,7 @@ makeFSpec env context =
     ruleviolations r = case formalExpression r of
       EEqu {} -> (cra Set.\\ crc) `Set.union` (crc Set.\\ cra)
       EInc {} -> cra Set.\\ crc
-      _ -> pairsinexpr (EDcV (sign (consequent r))) Set.\\ crc --everything not in con
+      _ -> pairsinexpr (EDcV (sign (consequent r))) Set.\\ crc -- everything not in con
       where
         cra = pairsinexpr (antecedent r)
         crc = pairsinexpr (consequent r)
@@ -247,8 +250,8 @@ makeFSpec env context =
       case rrkind r of
         UserDefined -> rolesFromScript
         Propty prp dcl
-          | prp == Uni && isUni (EDcD dcl) -> [] --Enforced by the database
-          | prp == Inj && isInj (EDcD dcl) -> [] --Enforced by the database
+          | prp == Uni && isUni (EDcD dcl) -> [] -- Enforced by the database
+          | prp == Inj && isInj (EDcD dcl) -> [] -- Enforced by the database
           | otherwise -> rolesFromScript
         Identity _ -> []
         Enforce ->
@@ -282,7 +285,8 @@ makeFSpec env context =
     getAllViewsForConcept' concpt =
       concatMap viewsOfThisConcept
         . sortSpecific2Generic (gens context)
-        $ concpt : largerConcepts (gens context) concpt
+        $ concpt
+        : largerConcepts (gens context) concpt
 
     viewsOfThisConcept :: A_Concept -> [ViewDef]
     viewsOfThisConcept cpt = filter isForConcept $ viewDefs context
@@ -296,12 +300,13 @@ makeFSpec env context =
       case filter vdIsDefault
         . concatMap viewsOfThisConcept
         . sortSpecific2Generic (gens context)
-        $ cpt : largerConcepts (gens context) cpt of
+        $ cpt
+        : largerConcepts (gens context) cpt of
         [] -> Nothing
         (vd : _) -> Just vd
 
     --------------
-    --making plugs
+    -- making plugs
     --------------
     allplugs = genPlugs -- all generated plugs
     genPlugs = InternalPlug <$> makeGeneratedSqlPlugs env context
@@ -320,13 +325,13 @@ makeFSpec env context =
     --             $ name x
     --       }
 
-    --TODO151210 -> Plug A is overbodig, want A zit al in plug r
-    --CONTEXT Temp
-    --PATTERN Temp
-    --r::A*B[TOT].
-    --t::E*ECps[UNI].
-    --ENDPATTERN
-    --ENDCONTEXT
+    -- TODO151210 -> Plug A is overbodig, want A zit al in plug r
+    -- CONTEXT Temp
+    -- PATTERN Temp
+    -- r::A*B[TOT].
+    -- t::E*ECps[UNI].
+    -- ENDPATTERN
+    -- ENDCONTEXT
     {-
         **************************************
         * Plug E                               *
@@ -348,10 +353,10 @@ makeFSpec env context =
         **************************************
     -}
     -------------------
-    --END: making plugs
+    -- END: making plugs
     -------------------
     -------------------
-    --making interfaces
+    -- making interfaces
     -------------------
     -- interfaces (type BoxItem) can be generated from a basic ontology. That is: they can be derived from a set
     -- of relations together with property constraints. That is what interfaceG does.
@@ -369,17 +374,17 @@ makeFSpec env context =
     --  Step 1: select and arrange all relations to obtain a set cRels of total relations
     --          to ensure insertability of entities (signal relations are excluded)
     cRels =
-      toList $
-        Set.filter isTot toconsider
-          `Set.union` (Set.map flp . Set.filter (not . isTot) . Set.filter isSur $ toconsider)
+      toList
+        $ Set.filter isTot toconsider
+        `Set.union` (Set.map flp . Set.filter (not . isTot) . Set.filter isSur $ toconsider)
       where
         toconsider = Set.map EDcD relsDefdInContext
     --  Step 2: select and arrange all relations to obtain a set dRels of injective relations
     --          to ensure deletability of entities (signal relations are excluded)
     dRels =
-      toList $
-        Set.filter isInj toconsider
-          `Set.union` (Set.map flp . Set.filter (not . isInj) . Set.filter isUni $ toconsider)
+      toList
+        $ Set.filter isInj toconsider
+        `Set.union` (Set.map flp . Set.filter (not . isInj) . Set.filter isUni $ toconsider)
       where
         toconsider = Set.map EDcD relsDefdInContext
     --  Step 3: compute longest sequences of total expressions and longest sequences of injective expressions.
@@ -447,7 +452,7 @@ makeFSpec env context =
               [] -> Nothing
               h : tl ->
                 if isIdent (objExpression h) && null tl
-                  then Nothing --exclude concept A without cRels or dRels (i.e. A in Scalar without total associations to other plugs)
+                  then Nothing -- exclude concept A without cRels or dRels (i.e. A in Scalar without total associations to other plugs)
                   else
                     Just
                       ( source . NE.head . NE.head $ cl,
@@ -476,9 +481,9 @@ makeFSpec env context =
             | (c, objattributes) <- mapMaybe f $ eqCl (source . NE.head) plugPaths,
               let params = bindedRelationsIn . expressionsIn $ objattributes
           ]
-    --end otherwise: default theme
-    --end stap4a
-    step4b --generate lists of concept instances for those concepts that have a generated INTERFACE in step4a
+    -- end otherwise: default theme
+    -- end stap4a
+    step4b -- generate lists of concept instances for those concepts that have a generated INTERFACE in step4a
       =
       [ Ifc
           { ifcIsAPI = False,
@@ -510,12 +515,12 @@ makeFSpec env context =
                 mkName ConceptName
                   . NE.reverse
                   $ (toNamePart' . plural (ctxlang context) . plainNameOf $ c)
-                    NE.:| reverse (nameSpaceOf (name c))
+                  NE.:| reverse (nameSpaceOf (name c))
               nm' i =
                 mkName ConceptName
                   . NE.reverse
                   $ (toNamePart' . plural (ctxlang context) $ plainNameOf c <> tshow i)
-                    NE.:| reverse (nameSpaceOf (name c))
+                  NE.:| reverse (nameSpaceOf (name c))
               nm = case [nm' i | i <- [0 ..], nm' i `notElem` map name (ctxifcs context)] of
                 [] -> fatal "impossible"
                 h : _ -> h
@@ -532,7 +537,7 @@ makeFSpec env context =
       ]
 
 ----------------------
---END: making interfaces
+-- END: making interfaces
 ----------------------
 
 makeifcConjuncts :: Relations -> [Conjunct] -> [Conjunct]
@@ -557,22 +562,22 @@ tblcontents ci ps plug =
             ss -> fatal ("Exactly one relation sould be stored in BinSQL. However, there are " <> tshow (length ss))
        in [[(Just . apLeft) p, (Just . apRight) p] | p <- toList $ fullContents ci ps expr]
     TblSQL {} ->
-      --TODO15122010 -> remove the assumptions (see comment data PlugSQL)
-      --attributes are assumed to be in the order kernel+other,
-      --where NULL in a kernel attribute implies NULL in the following kernel attributes
-      --and the first attribute is unique and not null
-      --(r,s,t)<-mLkpTbl: s is assumed to be in the kernel, attExpr t is expected to hold r or (flp r), s and t are assumed to be different
+      -- TODO15122010 -> remove the assumptions (see comment data PlugSQL)
+      -- attributes are assumed to be in the order kernel+other,
+      -- where NULL in a kernel attribute implies NULL in the following kernel attributes
+      -- and the first attribute is unique and not null
+      -- (r,s,t)<-mLkpTbl: s is assumed to be in the kernel, attExpr t is expected to hold r or (flp r), s and t are assumed to be different
       case attributes plug of
         [] -> fatal "no attributes in plug."
         f : fs ->
           (L.nub . L.transpose)
-            ( map Just (toList cAtoms) :
-                [ case fExp of
-                    EDcI c -> [if a `elem` atomValuesOf ci ps c then Just a else Nothing | a <- toList cAtoms]
-                    _ -> [(lkp att a . fullContents ci ps) fExp | a <- toList cAtoms]
-                  | att <- fs,
-                    let fExp = attExpr att
-                ]
+            ( map Just (toList cAtoms)
+                : [ case fExp of
+                      EDcI c -> [if a `elem` atomValuesOf ci ps c then Just a else Nothing | a <- toList cAtoms]
+                      _ -> [(lkp att a . fullContents ci ps) fExp | a <- toList cAtoms]
+                    | att <- fs,
+                      let fExp = attExpr att
+                  ]
             )
           where
             cAtoms = (atomValuesOf ci ps . source . attExpr) f
@@ -582,19 +587,20 @@ tblcontents ci ps plug =
                 [] -> Nothing
                 [p] -> Just (apRight p)
                 ps' ->
-                  fatal . T.unlines $
-                    [ "There is an attempt to populate multiple values into ",
-                      "     the row of table `" <> text1ToText (showUnique plug) <> "`, where id = " <> tshow (showValADL a) <> ":",
-                      "     Values to be inserted in field `" <> (text1ToText . sqlColumNameToText1 . attSQLColName $ att) <> "` are: " <> tshow (map (showValADL . apRight) ps'),
-                      "",
-                      "ps: " <> T.intercalate ("\n  |" <> tshow (length ps) <> " ") (fmap tshow ps),
-                      "",
-                      "ps': " <> tshow ps'
-                    ] --this has happened before due to:
-                    --    when using --dev flag
-                    --  , when there are violations
-                    --  , when you have INCLUDE \"MinimalAST.xlsx\" in formalampersand.)
-                    --  , when a relation in formalAmpersand is declared UNI, but actually it isn't.
+                  fatal
+                    . T.unlines
+                    $ [ "There is an attempt to populate multiple values into ",
+                        "     the row of table `" <> text1ToText (showUnique plug) <> "`, where id = " <> tshow (showValADL a) <> ":",
+                        "     Values to be inserted in field `" <> (text1ToText . sqlColumNameToText1 . attSQLColName $ att) <> "` are: " <> tshow (map (showValADL . apRight) ps'),
+                        "",
+                        "ps: " <> T.intercalate ("\n  |" <> tshow (length ps) <> " ") (fmap tshow ps),
+                        "",
+                        "ps': " <> tshow ps'
+                      ] -- this has happened before due to:
+                      --    when using --dev flag
+                      --  , when there are violations
+                      --  , when you have INCLUDE \"MinimalAST.xlsx\" in formalampersand.)
+                      --  , when a relation in formalAmpersand is declared UNI, but actually it isn't.
 
 -- convenient function to give a Box header without keyvalues
 simpleBoxHeader :: Origin -> BoxHeader
diff --git a/src/Ampersand/FSpec/ToFSpec/ADL2Plug.hs b/src/Ampersand/FSpec/ToFSpec/ADL2Plug.hs
index fff23e051..b7a95f814 100644
--- a/src/Ampersand/FSpec/ToFSpec/ADL2Plug.hs
+++ b/src/Ampersand/FSpec/ToFSpec/ADL2Plug.hs
@@ -39,7 +39,7 @@ attributesOfConcept fSpec c =
       where
         expr = attExpr att
 
---was : null(Set.fromList [Uni,Inj,Sur]Set.\\properties (attExpr att)) && not (isPropty att)
+-- was : null(Set.fromList [Uni,Inj,Sur]Set.\\properties (attExpr att)) && not (isPropty att)
 
 makeGeneratedSqlPlugs ::
   (HasFSpecGenOpts env) =>
@@ -55,18 +55,20 @@ makeGeneratedSqlPlugs env context = inspectedCandidateTables
     inspectedCandidateTables
       | null candidateTables = []
       | otherwise = case filter (not . isSingleton) . eqCl sqlname $ candidateTables of
-        [] -> case filter hasNameConflict candidateTables of
-          [] -> candidateTables
-          xs ->
-            fatal . T.intercalate "\n   " $
-              [ "The following " <> tshow (length xs) <> " generated tables have a name conflict:"
-              ]
+          [] -> case filter hasNameConflict candidateTables of
+            [] -> candidateTables
+            xs ->
+              fatal
+                . T.intercalate "\n   "
+                $ [ "The following " <> tshow (length xs) <> " generated tables have a name conflict:"
+                  ]
                 <> concatMap showNameConflict (L.sortOn sqlname xs)
                 <> hint
-        xs ->
-          fatal . T.intercalate "\n   " $
-            [ "The following names are used for different tables:"
-            ]
+          xs ->
+            fatal
+              . T.intercalate "\n   "
+              $ [ "The following names are used for different tables:"
+                ]
               <> concatMap myShow xs
               <> hint
       where
@@ -91,9 +93,9 @@ makeGeneratedSqlPlugs env context = inspectedCandidateTables
           ("    " <>)
             <$> [ "Table: " <> tshow (sqlname plug)
                 ]
-              <> ( ("    " <>)
-                     <$> (L.sort . map (tshow . attSQLColName) . toList . plugAttributes $ plug)
-                 )
+            <> ( ("    " <>)
+                   <$> (L.sort . map (tshow . attSQLColName) . toList . plugAttributes $ plug)
+               )
         sameBy foo a b = foo a == foo b
         isSingleton :: NonEmpty a -> Bool
         isSingleton (_ NE.:| []) = True
@@ -168,14 +170,16 @@ makeGeneratedSqlPlugs env context = inspectedCandidateTables
         lookupC :: A_Concept -> SqlAttribute
         lookupC cpt = case [f | (c', f) <- conceptLookuptable, cpt == c'] of
           [] ->
-            fatal $
-              "Concept `" <> fullName cpt <> "` is not in the lookuptable."
-                <> "\nallConceptsInTable: "
-                <> tshow allConceptsInTable
-                <> "\nallRelationsInTable: "
-                <> tshow (map (\d -> fullName d <> tshow (sign d) <> " " <> tshow (properties d)) allRelationsInTable)
-                <> "\nlookupTable: "
-                <> tshow (map fst conceptLookuptable)
+            fatal
+              $ "Concept `"
+              <> fullName cpt
+              <> "` is not in the lookuptable."
+              <> "\nallConceptsInTable: "
+              <> tshow allConceptsInTable
+              <> "\nallRelationsInTable: "
+              <> tshow (map (\d -> fullName d <> tshow (sign d) <> " " <> tshow (properties d)) allRelationsInTable)
+              <> "\nlookupTable: "
+              <> tshow (map fst conceptLookuptable)
           x : _ -> x
         cptAttrib :: A_Concept -> SqlAttribute
         cptAttrib cpt =
@@ -184,8 +188,10 @@ makeGeneratedSqlPlugs env context = inspectedCandidateTables
               attExpr = expr,
               attType = repr cpt,
               attUse =
-                if cpt == tableKey
-                  && repr cpt == Object -- For scalars, we do not want a primary key. This is a workaround fix for issue #341
+                if cpt
+                  == tableKey
+                  && repr cpt
+                  == Object -- For scalars, we do not want a primary key. This is a workaround fix for issue #341
                   then PrimaryKey cpt
                   else PlainAttr,
               attNull = cpt /= tableKey, -- column for specializations can be NULL, but not the first column (tableKey)
@@ -218,7 +224,7 @@ makeGeneratedSqlPlugs env context = inspectedCandidateTables
             keyToTargetExpr = (attExpr . cptAttrib . source $ dclAttExpression) .:. dclAttExpression
 
     -----------------------------------------
-    --makeLinkTable
+    -- makeLinkTable
     -----------------------------------------
     -- makeLinkTable creates associations (BinSQL) between plugs that represent wide tables.
     -- Typical for BinSQL is that it has exactly two columns that are not unique and may not contain NULL values
@@ -234,10 +240,10 @@ makeGeneratedSqlPlugs env context = inspectedCandidateTables
     makeLinkTable dcl =
       BinSQL
         { sqlname = determineLinkTableName dcl,
-          cLkpTbl = [], --TODO: in case of TOT or SUR you might use a binary plug to lookup a concept (don't forget to nub)
-          --given that dcl cannot be (UNI or INJ) (because then dcl would be in a TblSQL plug)
-          --if dcl is TOT, then the concept (source dcl) is stored in this plug
-          --if dcl is SUR, then the concept (target dcl) is stored in this plug
+          cLkpTbl = [], -- TODO: in case of TOT or SUR you might use a binary plug to lookup a concept (don't forget to nub)
+          -- given that dcl cannot be (UNI or INJ) (because then dcl would be in a TblSQL plug)
+          -- if dcl is TOT, then the concept (source dcl) is stored in this plug
+          -- if dcl is SUR, then the concept (target dcl) is stored in this plug
           dLkpTbl = [theRelStore],
           mainItem = toConceptOrRelation dcl
         }
@@ -261,12 +267,12 @@ makeGeneratedSqlPlugs env context = inspectedCandidateTables
               rsSrcAtt = if isStoredFlipped dcl then trgAtt else srcAtt,
               rsTrgAtt = if isStoredFlipped dcl then srcAtt else trgAtt
             }
-        --the expr for the domain of r
+        -- the expr for the domain of r
         domExpr
           | isTot bindedExp = EDcI (source bindedExp)
           | isSur bindedExp = EDcI (target bindedExp)
           | otherwise = EDcI (source bindedExp) ./\. (bindedExp .:. flp bindedExp)
-        --the expr for the codomain of r
+        -- the expr for the codomain of r
         codExpr
           | not (isTot bindedExp) && isSur bindedExp = flp bindedExp
           | otherwise = bindedExp
@@ -377,7 +383,7 @@ hashText x = case x of
       <> fullName (source rel)
       <> fullName (target rel)
 
-class Named a => TableArtefact a where
+class (Named a) => TableArtefact a where
   toConceptOrRelation :: a -> ConceptOrRelation
 
 instance TableArtefact A_Concept where
@@ -398,5 +404,5 @@ determineSqlName scope conceptOrRelation =
         [clazz] -> (T.length . fullName $ conceptOrRelation) > maxLengthOfDatabaseTableName || length clazz > 1
         _ -> fatal "Concept must be found exactly in one list."
       where
-        equality :: Named a => a -> a -> Bool
+        equality :: (Named a) => a -> a -> Bool
         equality a b = (T.toLower . fullName) a == (T.toLower . fullName) b
diff --git a/src/Ampersand/FSpec/ToFSpec/Calc.hs b/src/Ampersand/FSpec/ToFSpec/Calc.hs
index b093a3386..9e5ebd639 100644
--- a/src/Ampersand/FSpec/ToFSpec/Calc.hs
+++ b/src/Ampersand/FSpec/ToFSpec/Calc.hs
@@ -47,7 +47,9 @@ deriveProofs env context =
     <> para ("Rules and their conjuncts for " <> (str . fullName) context)
     <> bulletList
       [ para
-          ( "rule r:   " <> (str . fullName) r <> linebreak
+          ( "rule r:   "
+              <> (str . fullName) r
+              <> linebreak
               <> "formalExpression r:  "
               <> str (showA (formalExpression r))
               <> linebreak
@@ -82,7 +84,7 @@ showProof shw ((expr, ss, equ) : prf) =
               else str equ <> str (" { " <> T.intercalate " and " ss <> " }")
       )
     <> showProof shw prf
---where e'= if null prf then "" else let (expr,_,_):_ = prf in showHS options "" expr
+-- where e'= if null prf then "" else let (expr,_,_):_ = prf in showHS options "" expr
 showProof _ [] = fromList []
 
 -- showPrf is meant to circumvent Pandoc. For example when a proof needs to be shown in debugging texts.
diff --git a/src/Ampersand/FSpec/ToFSpec/NormalForms.hs b/src/Ampersand/FSpec/ToFSpec/NormalForms.hs
index 2de308a28..80758dcef 100644
--- a/src/Ampersand/FSpec/ToFSpec/NormalForms.hs
+++ b/src/Ampersand/FSpec/ToFSpec/NormalForms.hs
@@ -187,7 +187,8 @@ dSteps drs x = dStps x
           let unif = Set.fromList [(name a', x)], -- find unifiers such that: substitute "" unif term==rCombinator a
           term' <- rewriteTerms, -- enumerate right hand side RTerms in order to construct:  substitute "" unif term'
           let rd = showIT term <> " -> " <> showIT term', -- rule documentation for fatals in 'substitute'
-          substitute rd unif term == x
+          substitute rd unif term
+            == x
             || fatal ("When analysing rule " <> rd <> " with unifier " <> showIT unif <> "\nsubstitute rd unif term:  " <> showIT (substitute rd unif term) <> "\ndiffers from:  " <> showIT x)
       ]
     dStps (RVee a b) =
@@ -201,7 +202,8 @@ dSteps drs x = dStps x
           noDoubles unif, -- if one variable is bound to more than one different terms, the deal is off.
           term' <- rewriteTerms, -- enumerate right hand side RTerms in order to construct:  substitute "" unif term'
           let rd = showIT term <> " -> " <> showIT term', -- rule documentation for fatals in 'substitute'
-          substitute rd unif term == x
+          substitute rd unif term
+            == x
             || fatal ("When analysing rule " <> rd <> " with unifier " <> showIT unif <> "\nsubstitute rd unif term:  " <> showIT (substitute rd unif term) <> "\ndiffers from:  " <> showIT x)
       ]
     dStps (RAtm a c) =
@@ -215,7 +217,8 @@ dSteps drs x = dStps x
           let unif = Set.fromList [(name c', RId c)], -- find unifiers such that: substitute "" unif term==rCombinator a
           term' <- rewriteTerms, -- enumerate right hand side RTerms in order to construct:  substitute "" unif term'
           let rd = showIT term <> " -> " <> showIT term', -- rule documentation for fatals in 'substitute'
-          substitute rd unif term == x
+          substitute rd unif term
+            == x
             || fatal ("When analysing rule " <> rd <> " with unifier " <> showIT unif <> "\nsubstitute rd unif term:  " <> showIT (substitute rd unif term) <> "\ndiffers from:  " <> showIT x)
       ]
     dStps RVar {} = fatal "Cannot rewrite a term with a variable in it." -- This should become a haskell type-error when RTerm is polymorphic
@@ -254,7 +257,8 @@ dSteps drs x = dStps x
               unif <- matches subTerm a, -- find unifiers such that: substitute "" unif term==rCombinator a
               term' <- rewriteTerms, -- enumerate right hand side RTerms in order to construct:  substitute "" unif term'
               let rd = showIT term <> " -> " <> showIT term', -- rule documentation for fatals in 'substitute'
-              substitute rd unif term == rCombinator a
+              substitute rd unif term
+                == rCombinator a
                 || fatal ("When analysing rule " <> rd <> " with unifier " <> showIT unif <> "\nsubstitute rd unif term:  " <> showIT (substitute rd unif term) <> "\ndiffers from\nrCombinator a:  " <> showIT (rCombinator a))
           ]
 
@@ -295,7 +299,8 @@ dSteps drs x = dStps x
               noDoubles unif, -- if one variable is bound to more than one different terms, the deal is off.
               term' <- rewriteTerms, -- enumerate right hand side RTerms in order to construct:  substitute "" unif term'
               let rd = showIT term <> " -> " <> showIT term', -- rule documentation for fatals in 'substitute'
-              substitute rd unif term == rCombinator a b
+              substitute rd unif term
+                == rCombinator a b
                 || fatal ("When analysing rule " <> rd <> " with unifier " <> showIT unif <> "\nsubstitute rd unif term:  " <> showIT (substitute rd unif term) <> "\ndiffers from\nrCombinator a b:  " <> showIT (rCombinator a b))
           ]
 
@@ -320,9 +325,15 @@ dSteps drs x = dStps x
               let rd = showIT term <> " -> " <> showIT term', -- rule documentation for fatals in 'substitute'
               let original = flatLst (pre ++ substitute rd unif term : post), -- is equal to rCombinator ls
               let result = flatLst (pre ++ substitute rd unif term' : post),
-              original == rCombinator ls
+              original
+                == rCombinator ls
                 || fatal
-                  ( "When analysing rule " <> rd <> " with unifier " <> showIT unif <> " on:  " <> showIT (rCombinator ls)
+                  ( "When analysing rule "
+                      <> rd
+                      <> " with unifier "
+                      <> showIT unif
+                      <> " on:  "
+                      <> showIT (rCombinator ls)
                       <> "\nWe substitute:  "
                       <> showIT (substitute rd unif term)
                       <> "\nby:             "
@@ -409,9 +420,15 @@ dSteps drs x = dStps x
                 if Set.null remainder
                   then substitute rd unif term'
                   else flatSet [substitute rd unif term', remTerm],
-          original == rCombinator s
+          original
+            == rCombinator s
             || fatal
-              ( "When analysing rule " <> rd <> " with unifier " <> showIT unif <> " on:  " <> showIT (rCombinator s)
+              ( "When analysing rule "
+                  <> rd
+                  <> " with unifier "
+                  <> showIT unif
+                  <> " on:  "
+                  <> showIT (rCombinator s)
                   <> "\nWe substitute:  "
                   <> showIT original
                   <> "\nby:             "
@@ -431,7 +448,7 @@ dSteps drs x = dStps x
                dstep <- dStps l
            ]
       where
-        partsplus :: Ord a => Int -> Set a -> [(Set (Set a), Set a)]
+        partsplus :: (Ord a) => Int -> Set a -> [(Set (Set a), Set a)]
         partsplus n ss = [(p, Set.empty) | p <- parts n ss] <> [(Set.delete p prt, p) | prt <- parts (n + 1) ss, p <- Set.toList prt]
         flatSet :: [RTerm] -> RTerm
         flatSet = normRT . rCombinator . Set.fromList . flat isrComb
@@ -620,7 +637,7 @@ rTerm2expr term =
           dechash = hash nm `hashWithSalt` sgn
         }
 
-class ShowIT a where --class meant for stuff not belonging to A-struct and/or P-struct
+class ShowIT a where -- class meant for stuff not belonging to A-struct and/or P-struct
   showIT :: a -> Text
 
 instance ShowIT RTerm where
@@ -848,42 +865,42 @@ matches term expr
   | not (isValid term) = fatal ("Invalid term " <> showIT term <> "\nbeing matched to term " <> showIT expr)
   | not (isValid expr) = fatal ("Matching term " <> showIT term <> "\nto invalid term " <> showIT expr)
   | otherwise =
-    case (term, expr) of
-      (RIsc es, RIsc es') -> matchSets RIsc es es'
-      (RUni es, RUni es') -> matchSets RUni es es'
-      (RDif l r, RDif l' r') -> matches l l' <> matches r r'
-      (RLrs l r, RLrs l' r') -> matches l l' <> matches r r'
-      (RRrs l r, RRrs l' r') -> matches l l' <> matches r r'
-      (RDia l r, RDia l' r') -> matches l l' <> matches r r'
-      (RCps ls, RCps ls') -> matchLists RCps ls ls'
-      (RRad ls, RRad ls') -> matchLists RRad ls ls'
-      (RPrd ls, RPrd ls') -> matchLists RPrd ls ls'
-      (RKl0 e, RKl0 e') -> matches e e'
-      (RKl1 e, RKl1 e') -> matches e e'
-      (RFlp e, RFlp e') -> matches e e'
-      (RCpl e, RCpl e') -> matches e e'
-      (RId c, RId _) -> [Set.fromList [(name c, expr)]]
-      (RVee s t, RVee s' t') -> [Set.fromList [(name s, RId s'), (name t, RId t')]]
-      (RVar v s t, _) -> [Set.fromList [(v, expr), (name s, RId (source expr)), (name t, RId (target expr))]]
-      (RAtm a c, RAtm a' c') -> [Set.singleton (name c, RId c') | a == a']
-      (RConst e, RConst e') -> [Set.empty | e == e']
-      (_, _) -> []
+      case (term, expr) of
+        (RIsc es, RIsc es') -> matchSets RIsc es es'
+        (RUni es, RUni es') -> matchSets RUni es es'
+        (RDif l r, RDif l' r') -> matches l l' <> matches r r'
+        (RLrs l r, RLrs l' r') -> matches l l' <> matches r r'
+        (RRrs l r, RRrs l' r') -> matches l l' <> matches r r'
+        (RDia l r, RDia l' r') -> matches l l' <> matches r r'
+        (RCps ls, RCps ls') -> matchLists RCps ls ls'
+        (RRad ls, RRad ls') -> matchLists RRad ls ls'
+        (RPrd ls, RPrd ls') -> matchLists RPrd ls ls'
+        (RKl0 e, RKl0 e') -> matches e e'
+        (RKl1 e, RKl1 e') -> matches e e'
+        (RFlp e, RFlp e') -> matches e e'
+        (RCpl e, RCpl e') -> matches e e'
+        (RId c, RId _) -> [Set.fromList [(name c, expr)]]
+        (RVee s t, RVee s' t') -> [Set.fromList [(name s, RId s'), (name t, RId t')]]
+        (RVar v s t, _) -> [Set.fromList [(v, expr), (name s, RId (source expr)), (name t, RId (target expr))]]
+        (RAtm a c, RAtm a' c') -> [Set.singleton (name c, RId c') | a == a']
+        (RConst e, RConst e') -> [Set.empty | e == e']
+        (_, _) -> []
 
 matchLists :: ([RTerm] -> RTerm) -> [RTerm] -> [RTerm] -> [Unifier]
 matchLists rCombinator es es'
   | not (isValid (combLst rCombinator es)) = fatal ("Invalid term " <> showIT (rCombinator es) <> "\nbeing matched to term " <> showIT (rCombinator es'))
   | not (isValid (combLst rCombinator es')) = fatal ("Matching term " <> showIT (rCombinator es) <> "\nto invalid term " <> showIT (rCombinator es'))
   | otherwise =
-    [ unif
-      | let n = length es, -- the length of the template, which contains variables
-        n /= 0 || fatal "n equals 0",
-        ms <- dist n es', -- determine segments from es' (which is variable free) that have the same length as the template es
-        not (or [null m | m <- ms])
-          || fatal (T.concat ["\nms:  [" <> T.intercalate ", " (map showIT m) <> "]" | m <- ms]),
-        let subTerms = map (combLst rCombinator) ms, -- make an RTerm from each sublist in ms
-        unif <- mix [matches l r | (l, r) <- safezip es subTerms],
-        noDoubles unif -- if one variable, v, is bound to more than one different terms, the deal is off.
-    ]
+      [ unif
+        | let n = length es, -- the length of the template, which contains variables
+          n /= 0 || fatal "n equals 0",
+          ms <- dist n es', -- determine segments from es' (which is variable free) that have the same length as the template es
+          not (or [null m | m <- ms])
+            || fatal (T.concat ["\nms:  [" <> T.intercalate ", " (map showIT m) <> "]" | m <- ms]),
+          let subTerms = map (combLst rCombinator) ms, -- make an RTerm from each sublist in ms
+          unif <- mix [matches l r | (l, r) <- safezip es subTerms],
+          noDoubles unif -- if one variable, v, is bound to more than one different terms, the deal is off.
+      ]
 
 mix :: [[Unifier]] -> [Unifier]
 mix (ls : lss) = [Set.union e str | e <- ls, str <- mix lss]
@@ -900,36 +917,36 @@ matchSets rCombinator es es'
   | or [not (isValid e) | e <- Set.toList es] = fatal ("Invalid subterm(s): " <> T.intercalate ", " [showIT e | e <- Set.toList es, not (isValid e)])
   | or [not (isValid e) | e <- Set.toList es'] = fatal ("Invalid subexpr(s): " <> T.intercalate ", " [showIT e | e <- Set.toList es', not (isValid e)])
   | otherwise =
-    [ unif
-      | let n = Set.size cdes, -- the length of the template, which contains variables
-        partition' <- parts n cdes', -- determine segments from the term with the same length. partition' :: Set (Set RTerm)
-        let subTerms = Set.map (combSet rCombinator) partition', -- make an RTerm from each subset in ms. subTerms :: Set RTerm
-        template <- L.permutations (Set.toList cdes),
-        unif <- mix [matches l r | (l, r) <- safezip template (Set.toList subTerms)],
-        noDoubles unif -- if one variable, v, is bound to more than one different terms, the deal is off.
-    ]
+      [ unif
+        | let n = Set.size cdes, -- the length of the template, which contains variables
+          partition' <- parts n cdes', -- determine segments from the term with the same length. partition' :: Set (Set RTerm)
+          let subTerms = Set.map (combSet rCombinator) partition', -- make an RTerm from each subset in ms. subTerms :: Set RTerm
+          template <- L.permutations (Set.toList cdes),
+          unif <- mix [matches l r | (l, r) <- safezip template (Set.toList subTerms)],
+          noDoubles unif -- if one variable, v, is bound to more than one different terms, the deal is off.
+      ]
   where
     isct = es `Set.intersection` es' -- E.g.:  {'Piet'}
     cdes = es `Set.difference` isct -- the terms of es that are not in es' (a set of templates). E.g.: { r;s }
     cdes' = es' `Set.difference` isct -- candidates for binding to a variable: { a\b , a;b;c , d , e;f }  (a set of terms)
 
-separate :: Ord a => Int -> Set a -> [(Set a, Set a)]
+separate :: (Ord a) => Int -> Set a -> [(Set a, Set a)]
 separate n s = [(part, s `Set.difference` part) | part <- subsetLength n (Set.toList s)]
   where
-    subsetLength :: Ord a => Int -> [a] -> [Set a]
+    subsetLength :: (Ord a) => Int -> [a] -> [Set a]
     subsetLength 0 _ = [Set.empty]
-    subsetLength i (x : xs) = map (Set.insert x) (subsetLength (i -1) xs) <> subsetLength i xs
+    subsetLength i (x : xs) = map (Set.insert x) (subsetLength (i - 1) xs) <> subsetLength i xs
     subsetLength _ [] = []
 
 -- parts produces a fixed number of subsets
-parts :: Ord a => Int -> Set a -> [Set (Set a)] -- ,   but within this where clause we must make it more specific.
+parts :: (Ord a) => Int -> Set a -> [Set (Set a)] -- ,   but within this where clause we must make it more specific.
 parts n = Set.toList . Set.fromList . map (Set.fromList . map Set.fromList) . p n . Set.toList
   where
-    p :: Eq a => Int -> [a] -> [[[a]]]
+    p :: (Eq a) => Int -> [a] -> [[[a]]]
     p 0 _ = []
     p 1 xs = [[xs]]
     p 2 xs = [[ss, rest] | ss <- init (subsets xs), let rest = [e | e <- xs, e `notElem` ss], not (null rest)]
-    p i xs = [twoSets <> tl | (hd : tl) <- p (i -1) xs, twoSets <- p 2 hd]
+    p i xs = [twoSets <> tl | (hd : tl) <- p (i - 1) xs, twoSets <- p 2 hd]
     {- examples:
        parts 1 "abcd" = {{"abcd"}}
        parts 2 "abcd" = {{"a","bcd"},{"ab","cd"},{"abc","d"},{"abd","c"},{"ac","bd"},{"acd","b"},{"ad","bc"}}
@@ -1290,15 +1307,15 @@ normStep
       nM _ (ELrs (ECps (x, y), z)) _ | not eq && y == z = (x, ["(x;y)/y |- x"], "==>")
       nM _ (ELrs (ECps (x, y), z)) _
         | not eq && flp x == z =
-          ( flp y,
-            [ case (x, y) of
-                (EFlp _, EFlp _) -> "(SJ) (x~;y~)/x |- y"
-                (_, EFlp _) -> "(SJ) (x;y~)/x~ |- y"
-                (EFlp _, _) -> "(SJ) (x~;y)/x |- y~"
-                (_, _) -> "(SJ) (x;y)/x~ |- y~"
-            ],
-            "==>"
-          )
+            ( flp y,
+              [ case (x, y) of
+                  (EFlp _, EFlp _) -> "(SJ) (x~;y~)/x |- y"
+                  (_, EFlp _) -> "(SJ) (x;y~)/x~ |- y"
+                  (EFlp _, _) -> "(SJ) (x~;y)/x |- y~"
+                  (_, _) -> "(SJ) (x;y)/x~ |- y~"
+              ],
+              "==>"
+            )
       nM _ (ELrs (ELrs (x, z), y)) _ = (ELrs (x, ECps (y, z)), ["Jipsen&Tsinakis: x/yz = (x/z)/y"], "<=>") -- note: sign (x/yz) == sign ((x/z)/y)
       nM posCpl (ELrs (l, r)) _ = (t ./. f, steps <> steps', fEqu [equ', equ''])
         where
@@ -1332,78 +1349,78 @@ normStep
       nM posCpl x@(EIsc (l, r)) rs
         -- Absorb equals:    r/\r  -->  r
         | or [length cl > 1 | cl <- NE.toList absorbClasses] =
-          ( foldr1 (./\.) (fmap NE.head absorbClasses),
-            [shw e <> " /\\ " <> shw e <> " = " <> shw e | cl <- NE.toList absorbClasses, length cl > 1, let e = NE.head cl],
-            "<=>"
-          )
+            ( foldr1 (./\.) (fmap NE.head absorbClasses),
+              [shw e <> " /\\ " <> shw e <> " = " <> shw e | cl <- NE.toList absorbClasses, length cl > 1, let e = NE.head cl],
+              "<=>"
+            )
         -- Absorb True:    r/\V  --> r
         | isTrue l = (r, ["V/\\x = x"], "<=>")
         | isTrue r = (l, ["x/\\V = x"], "<=>")
         -- Inconsistency:    r/\-r   -->  False
         | not (null incons) =
-          let i = head incons in (notCpl (EDcV (sign i)), [shw (notCpl i) <> " /\\ " <> shw i <> " = V-"], "<=>")
+            let i = head incons in (notCpl (EDcV (sign i)), [shw (notCpl i) <> " /\\ " <> shw i <> " = V-"], "<=>")
         -- Inconsistency:    x/\\V-  -->  False
         | isFalse l = (notCpl (EDcV (sign x)), ["-V/\\x = -V"], "<=>")
         | isFalse r = (notCpl (EDcV (sign x)), ["x/\\-V = -V"], "<=>")
         -- Absorb if r is antisymmetric:    r/\r~ --> I
         | t /= l || f /= r =
-          (t ./\. f, steps <> steps', fEqu [equ', equ''])
+            (t ./\. f, steps <> steps', fEqu [equ', equ''])
         | not eq && or [length cl > 1 | cl <- absorbAsy] =
-          ( foldr1
-              (./\.)
-              ( let absorbAsy1 = case absorbAsy of
-                      [] -> fatal "impossible" -- because of above or-clause
-                      h : tl -> h NE.:| tl
-                    fun cl =
-                      let e = NE.head cl
-                       in if length cl > 1 then EDcI (source e) else e
-                 in fmap fun absorbAsy1
-              ),
-            [shw e <> " /\\ " <> shw (flp e) <> " |- I, because" <> shw e <> " is antisymmetric" | cl <- absorbAsy, let e = NE.head cl],
-            "==>"
-          )
+            ( foldr1
+                (./\.)
+                ( let absorbAsy1 = case absorbAsy of
+                        [] -> fatal "impossible" -- because of above or-clause
+                        h : tl -> h NE.:| tl
+                      fun cl =
+                        let e = NE.head cl
+                         in if length cl > 1 then EDcI (source e) else e
+                   in fmap fun absorbAsy1
+                ),
+              [shw e <> " /\\ " <> shw (flp e) <> " |- I, because" <> shw e <> " is antisymmetric" | cl <- absorbAsy, let e = NE.head cl],
+              "==>"
+            )
         -- Absorb if r is antisymmetric and reflexive:    r/\r~ = I
         | or [length cl > 1 | cl <- absorbAsyRfx] =
-          ( foldr1
-              (./\.)
-              ( let absorbAsyRfx1 = case absorbAsyRfx of
-                      [] -> fatal "impossible" -- because of above or-clause
-                      h : tl -> h NE.:| tl
-                    fun cl =
-                      let e = NE.head cl
-                       in if length cl > 1 then EDcI (source e) else e
-                 in fmap fun absorbAsyRfx1
-              ),
-            [shw e <> " /\\ " <> shw (flp e) <> " = I, because" <> shw e <> " is antisymmetric and reflexive" | cl <- absorbAsyRfx, let e = NE.head cl],
-            "<=>"
-          )
+            ( foldr1
+                (./\.)
+                ( let absorbAsyRfx1 = case absorbAsyRfx of
+                        [] -> fatal "impossible" -- because of above or-clause
+                        h : tl -> h NE.:| tl
+                      fun cl =
+                        let e = NE.head cl
+                         in if length cl > 1 then EDcI (source e) else e
+                   in fmap fun absorbAsyRfx1
+                ),
+              [shw e <> " /\\ " <> shw (flp e) <> " = I, because" <> shw e <> " is antisymmetric and reflexive" | cl <- absorbAsyRfx, let e = NE.head cl],
+              "<=>"
+            )
         -- Absorb:    (x\\/y)/\\y  =  y
         | isEUni l && not (null absor0) =
-          let t' = head absor0 in (r, ["absorb " <> shw l <> " because of " <> shw t' <> ", using law  (x\\/y)/\\y = y"], "<=>")
+            let t' = head absor0 in (r, ["absorb " <> shw l <> " because of " <> shw t' <> ", using law  (x\\/y)/\\y = y"], "<=>")
         | isEUni r && not (null absor0') =
-          let t' = head absor0' in (r, ["absorb " <> shw r <> " because of " <> shw t' <> ", using law  (x\\/y)/\\x = x"], "<=>")
+            let t' = head absor0' in (r, ["absorb " <> shw r <> " because of " <> shw t' <> ", using law  (x\\/y)/\\x = x"], "<=>")
         -- Absorb:    (x\\/-y)/\\y  =  x/\\y
         | isEUni l && not (null absor1) =
-          ( case head absor1 of
-              (_, []) -> r
-              (_, t' : ts) -> foldr (.\/.) t' ts ./\. r,
-            ["absorb " <> shw t' <> ", using law (x\\/-y)/\\y  =  x/\\y" | (t', _) <- absor1],
-            "<=>"
-          )
+            ( case head absor1 of
+                (_, []) -> r
+                (_, t' : ts) -> foldr (.\/.) t' ts ./\. r,
+              ["absorb " <> shw t' <> ", using law (x\\/-y)/\\y  =  x/\\y" | (t', _) <- absor1],
+              "<=>"
+            )
         | isEUni r && not (null absor1') =
-          ( case head absor1' of
-              (_, []) -> l
-              (_, t' : ts) -> l ./\. foldr (.\/.) t' ts,
-            ["absorb " <> shw t' <> ", using law x/\\(y\\/-x)  =  x/\\y" | (t', _) <- absor1'],
-            "<=>"
-          )
+            ( case head absor1' of
+                (_, []) -> l
+                (_, t' : ts) -> l ./\. foldr (.\/.) t' ts,
+              ["absorb " <> shw t' <> ", using law x/\\(y\\/-x)  =  x/\\y" | (t', _) <- absor1'],
+              "<=>"
+            )
         -- Avoid complements: x/\\-y = x-y
         | (not . null) negList && (not . null) posList =
-          let posList' = head posList NE.:| tail posList
-           in ( foldl' (.-.) (foldr1 (./\.) posList') (map notCpl negList),
-                ["Avoid complements, using law x/\\-y = x-y"],
-                "<=>"
-              )
+            let posList' = head posList NE.:| tail posList
+             in ( foldl' (.-.) (foldr1 (./\.) posList') (map notCpl negList),
+                  ["Avoid complements, using law x/\\-y = x-y"],
+                  "<=>"
+                )
         | otherwise = (t ./\. f, steps <> steps', fEqu [equ', equ''])
         where
           (t, steps, equ') = nM posCpl l []
@@ -1479,13 +1496,13 @@ normStep
       nM posCpl x@(EUni (l, r)) rs
         -- Absorb equals:    r\/r  -->  r
         | t /= l || f /= r =
-          (t .\/. f, steps <> steps', fEqu [equ', equ''])
+            (t .\/. f, steps <> steps', fEqu [equ', equ''])
         | or [length cl > 1 | cl <- NE.toList absorbClasses] -- yields False if absorbClasses is empty
           =
-          ( foldr1 (.\/.) (fmap NE.head absorbClasses),
-            [shw e <> " \\/ " <> shw e <> " = " <> shw e | cl <- NE.toList absorbClasses, length cl > 1, let e = NE.head cl],
-            "<=>"
-          )
+            ( foldr1 (.\/.) (fmap NE.head absorbClasses),
+              [shw e <> " \\/ " <> shw e <> " = " <> shw e | cl <- NE.toList absorbClasses, length cl > 1, let e = NE.head cl],
+              "<=>"
+            )
         -- Tautologies:
         | (not . null) tauts = (EDcV (sign x), ["let e = " <> shw (head tauts) <> ". Since -e\\/e = V we get"], "<=>") -- r\/-r  -->  V
         | isTrue l = (EDcV (sign x), ["V\\/x = V"], "<=>") -- r\/V   -->  V
@@ -1498,19 +1515,19 @@ normStep
         | isEIsc r && not (null absor0') = let t' = head absor0' in (r, ["absorb " <> shw r <> " because of " <> shw t' <> ", using law  (x/\\y)\\/x = x"], "<=>")
         -- Absorb:    (x/\\-y)\\/y  =  x\\/y
         | isEIsc l && not (null absor1) =
-          ( case head absor1 of
-              (_, []) -> r
-              (_, t' : ts) -> foldr (./\.) t' ts .\/. r,
-            ["absorb " <> shw t' <> ", using law (x/\\-y)\\/y  =  x\\/y" | (t', _) <- absor1],
-            "<=>"
-          )
+            ( case head absor1 of
+                (_, []) -> r
+                (_, t' : ts) -> foldr (./\.) t' ts .\/. r,
+              ["absorb " <> shw t' <> ", using law (x/\\-y)\\/y  =  x\\/y" | (t', _) <- absor1],
+              "<=>"
+            )
         | isEIsc r && not (null absor1') =
-          ( case head absor1' of
-              (_, []) -> l
-              (_, t' : ts) -> l .\/. foldr (./\.) t' ts,
-            ["absorb " <> shw t' <> ", using law x\\/(y/\\-x)  =  x\\/y" | (t', _) <- absor1'],
-            "<=>"
-          )
+            ( case head absor1' of
+                (_, []) -> l
+                (_, t' : ts) -> l .\/. foldr (./\.) t' ts,
+              ["absorb " <> shw t' <> ", using law x\\/(y/\\-x)  =  x\\/y" | (t', _) <- absor1'],
+              "<=>"
+            )
         | otherwise = (t .\/. f, steps <> steps', fEqu [equ', equ''])
         where
           (t, steps, equ') = nM posCpl l []
@@ -1667,34 +1684,34 @@ allShifts env conjunct = map NE.head . eqClass (==) . filter pnEq . map normDNF
         move :: [Expression] -> [Expression] -> [([Expression], [Expression])]
         move ass [] = [(ass, [])]
         move ass css =
-          (ass, css) :
-          if and [(not . isEDcI) cs | cs <- css] -- all cs are nonempty because: (not.and.map isEDcI) cs ==> not (null cs)
-            then
-              [ ts | let headEs = map headECps css, length (eqClass (==) headEs) == 1, let h -- example: True, because map head css == [ "x" ]
-                                                                                             =
-                                                                                             head headEs, isUni h, ts <- -- example: h= "x"
-                                                                                             -- example: assume True
-                                                                                                                     move
-                                                                                                                       [ if source h == source as then flp h .:. as else fatal "type mismatch"
-                                                                                                                         | as <- ass
-                                                                                                                       ]
-                                                                                                                       (map tailECps css)
-              ]
-                <> [ ts
-                     | let lastEs -- example: ts<-move [ [flp "x","r","s"], [flp "x","p","r"] ]  [ ["y","z"] ]
-                             =
-                             map lastECps css,
-                       length (eqClass (==) lastEs) == 1,
-                       let l = head lastEs,
-                       isInj l,
-                       ts <-
-                         move
-                           [ if target as == target l then as .:. flp l else fatal "type mismatch"
-                             | as <- ass
-                           ]
-                           (map initECps css) -- example: ts<-move [ ["r","s",flp "z"], ["p","r",flp "z"] ]  [ ["x","y"] ]
-                   ]
-            else []
+          (ass, css)
+            : if and [(not . isEDcI) cs | cs <- css] -- all cs are nonempty because: (not.and.map isEDcI) cs ==> not (null cs)
+              then
+                [ ts | let headEs = map headECps css, length (eqClass (==) headEs) == 1, let h -- example: True, because map head css == [ "x" ]
+                                                                                               =
+                                                                                               head headEs, isUni h, ts <- -- example: h= "x"
+                                                                                               -- example: assume True
+                                                                                                                       move
+                                                                                                                         [ if source h == source as then flp h .:. as else fatal "type mismatch"
+                                                                                                                           | as <- ass
+                                                                                                                         ]
+                                                                                                                         (map tailECps css)
+                ]
+                  <> [ ts
+                       | let lastEs -- example: ts<-move [ [flp "x","r","s"], [flp "x","p","r"] ]  [ ["y","z"] ]
+                               =
+                               map lastECps css,
+                         length (eqClass (==) lastEs) == 1,
+                         let l = head lastEs,
+                         isInj l,
+                         ts <-
+                           move
+                             [ if target as == target l then as .:. flp l else fatal "type mismatch"
+                               | as <- ass
+                             ]
+                             (map initECps css) -- example: ts<-move [ ["r","s",flp "z"], ["p","r",flp "z"] ]  [ ["x","y"] ]
+                     ]
+              else []
     -- Here is (informally) what the example does:
     -- move [ r;s , p;r ] [ x;y ]
     -- ( [ r;s , p;r ] , [ x;y ] ): [ ts | ts<-move [flp x.:.as | as<-[ r;s , p;r ] [ y ] ] ]
@@ -1729,36 +1746,36 @@ allShifts env conjunct = map NE.head . eqClass (==) . filter pnEq . map normDNF
           case ass of
             [] -> [] -- was [([EDcI (target (last css))],css)]
             _ ->
-              (ass, css) :
-              if and [(not . isEDcI) as | as <- ass]
-                then
-                  [ ts | let headEs = map headECps ass, length (eqClass (==) headEs) == 1, let h -- example: True, because map headECps ass == [ "r", "r" ]
-                                                                                                 =
-                                                                                                 head headEs, isSur h, ts <- -- example: h= "r"
-                                                                                                 -- example: assume True
-                                                                                                                         move
-                                                                                                                           (map tailECps ass)
-                                                                                                                           [ if source h == source cs then flp h .:. cs else fatal "type mismatch"
-                                                                                                                             | cs <- css
-                                                                                                                           ]
-                  ]
-                    <> [ ts
-                         | let lastEs -- example: ts<-move  [["s"], ["r"]] [ [flp "r","x","y","z"] ]
-                                 =
-                                 map lastECps ass,
-                           length (eqClass (==) lastEs) == 1,
-                           let l -- example: False, because map lastECps ass == [ ["s"], ["r"] ]
-                                 =
-                                 head lastEs,
-                           isTot l,
-                           ts <-
-                             move
-                               (map initECps ass)
-                               [ if target cs == target l then cs .:. flp l else fatal "type mismatch"
-                                 | cs <- css -- is dit goed? cs.:.flp l wordt links zwaar, terwijl de normalisator rechts zwaar maakt.
-                               ]
-                       ]
-                else []
+              (ass, css)
+                : if and [(not . isEDcI) as | as <- ass]
+                  then
+                    [ ts | let headEs = map headECps ass, length (eqClass (==) headEs) == 1, let h -- example: True, because map headECps ass == [ "r", "r" ]
+                                                                                                   =
+                                                                                                   head headEs, isSur h, ts <- -- example: h= "r"
+                                                                                                   -- example: assume True
+                                                                                                                           move
+                                                                                                                             (map tailECps ass)
+                                                                                                                             [ if source h == source cs then flp h .:. cs else fatal "type mismatch"
+                                                                                                                               | cs <- css
+                                                                                                                             ]
+                    ]
+                      <> [ ts
+                           | let lastEs -- example: ts<-move  [["s"], ["r"]] [ [flp "r","x","y","z"] ]
+                                   =
+                                   map lastECps ass,
+                             length (eqClass (==) lastEs) == 1,
+                             let l -- example: False, because map lastECps ass == [ ["s"], ["r"] ]
+                                   =
+                                   head lastEs,
+                             isTot l,
+                             ts <-
+                               move
+                                 (map initECps ass)
+                                 [ if target cs == target l then cs .:. flp l else fatal "type mismatch"
+                                   | cs <- css -- is dit goed? cs.:.flp l wordt links zwaar, terwijl de normalisator rechts zwaar maakt.
+                                 ]
+                         ]
+                  else []
     -- Here is (informally) what the example does:
     -- move [ r;s , r;r ] [ x;y ]
     -- ( [ r;s , r;r ] , [ x;y ] ): move [ s , r ] [ r~;x;y ]
@@ -1863,8 +1880,8 @@ init = fromMaybe (fatal "Illegal use of init") . L.initMaybe
 --   will result in the original list.
 dist :: Int -> [a] -> [[[a]]]
 dist 1 ls = [[ls]]
-dist 2 ls = [[take i ls, drop i ls] | i <- [1 .. length ls -1]]
-dist n ls = [init ds <> st | ds <- dist (n -1) ls, let staart = last ds, length staart >= 2, st <- dist 2 staart]
+dist 2 ls = [[take i ls, drop i ls] | i <- [1 .. length ls - 1]]
+dist n ls = [init ds <> st | ds <- dist (n - 1) ls, let staart = last ds, length staart >= 2, st <- dist 2 staart]
 
 {- examples:
 dist 1 "abcd" = [["abcd"]]
diff --git a/src/Ampersand/FSpec/ToFSpec/Populated.hs b/src/Ampersand/FSpec/ToFSpec/Populated.hs
index 61b66d1cd..462415f94 100644
--- a/src/Ampersand/FSpec/ToFSpec/Populated.hs
+++ b/src/Ampersand/FSpec/ToFSpec/Populated.hs
@@ -22,8 +22,8 @@ import qualified RIO.NonEmpty as NE
 import qualified RIO.Set as Set
 
 genericAndSpecifics :: AClassify -> [(A_Concept, A_Concept)]
-genericAndSpecifics gen = filter (uncurry (/=)) $ -- make sure that no tuples where source and target are equal are returned.
-  case gen of
+genericAndSpecifics gen = filter (uncurry (/=))
+  $ case gen of -- make sure that no tuples where source and target are equal are returned.
     Isa {} -> [(genspc gen, gengen gen)]
     IsE {} -> [(genspc gen, g) | g <- NE.toList $ genrhs gen]
 
@@ -63,10 +63,10 @@ atomValuesOf ci pt c =
     ONE -> Set.singleton AtomValueOfONE
     PlainConcept {} ->
       let smallerconcs = c : smallerConcepts (ctxiGens ci) c
-       in Set.fromList $
-            [apLeft p | pop@ARelPopu {} <- pt, source (popdcl pop) `elem` smallerconcs, p <- toList $ popps pop]
-              ++ [apRight p | pop@ARelPopu {} <- pt, target (popdcl pop) `elem` smallerconcs, p <- toList $ popps pop]
-              ++ [a | pop@ACptPopu {} <- pt, popcpt pop `elem` smallerconcs, a <- popas pop]
+       in Set.fromList
+            $ [apLeft p | pop@ARelPopu {} <- pt, source (popdcl pop) `elem` smallerconcs, p <- toList $ popps pop]
+            ++ [apRight p | pop@ARelPopu {} <- pt, target (popdcl pop) `elem` smallerconcs, p <- toList $ popps pop]
+            ++ [a | pop@ACptPopu {} <- pt, popcpt pop `elem` smallerconcs, a <- popas pop]
 
 pairsOf :: ContextInfo -> [Population] -> Relation -> Map.Map AAtomValue AAtomValues
 pairsOf ci ps dcl =
@@ -135,11 +135,11 @@ fullContents ci ps e = Set.fromList [mkAtomPair a b | let pairMap = contents e,
               where
                 flipr = contents (EFlp r)
             EKl0 x ->
-              if source x == target x --see #166
+              if source x == target x -- see #166
                 then transClosureMap (Map.unionWith Set.union (contents x) (contents (EDcI (source x))))
                 else fatal ("source and target of " <> tshow x <> tshow (sign x) <> " are not equal.")
             EKl1 x ->
-              if source x == target x --see #166
+              if source x == target x -- see #166
                 then transClosureMap (contents x)
                 else fatal ("source and target of " <> tshow x <> tshow (sign x) <> " are not equal.")
             EFlp x -> Map.fromListWith Set.union [(b, Set.singleton a) | (a, bs) <- Map.assocs (contents x), b <- Set.toList bs]
@@ -157,7 +157,8 @@ fullContents ci ps e = Set.fromList [mkAtomPair a b | let pairMap = contents e,
                 ]
             EMp1 val c ->
               if isSESSION c -- prevent populating SESSION with "_SESSION"
-                && tshow val == tshow ("_SESSION" :: Text)
+                && tshow val
+                == tshow ("_SESSION" :: Text)
                 then Map.empty
                 else Map.singleton av (Set.singleton av)
               where
diff --git a/src/Ampersand/FSpec/Transformers.hs b/src/Ampersand/FSpec/Transformers.hs
index 0b27290c1..401d28586 100644
--- a/src/Ampersand/FSpec/Transformers.hs
+++ b/src/Ampersand/FSpec/Transformers.hs
@@ -55,18 +55,18 @@ instance Show PopAtom where
       PopAlphaNumeric str -> show str
       PopInt i -> show i
 
-dirtyId :: Unique a => a -> Maybe PopAtom
+dirtyId :: (Unique a) => a -> Maybe PopAtom
 dirtyId x = DirtyId <$> idWithoutType x
 
-dirtyId' :: Unique e => e -> PopAtom
+dirtyId' :: (Unique e) => e -> PopAtom
 dirtyId' x = case dirtyId x of
   Nothing -> fatal $ "Not a valid dirtyId could be generated: " <> tshow (typeOf x) <> ": " <> text1ToText (showUnique x)
   Just pa -> pa
 
-dirtyIdWithoutType :: Unique a => a -> Maybe PopAtom
+dirtyIdWithoutType :: (Unique a) => a -> Maybe PopAtom
 dirtyIdWithoutType x = DirtyId <$> idWithoutType x
 
-dirtyIdWithoutType' :: Unique e => e -> PopAtom
+dirtyIdWithoutType' :: (Unique e) => e -> PopAtom
 dirtyIdWithoutType' x = case dirtyIdWithoutType x of
   Nothing -> fatal $ "Not a valid dirtyIdWithoutType could be generated: " <> tshow (typeOf x) <> ": " <> text1ToText (showUnique x)
   Just pa -> pa
@@ -375,13 +375,13 @@ transformersFormalAmpersand fSpec =
         "PairViewSegment",
         "MySQLQuery",
         Set.empty,
-        [] --TODO
+        [] -- TODO
       ),
       ( "expTgt",
         "PairViewSegment",
         "Concept",
         Set.empty,
-        [] --TODO
+        [] -- TODO
       ),
       ( "fieldIn",
         "FieldDef",
@@ -473,7 +473,7 @@ transformersFormalAmpersand fSpec =
         "Interface",
         "Relation",
         Set.empty,
-        [] --TODO
+        [] -- TODO
       ),
       ( "ifcObj",
         "Interface",
@@ -487,7 +487,7 @@ transformersFormalAmpersand fSpec =
         "Interface",
         "Relation",
         Set.empty,
-        [] --TODO
+        [] -- TODO
       ),
       ( "ifcPos",
         "Interface",
@@ -616,7 +616,7 @@ transformersFormalAmpersand fSpec =
         "Rule",
         "Message",
         Set.empty,
-        [] --TODO
+        [] -- TODO
       ),
       ( "proprules",
         "PropertyRule",
@@ -769,7 +769,7 @@ transformersFormalAmpersand fSpec =
         "Rule",
         "PairView",
         Set.empty,
-        [] --TODO
+        [] -- TODO
       ),
       ( "prop",
         "Relation",
@@ -859,7 +859,7 @@ transformersFormalAmpersand fSpec =
         [ (dirtyId' quad, dirtyId' conj)
           | quad <- vquads fSpec,
             conj <- NE.toList (qConjuncts quad)
-        ] --TODO
+        ] -- TODO
       ),
       ( "qDcl",
         "Quad",
@@ -867,7 +867,7 @@ transformersFormalAmpersand fSpec =
         Set.fromList [Uni, Tot],
         [ (dirtyId' quad, dirtyId' (qDcl quad))
           | quad <- vquads fSpec
-        ] --TODO
+        ] -- TODO
       ),
       ( "qRule",
         "Quad",
@@ -875,7 +875,7 @@ transformersFormalAmpersand fSpec =
         Set.fromList [Uni, Tot],
         [ (dirtyId' quad, dirtyId' (qRule quad))
           | quad <- vquads fSpec
-        ] --TODO
+        ] -- TODO
       ),
       ( "rc_orgRules",
         "Conjunct",
@@ -908,19 +908,19 @@ transformersFormalAmpersand fSpec =
         "PairView",
         "PairViewSegment",
         Set.empty,
-        [] --TODO
+        [] -- TODO
       ),
       ( "segmentType",
         "PairViewSegment",
         "PairViewSegmentType",
         Set.empty,
-        [] --TODO
+        [] -- TODO
       ),
       ( "sequenceNr",
         "PairViewSegment",
         "Int",
         Set.empty,
-        [] --TODO
+        [] -- TODO
       ),
       ( "sessAtom",
         "SESSION",
@@ -932,13 +932,13 @@ transformersFormalAmpersand fSpec =
         "SESSION",
         "Interface",
         Set.empty,
-        [] --TODO
+        [] -- TODO
       ),
       ( "sessionRole",
         "SESSION",
         "Role",
         Set.empty,
-        [] --TODO
+        [] -- TODO
       ),
       ( "showADL",
         "Term",
@@ -993,7 +993,7 @@ transformersFormalAmpersand fSpec =
         "PairViewSegment",
         "SourceOrTarget",
         Set.fromList [Uni, Tot],
-        [] --TODO
+        [] -- TODO
       ),
       ( "target",
         "Relation",
@@ -1007,7 +1007,7 @@ transformersFormalAmpersand fSpec =
         "PairViewSegment",
         "String",
         Set.fromList [Uni, Tot],
-        [] --TODO
+        [] -- TODO
       ),
       ( "tgt",
         "Signature",
@@ -1159,13 +1159,13 @@ transformersFormalAmpersand fSpec =
         "Concept",
         "Concept",
         Set.empty,
-        [] --TODO
+        [] -- TODO
       ),
       ( "violatable",
         "Interface",
         "Rule",
         Set.empty,
-        [] --TODO
+        [] -- TODO
       )
     ]
 
@@ -1238,7 +1238,7 @@ transformersPrototypeContext fSpec =
       )
     ]
 
-class Instances a => HasPurpose a where
+class (Instances a) => HasPurpose a where
   purposes :: FSpec -> a -> [Purpose]
   purposes fSpec a =
     Set.toList . Set.filter (isFor a) . instances $ fSpec
diff --git a/src/Ampersand/Graphic/ClassDiag2Dot.hs b/src/Ampersand/Graphic/ClassDiag2Dot.hs
index 23cd4d8d9..51d0349a2 100644
--- a/src/Ampersand/Graphic/ClassDiag2Dot.hs
+++ b/src/Ampersand/Graphic/ClassDiag2Dot.hs
@@ -32,13 +32,14 @@ classdiagram2dot env cd =
               GraphAttrs
                 [ RankDir FromLeft,
                   bgColor White
-                ] :
-              --    ++ [NodeAttrs  [ ]]
-              [ EdgeAttrs
-                  [ FontSize 11,
-                    MinLen 4
-                  ]
-              ],
+                ]
+                :
+                --    ++ [NodeAttrs  [ ]]
+                [ EdgeAttrs
+                    [ FontSize 11,
+                      MinLen 4
+                    ]
+                ],
             subGraphs = group2subgraph <$> groups cd,
             nodeStmts =
               map class2node (allClasses cd)
@@ -75,7 +76,7 @@ classdiagram2dot env cd =
               }
         }
       where
-        nameLabel :: Named a => a -> TL.Text
+        nameLabel :: (Named a) => a -> TL.Text
         nameLabel = TL.fromStrict . fullName
         nm = fst x
         notInClassNodes :: Name -> Bool
@@ -269,7 +270,7 @@ instance CdNode (Name, NonEmpty Class) where
 instance CdNode Class where
   nodes cl = [name . clName $ cl]
 
-instance CdNode a => CdNode [a] where
+instance (CdNode a) => CdNode [a] where
   nodes = concatMap nodes
 
 instance CdNode Association where
diff --git a/src/Ampersand/Graphic/Fspec2ClassDiagrams.hs b/src/Ampersand/Graphic/Fspec2ClassDiagrams.hs
index 7761d1e1a..e8eab0557 100644
--- a/src/Ampersand/Graphic/Fspec2ClassDiagrams.hs
+++ b/src/Ampersand/Graphic/Fspec2ClassDiagrams.hs
@@ -127,9 +127,12 @@ dclIsShown :: FSpec -> [A_Concept] -> Relation -> Bool
 dclIsShown fSpec nodeConcepts d =
   (not . isProp . EDcD) d
     && ( (d `notElem` attribDcls fSpec)
-           || ( source d `elem` nodeConcepts
-                  && target d `elem` nodeConcepts
-                  && source d /= target d
+           || ( source d
+                  `elem` nodeConcepts
+                  && target d
+                  `elem` nodeConcepts
+                  && source d
+                  /= target d
               )
        )
 
@@ -170,17 +173,17 @@ instance CDAnalysable FSpec where
       groups' :: [(Name, NonEmpty Class)]
       (groups', classes')
         | grouped =
-          ( [ ( name pat,
-                case classesOfPattern (Just pat) of
-                  [] -> fatal "Shouldn't be empty here"
-                  h : tl -> h :| tl
-              )
-              | pat :: Pattern <- instanceList fSpec,
-                let cls = classesOfPattern (Just pat),
-                not (null cls)
-            ],
-            classesOfPattern Nothing
-          ) -- (samePattern $ rights grps, lefts grps)
+            ( [ ( name pat,
+                  case classesOfPattern (Just pat) of
+                    [] -> fatal "Shouldn't be empty here"
+                    h : tl -> h :| tl
+                )
+                | pat :: Pattern <- instanceList fSpec,
+                  let cls = classesOfPattern (Just pat),
+                  not (null cls)
+              ],
+              classesOfPattern Nothing
+            ) -- (samePattern $ rights grps, lefts grps)
         | otherwise = ([], map (buildClass fSpec) entities)
       classesOfPattern :: Maybe Pattern -> [Class]
       classesOfPattern pat =
@@ -233,8 +236,8 @@ tdAnalysis fSpec =
                  in map (ooAtt kernelAtts) kernelAtts
                       <> map (ooAtt kernelAtts . rsTrgAtt) (dLkpTbl table)
               BinSQL {} ->
-                NE.toList $
-                  fmap mkOOattr (plugAttributes table)
+                NE.toList
+                  $ fmap mkOOattr (plugAttributes table)
                 where
                   mkOOattr a =
                     OOAttr
diff --git a/src/Ampersand/Graphic/Graphics.hs b/src/Ampersand/Graphic/Graphics.hs
index eca197b23..02b1e8fa9 100644
--- a/src/Ampersand/Graphic/Graphics.hs
+++ b/src/Ampersand/Graphic/Graphics.hs
@@ -61,11 +61,13 @@ instance Named PictureTyp where -- for displaying a fatal error
     where
       mkName' :: Text -> Name
       mkName' x =
-        withNameSpace nameSpaceFormalAmpersand . mkName ContextName . (:| []) $
-          ( case toNamePart x of
-              Nothing -> fatal $ "Not a valid NamePart: " <> tshow x
-              Just np -> np
-          )
+        withNameSpace nameSpaceFormalAmpersand
+          . mkName ContextName
+          . (:| [])
+          $ ( case toNamePart x of
+                Nothing -> fatal $ "Not a valid NamePart: " <> tshow x
+                Just np -> np
+            )
 
 makePicture :: (HasOutputLanguage env) => env -> FSpec -> PictureTyp -> Picture
 makePicture env fSpec pr =
@@ -169,8 +171,8 @@ makePicture env fSpec pr =
 --   Each pictureFileName must be unique (within fSpec) to prevent overwriting newly created files.
 --   File names are urlEncoded to cater for the entire alphabet.
 pictureFileName :: PictureTyp -> FilePath
-pictureFileName pr = toBaseFileName $
-  case pr of
+pictureFileName pr = toBaseFileName
+  $ case pr of
     PTClassDiagram -> "Classification"
     PTLogicalDM grouped -> "LogicalDataModel" <> if grouped then "_Grouped_By_Pattern" else mempty
     PTTechnicalDM -> "TechnicalDataModel"
@@ -255,7 +257,7 @@ writePicture pict = do
   liftIO $ createDirectoryIfMissing True (takeDirectory imagePathRelativeToCurrentDir)
   writeDot imagePathRelativeToCurrentDir Canon -- To obtain the Graphviz source code of the images
   --  writeDot imagePathRelativeToCurrentDir DotOutput --Reproduces the input along with layout information.
-  writeDot imagePathRelativeToCurrentDir Png --handy format to include in github comments/issues
+  writeDot imagePathRelativeToCurrentDir Png -- handy format to include in github comments/issues
   -- writeDot imagePathRelativeToCurrentDir Svg   -- format that is used when docx docs are being generated.
   -- writePdf imagePathRelativeToCurrentDir Eps   -- .eps file that is postprocessed to a .pdf file
   where
@@ -268,7 +270,7 @@ writePicture pict = do
     writeDotPostProcess ::
       (HasBlackWhite env, HasLogFunc env) =>
       FilePath ->
-      Maybe (FilePath -> RIO env ()) -> --Optional postprocessor
+      Maybe (FilePath -> RIO env ()) -> -- Optional postprocessor
       GraphvizOutput ->
       RIO env ()
     writeDotPostProcess fp postProcess gvOutput =
@@ -278,8 +280,9 @@ writePicture pict = do
         let dotSource = mkDotGraph env pict
         --  writeFileUtf8 (dropExtension fp <.> "dotSource") (tshow dotSource)
         path <-
-          liftIO . GV.addExtension (runGraphvizCommand gvCommand dotSource) gvOutput $
-            dropExtension fp
+          liftIO
+            . GV.addExtension (runGraphvizCommand gvCommand dotSource) gvOutput
+            $ dropExtension fp
         absPath <- liftIO . makeAbsolute $ path
         logInfo $ display (T.pack absPath) <> " written."
         case postProcess of
@@ -394,9 +397,9 @@ conceptual2Dot cs@(CStruct _ rels idgs) =
           }
     }
   where
-    nodes :: HasDotParts a => a -> [DotNode Name]
+    nodes :: (HasDotParts a) => a -> [DotNode Name]
     nodes = dotNodes cs
-    edges :: HasDotParts a => a -> [DotEdge Name]
+    edges :: (HasDotParts a) => a -> [DotEdge Name]
     edges = dotEdges cs
 
 class HasDotParts a where
@@ -407,11 +410,12 @@ baseNodeId :: ConceptualStructure -> A_Concept -> Name
 baseNodeId x c =
   case lookup c (zip (allCpts x) [(1 :: Int) ..]) of
     Just i ->
-      mkName ConceptName . (:| []) $
-        ( case toNamePart $ "cpt_" <> tshow i of
-            Nothing -> fatal $ "Not a valid NamePart: " <> "cpt_" <> tshow i
-            Just np -> np
-        )
+      mkName ConceptName
+        . (:| [])
+        $ ( case toNamePart $ "cpt_" <> tshow i of
+              Nothing -> fatal $ "Not a valid NamePart: " <> "cpt_" <> tshow i
+              Just np -> np
+          )
     _ -> fatal ("element " <> fullName c <> " not found by nodeLabel.")
 
 allCpts :: ConceptualStructure -> [A_Concept]
@@ -434,45 +438,51 @@ instance HasDotParts A_Concept where
 instance HasDotParts Relation where
   dotNodes x rel
     | isEndo rel =
-      [ DotNode
-          { nodeID = prependToPlainName (fullName . baseNodeId x . source $ rel) $ name rel,
-            nodeAttributes =
-              [ Color [WC (X11Color Transparent) Nothing],
-                Shape PlainText,
-                Label . StrLabel . TL.fromStrict . T.intercalate "\n" $
-                  fullName rel :
-                  case Set.toList . properties $ rel of
-                    [] -> []
-                    ps -> ["[" <> (T.intercalate ", " . map (T.toLower . tshow) $ ps) <> "]"]
-              ]
-          }
-      ]
+        [ DotNode
+            { nodeID = prependToPlainName (fullName . baseNodeId x . source $ rel) $ name rel,
+              nodeAttributes =
+                [ Color [WC (X11Color Transparent) Nothing],
+                  Shape PlainText,
+                  Label
+                    . StrLabel
+                    . TL.fromStrict
+                    . T.intercalate "\n"
+                    $ fullName rel
+                    : case Set.toList . properties $ rel of
+                      [] -> []
+                      ps -> ["[" <> (T.intercalate ", " . map (T.toLower . tshow) $ ps) <> "]"]
+                ]
+            }
+        ]
     | otherwise = []
   dotEdges x rel
     | isEndo rel =
-      [ DotEdge
-          { fromNode = baseNodeId x . source $ rel,
-            toNode = prependToPlainName (fullName . baseNodeId x . source $ rel) $ name rel,
-            edgeAttributes =
-              [ Dir NoDir,
-                edgeLenFactor 0.4,
-                Label . StrLabel . fromString $ ""
-              ]
-          }
-      ]
+        [ DotEdge
+            { fromNode = baseNodeId x . source $ rel,
+              toNode = prependToPlainName (fullName . baseNodeId x . source $ rel) $ name rel,
+              edgeAttributes =
+                [ Dir NoDir,
+                  edgeLenFactor 0.4,
+                  Label . StrLabel . fromString $ ""
+                ]
+            }
+        ]
     | otherwise =
-      [ DotEdge
-          { fromNode = baseNodeId x . source $ rel,
-            toNode = baseNodeId x . target $ rel,
-            edgeAttributes =
-              [ Label . StrLabel . TL.fromStrict . T.intercalate "\n" $
-                  fullName rel :
-                  case Set.toList . properties $ rel of
-                    [] -> []
-                    ps -> ["[" <> (T.intercalate ", " . map (T.toLower . tshow) $ ps) <> "]"]
-              ]
-          }
-      ]
+        [ DotEdge
+            { fromNode = baseNodeId x . source $ rel,
+              toNode = baseNodeId x . target $ rel,
+              edgeAttributes =
+                [ Label
+                    . StrLabel
+                    . TL.fromStrict
+                    . T.intercalate "\n"
+                    $ fullName rel
+                    : case Set.toList . properties $ rel of
+                      [] -> []
+                      ps -> ["[" <> (T.intercalate ", " . map (T.toLower . tshow) $ ps) <> "]"]
+                ]
+            }
+        ]
 
 instance HasDotParts (A_Concept, A_Concept) where
   dotNodes _ _ = []
diff --git a/src/Ampersand/Input/ADL1/CtxError.hs b/src/Ampersand/Input/ADL1/CtxError.hs
index aaabaf770..a08e2386e 100644
--- a/src/Ampersand/Input/ADL1/CtxError.hs
+++ b/src/Ampersand/Input/ADL1/CtxError.hs
@@ -80,7 +80,7 @@ data CtxError
   = CTXE Origin Text -- SJC: I consider it ill practice to export CTXE, see remark at top
   | PE ParseError
   | LE LexerError
-  | RoundTripError Text (Either (NonEmpty CtxError) Text) --The prettyprinted script and either the error given at the script or some descriptive error text.
+  | RoundTripError Text (Either (NonEmpty CtxError) Text) -- The prettyprinted script and either the error given at the script or some descriptive error text.
 
 instance Show CtxError where
   -- The vscode extension expects errors and warnings
@@ -89,25 +89,26 @@ instance Show CtxError where
   -- this function is changed, please verify
   -- the proper working of the ampersand-language-extension
   show err =
-    T.unpack . T.intercalate "\n  " $
-      [tshow (origin err) <> " error:"]
-        <> ( case err of
-               CTXE _ s -> T.lines s
-               PE e ->
-                 -- The first line of a parse error allways contains
-                 -- the filename and position of the error. However,
-                 -- these are in a wrong format. So we strip the first
-                 -- line of the error:
-                 case T.lines (tshow e) of
-                   [] -> fatal "Whoh! the impossible just happened! (triggered by a parse error somewhere in your script)"
-                   _ : xs -> xs
-               LE (LexerError _ info) -> T.lines (tshow info)
-               RoundTripError script err' ->
-                 ["Roundtrip test failed. Script that was tried:"]
-                   ++ map ("  " <>) (T.lines script)
-                   ++ ["Yields the following error:"]
-                   ++ map ("  " <>) (T.lines $ tshow err')
-           )
+    T.unpack
+      . T.intercalate "\n  "
+      $ [tshow (origin err) <> " error:"]
+      <> ( case err of
+             CTXE _ s -> T.lines s
+             PE e ->
+               -- The first line of a parse error allways contains
+               -- the filename and position of the error. However,
+               -- these are in a wrong format. So we strip the first
+               -- line of the error:
+               case T.lines (tshow e) of
+                 [] -> fatal "Whoh! the impossible just happened! (triggered by a parse error somewhere in your script)"
+                 _ : xs -> xs
+             LE (LexerError _ info) -> T.lines (tshow info)
+             RoundTripError script err' ->
+               ["Roundtrip test failed. Script that was tried:"]
+                 ++ map ("  " <>) (T.lines script)
+                 ++ ["Yields the following error:"]
+                 ++ map ("  " <>) (T.lines $ tshow err')
+         )
 
 data Warning = Warning Origin Text
 
@@ -118,9 +119,10 @@ instance Show Warning where
   -- this function is changed, please verify
   -- the proper working of the ampersand-language-extension
   show (Warning o msg) =
-    T.unpack . T.intercalate "\n  " $
-      [tshow o <> " warning: "]
-        <> T.lines msg
+    T.unpack
+      . T.intercalate "\n  "
+      $ [tshow o <> " warning: "]
+      <> T.lines msg
 
 instance Traced CtxError where
   origin (CTXE o _) = o
@@ -171,11 +173,11 @@ mkMultipleRepresentTypesError cpt rs =
       [] -> fatal "Call of mkMultipleRepresentTypesError with no Representations"
       (_, x) : _ -> x
     msg =
-      T.intercalate "\n" $
-        [ "The Concept " <> (text1ToText . showWithAliases) cpt <> " was shown to be representable with multiple types.",
-          "The following TYPEs are defined for it:"
-        ]
-          <> ["  - " <> tshow t <> " at " <> showFullOrig orig | (t, orig) <- rs]
+      T.intercalate "\n"
+        $ [ "The Concept " <> (text1ToText . showWithAliases) cpt <> " was shown to be representable with multiple types.",
+            "The following TYPEs are defined for it:"
+          ]
+        <> ["  - " <> tshow t <> " at " <> showFullOrig orig | (t, orig) <- rs]
 
 mkMultipleTypesInTypologyError :: [(A_Concept, TType, [Origin])] -> Guarded a
 mkMultipleTypesInTypologyError tripls =
@@ -185,12 +187,12 @@ mkMultipleTypesInTypologyError tripls =
       (_, _, x : _) : _ -> x
       _ -> fatal "No origin in list."
     msg =
-      T.intercalate "\n" $
-        [ "Concepts in the same typology must have the same TYPE.",
-          "The following concepts are in the same typology, but not all",
-          "of them have the same TYPE:"
-        ]
-          <> ["  - REPRESENT " <> (text1ToText . showWithAliases) c <> " TYPE " <> tshow t <> " at " <> showFullOrig orig | (c, t, origs) <- tripls, orig <- origs]
+      T.intercalate "\n"
+        $ [ "Concepts in the same typology must have the same TYPE.",
+            "The following concepts are in the same typology, but not all",
+            "of them have the same TYPE:"
+          ]
+        <> ["  - REPRESENT " <> (text1ToText . showWithAliases) c <> " TYPE " <> tshow t <> " at " <> showFullOrig orig | (c, t, origs) <- tripls, orig <- origs]
 
 mkMultipleRootsError :: [A_Concept] -> NE.NonEmpty AClassify -> Guarded a
 mkMultipleRootsError roots gs =
@@ -198,24 +200,25 @@ mkMultipleRootsError roots gs =
   where
     o = origin (NE.head gs)
     msg =
-      T.intercalate "\n" $
-        [ "A typology must have at most one root concept.",
-          "The following CLASSIFY statements define a typology with multiple root concepts: "
-        ]
-          <> ["  - " <> showA x <> " at " <> showFullOrig (origin x) | x <- NE.toList gs]
-          <> ["Parhaps you could add the following statements:"]
-          <> ["  CLASSIFY " <> (text1ToText . showWithAliases) cpt <> " ISA " <> tshow rootName | cpt <- roots]
+      T.intercalate "\n"
+        $ [ "A typology must have at most one root concept.",
+            "The following CLASSIFY statements define a typology with multiple root concepts: "
+          ]
+        <> ["  - " <> showA x <> " at " <> showFullOrig (origin x) | x <- NE.toList gs]
+        <> ["Parhaps you could add the following statements:"]
+        <> ["  CLASSIFY " <> (text1ToText . showWithAliases) cpt <> " ISA " <> tshow rootName | cpt <- roots]
       where
         rootName = T.intercalate "_Or_" . map (text1ToText . showWithAliases) $ roots
 
 nonMatchingRepresentTypes :: Origin -> TType -> TType -> Guarded a
 nonMatchingRepresentTypes orig wrongType rightType =
-  Errors . pure $
-    CTXE orig $
-      "A CLASSIFY statement is only allowed between Concepts that are represented by the same type, but "
-        <> tshow wrongType
-        <> " is not the same as "
-        <> tshow rightType
+  Errors
+    . pure
+    $ CTXE orig
+    $ "A CLASSIFY statement is only allowed between Concepts that are represented by the same type, but "
+    <> tshow wrongType
+    <> " is not the same as "
+    <> tshow rightType
 
 class GetOneGuarded a b | b -> a where
   {-# MINIMAL getOneExactly | hasNone #-} -- we don't want endless loops, do we?
@@ -237,15 +240,19 @@ class GetOneGuarded a b | b -> a where
 instance GetOneGuarded Expression P_NamedRel where
   getOneExactly _ [d] = pure d
   getOneExactly o [] =
-    Errors . pure $
-      CTXE (origin o) $
-        "A relation is used that is not explicitly declared: " <> showP o
+    Errors
+      . pure
+      $ CTXE (origin o)
+      $ "A relation is used that is not explicitly declared: "
+      <> showP o
   getOneExactly o lst =
-    Errors . pure $
-      CTXE (origin o) $
-        "A relation is used that is not explicitly declared: " <> showP o
-          <> ".\n  Explicitly mention one of the following matching terms:"
-          <> T.concat ["\n  - " <> showA l | l <- lst]
+    Errors
+      . pure
+      $ CTXE (origin o)
+      $ "A relation is used that is not explicitly declared: "
+      <> showP o
+      <> ".\n  Explicitly mention one of the following matching terms:"
+      <> T.concat ["\n  - " <> showA l | l <- lst]
 
 instance GetOneGuarded Expression (P_NamedRel, (A_Concept, A_Concept)) where
   getOneExactly (o, (sr, tg)) = getOneExactly (o, (Just sr, Just tg))
@@ -254,15 +261,19 @@ instance GetOneGuarded Expression (P_NamedRel, (Maybe A_Concept, Maybe A_Concept
   getOneExactly o lst = case lst of
     [d] -> pure d
     [] ->
-      Errors . pure $
-        (CTXE . origin . fst) o $
-          "A relation is used that is not explicitly declared: " <> showP_T o
+      Errors
+        . pure
+        $ (CTXE . origin . fst) o
+        $ "A relation is used that is not explicitly declared: "
+        <> showP_T o
     _ ->
-      Errors . pure $
-        (CTXE . origin . fst) o $
-          "A relation is used that is not explicitly declared: " <> showP_T o
-            <> ".\n  Perhaps you meant one of the following matching terms:"
-            <> T.concat ["\n  - " <> showA l | l <- lst]
+      Errors
+        . pure
+        $ (CTXE . origin . fst) o
+        $ "A relation is used that is not explicitly declared: "
+        <> showP_T o
+        <> ".\n  Perhaps you meant one of the following matching terms:"
+        <> T.concat ["\n  - " <> showA l | l <- lst]
     where
       showP_T :: (P_NamedRel, (Maybe A_Concept, Maybe A_Concept)) -> Text
       showP_T (p, (src, tgt)) = fullName p <> "[" <> showC src <> "*" <> showC tgt <> "]"
@@ -299,28 +310,28 @@ cannotDisambiguate o x = Errors . pure $ CTXE (origin o) message
         Rel [] -> "A relation is used that is not defined: " <> showP o
         Rel exprs -> case o of
           (PNamedR (PNamedRel _ _ Nothing)) ->
-            T.intercalate "\n" $
-              [ "Cannot disambiguate the relation: " <> showP o,
-                "  Please add a signature (e.g. [A*B]) to the relation.",
-                "  Relations you may have intended:"
-              ]
-                <> map (("  " <>) . showA') exprs
-                <> noteIssue980
+            T.intercalate "\n"
+              $ [ "Cannot disambiguate the relation: " <> showP o,
+                  "  Please add a signature (e.g. [A*B]) to the relation.",
+                  "  Relations you may have intended:"
+                ]
+              <> map (("  " <>) . showA') exprs
+              <> noteIssue980
           _ ->
-            T.intercalate "\n" $
-              [ "Cannot disambiguate: " <> showP o,
-                "  Please add a signature (e.g. [A*B]) to the term.",
-                "  You may have intended one of these:"
-              ]
-                <> map (("  " <>) . showA') exprs
-                <> noteIssue980
+            T.intercalate "\n"
+              $ [ "Cannot disambiguate: " <> showP o,
+                  "  Please add a signature (e.g. [A*B]) to the term.",
+                  "  You may have intended one of these:"
+                ]
+              <> map (("  " <>) . showA') exprs
+              <> noteIssue980
         Known _ -> fatal "We have a known term, so it is allready disambiguated."
         _ ->
-          T.intercalate "\n" $
-            [ "Cannot disambiguate: " <> showP o,
-              "  Please add a signature (e.g. [A*B]) to it."
-            ]
-              <> noteIssue980
+          T.intercalate "\n"
+            $ [ "Cannot disambiguate: " <> showP o,
+                "  Please add a signature (e.g. [A*B]) to it."
+              ]
+            <> noteIssue980
     noteIssue980 =
       [ "Note: Some cases are not disambiguated fully by design. You can read about",
         "  this at https://github.com/AmpersandTarski/Ampersand/issues/980#issuecomment-508985676"
@@ -349,7 +360,11 @@ uniqueNames nameclass = uniqueBy name messageFor
     messageFor x =
       CTXE
         (origin $ NE.head x)
-        ( "Every " <> nameclass <> " must have a unique name. " <> fullName (NE.head x) <> ", however, is used at:"
+        ( "Every "
+            <> nameclass
+            <> " must have a unique name. "
+            <> fullName (NE.head x)
+            <> ", however, is used at:"
             <> T.intercalate "\n    " (NE.toList $ fmap (tshow . origin) x)
             <> "."
         )
@@ -370,7 +385,7 @@ uniqueLables orig toLabel = uniqueBy toLabel (messageFor . fmap toLabel)
 
 -- | Helper function to check for uniqueness.
 uniqueBy ::
-  Ord b =>
+  (Ord b) =>
   -- | user supplied function to project something out of each element
   (a -> b) ->
   -- | user supplied function to generate the error for a nonempty list
@@ -400,16 +415,21 @@ mkUndeclaredError :: Text -> P_BoxItem a -> Name -> CtxError
 mkUndeclaredError entity objDef ref =
   case objDef of
     P_BoxItemTerm {} ->
-      CTXE (origin objDef) $
-        "Undeclared " <> entity <> " " <> tshow ref <> " referenced at field " <> tshow (obj_PlainName objDef)
+      CTXE (origin objDef)
+        $ "Undeclared "
+        <> entity
+        <> " "
+        <> tshow ref
+        <> " referenced at field "
+        <> tshow (obj_PlainName objDef)
     _ -> fatal "Unexpected use of mkUndeclaredError."
 
 mkEndoPropertyError :: Origin -> [PProp] -> CtxError
 mkEndoPropertyError orig ps =
   CTXE orig msg
   where
-    msg = T.intercalate "\n" $
-      case ps of
+    msg = T.intercalate "\n"
+      $ case ps of
         [] -> fatal "What property is causing this error???"
         [p] ->
           [ "Property " <> tshow p <> " can only be used for relations where",
@@ -424,9 +444,13 @@ mkEndoPropertyError orig ps =
 
 mkMultipleInterfaceError :: Text -> Interface -> [Interface] -> CtxError
 mkMultipleInterfaceError role' ifc duplicateIfcs =
-  CTXE (origin ifc) $
-    "Multiple interfaces named " <> fullName ifc <> " for role " <> tshow role' <> ":"
-      <> T.intercalate "\n    " (map (tshow . origin) (ifc : duplicateIfcs))
+  CTXE (origin ifc)
+    $ "Multiple interfaces named "
+    <> fullName ifc
+    <> " for role "
+    <> tshow role'
+    <> ":"
+    <> T.intercalate "\n    " (map (tshow . origin) (ifc : duplicateIfcs))
 
 mkInvalidCRUDError :: Origin -> Text1 -> CtxError
 mkInvalidCRUDError o x = CTXE o $ "Invalid CRUD annotation. (doubles and other characters than crud are not allowed): `" <> text1ToText x <> "`."
@@ -449,25 +473,25 @@ mkInvariantViolationsError applyViolText (r, ps) =
   where
     violationMessage :: Text
     violationMessage =
-      T.unlines $
-        [ if length ps == 1
-            then "There is a violation of RULE " <> fullName r <> ":"
-            else "There are " <> tshow (length ps) <> " violations of RULE " <> fullName r <> ":"
-        ]
-          <> (map ("  " <>) . listPairs 10 . toList $ ps)
+      T.unlines
+        $ [ if length ps == 1
+              then "There is a violation of RULE " <> fullName r <> ":"
+              else "There are " <> tshow (length ps) <> " violations of RULE " <> fullName r <> ":"
+          ]
+        <> (map ("  " <>) . listPairs 10 . toList $ ps)
     listPairs :: Int -> [AAtomPair] -> [Text]
     listPairs i xs =
       case xs of
         [] -> []
         h : tl
           | i == 0 -> ["  ... (" <> tshow (length xs) <> " more)"]
-          | otherwise -> applyViolText r h : listPairs (i -1) tl
+          | otherwise -> applyViolText r h : listPairs (i - 1) tl
 
 mkInterfaceRefCycleError :: NE.NonEmpty Interface -> CtxError
 mkInterfaceRefCycleError cyclicIfcs =
-  CTXE (origin (NE.head cyclicIfcs)) $
-    "Interfaces form a reference cycle:\n"
-      <> (T.unlines . NE.toList $ fmap showIfc cyclicIfcs)
+  CTXE (origin (NE.head cyclicIfcs))
+    $ "Interfaces form a reference cycle:\n"
+    <> (T.unlines . NE.toList $ fmap showIfc cyclicIfcs)
   where
     showIfc :: Interface -> Text
     showIfc i = "- " <> fullName i <> " at position " <> tshow (origin i)
@@ -476,24 +500,27 @@ mkIncompatibleInterfaceError :: P_BoxItem a -> A_Concept -> A_Concept -> Name ->
 mkIncompatibleInterfaceError objDef expTgt refSrc ref =
   case objDef of
     P_BoxItemTerm {} ->
-      CTXE (origin objDef) $
-        "Incompatible interface reference " <> fullName ref
-          <> " at field "
-          <> maybe "without a label" tshow (obj_PlainName objDef)
-          <> ":\nReferenced interface "
-          <> fullName ref
-          <> " has type "
-          <> (text1ToText . showWithAliases) refSrc
-          <> ", which is not comparable to the target "
-          <> (text1ToText . showWithAliases) expTgt
-          <> " of the term at this field."
+      CTXE (origin objDef)
+        $ "Incompatible interface reference "
+        <> fullName ref
+        <> " at field "
+        <> maybe "without a label" tshow (obj_PlainName objDef)
+        <> ":\nReferenced interface "
+        <> fullName ref
+        <> " has type "
+        <> (text1ToText . showWithAliases) refSrc
+        <> ", which is not comparable to the target "
+        <> (text1ToText . showWithAliases) expTgt
+        <> " of the term at this field."
     _ -> fatal "Improper use of mkIncompatibleInterfaceError"
 
 mkMultipleDefaultError :: NE.NonEmpty ViewDef -> CtxError
 mkMultipleDefaultError vds =
-  CTXE (origin . NE.head $ vds) $
-    "Multiple default views for concept " <> (text1ToText . showWithAliases) cpt <> ":"
-      <> T.intercalate "\n    " (fmap showViewDef (NE.toList vds))
+  CTXE (origin . NE.head $ vds)
+    $ "Multiple default views for concept "
+    <> (text1ToText . showWithAliases) cpt
+    <> ":"
+    <> T.intercalate "\n    " (fmap showViewDef (NE.toList vds))
   where
     showViewDef :: ViewDef -> Text
     showViewDef vd = "VIEW " <> fullName vd <> " (at " <> tshow (origin vd) <> ")"
@@ -506,17 +533,19 @@ mkIncompatibleViewError :: (Named b, Named c) => P_BoxItem a -> Name -> b -> c -
 mkIncompatibleViewError objDef viewId viewRefCptStr viewCptStr =
   case objDef of
     P_BoxItemTerm {} ->
-      CTXE (origin objDef) $
-        "Incompatible view annotation <" <> fullName viewId <> "> at field "
-          <> maybe "without a label" tshow (obj_PlainName objDef)
-          <> ":"
-          <> "\nView "
-          <> tshow viewId
-          <> " has type "
-          <> fullName viewCptStr
-          <> ", which should be equal to or more general than the target "
-          <> fullName viewRefCptStr
-          <> " of the term at this field."
+      CTXE (origin objDef)
+        $ "Incompatible view annotation <"
+        <> fullName viewId
+        <> "> at field "
+        <> maybe "without a label" tshow (obj_PlainName objDef)
+        <> ":"
+        <> "\nView "
+        <> tshow viewId
+        <> " has type "
+        <> fullName viewCptStr
+        <> ", which should be equal to or more general than the target "
+        <> fullName viewRefCptStr
+        <> " of the term at this field."
     _ -> fatal "Improper use of mkIncompatibleViewError."
 
 mkOtherAtomInSessionError :: AAtomValue -> CtxError
@@ -529,17 +558,19 @@ mkOtherTupleInSessionError r pr =
 
 mkInterfaceMustBeDefinedOnObject :: P_Interface -> A_Concept -> TType -> CtxError
 mkInterfaceMustBeDefinedOnObject ifc cpt tt =
-  CTXE (origin ifc) . T.intercalate "\n  " $
-    [ "The TYPE of the concept for which an INTERFACE is defined must be OBJECT.",
-      "The TYPE of the concept `" <> (text1ToText . showWithAliases) cpt <> "`, for interface `" <> fullName ifc <> "`, however is " <> tshow tt <> "."
-    ]
+  CTXE (origin ifc)
+    . T.intercalate "\n  "
+    $ [ "The TYPE of the concept for which an INTERFACE is defined must be OBJECT.",
+        "The TYPE of the concept `" <> (text1ToText . showWithAliases) cpt <> "`, for interface `" <> fullName ifc <> "`, however is " <> tshow tt <> "."
+      ]
 
 mkSubInterfaceMustBeDefinedOnObject :: P_SubIfc (TermPrim, DisambPrim) -> A_Concept -> TType -> CtxError
 mkSubInterfaceMustBeDefinedOnObject x cpt tt =
-  CTXE (origin x) . T.intercalate "\n  " $
-    [ "The TYPE of the concept for which a " <> tshow boxTemplate <> " is defined must be OBJECT.",
-      "The TYPE of the concept `" <> (text1ToText . showWithAliases) cpt <> "`, for this " <> tshow boxTemplate <> ", however is " <> tshow tt <> "."
-    ]
+  CTXE (origin x)
+    . T.intercalate "\n  "
+    $ [ "The TYPE of the concept for which a " <> tshow boxTemplate <> " is defined must be OBJECT.",
+        "The TYPE of the concept `" <> (text1ToText . showWithAliases) cpt <> "`, for this " <> tshow boxTemplate <> ", however is " <> tshow tt <> "."
+      ]
   where
     boxTemplate = btType . si_header $ x
 
@@ -572,24 +603,30 @@ instance (AStruct declOrExpr, HasSignature declOrExpr) => ErrorConcept (SrcOrTgt
 
 mustBeOrdered :: (ErrorConcept t1, ErrorConcept t2) => Origin -> t1 -> t2 -> Guarded a
 mustBeOrdered o a b =
-  Errors . pure . CTXE (origin o) . T.unlines $
-    [ "Type error, cannot match:",
-      "  the concept " <> showEC a,
-      "  and concept " <> showEC b
-    ]
+  Errors
+    . pure
+    . CTXE (origin o)
+    . T.unlines
+    $ [ "Type error, cannot match:",
+        "  the concept " <> showEC a,
+        "  and concept " <> showEC b
+      ]
 
 mustBeOrderedLst :: P_SubIfc (TermPrim, DisambPrim) -> [(A_Concept, SrcOrTgt, P_BoxItem TermPrim)] -> Guarded b
 mustBeOrderedLst o lst =
-  Errors . pure . CTXE (origin o) . T.unlines $
-    [ "Type error in BOX",
-      "  Cannot match:"
-    ]
-      <> [ "  - concept " <> (text1ToText . showWithAliases) c <> " , " <> showP st <> " of: " <> showP (exprOf a)
-           | (c, st, a) <- lst
-         ]
-      <> [ "  if you think there is no type error, add an order between the mismatched concepts.",
-           "  You can do so by using a CLASSIFY statement."
-         ]
+  Errors
+    . pure
+    . CTXE (origin o)
+    . T.unlines
+    $ [ "Type error in BOX",
+        "  Cannot match:"
+      ]
+    <> [ "  - concept " <> (text1ToText . showWithAliases) c <> " , " <> showP st <> " of: " <> showP (exprOf a)
+         | (c, st, a) <- lst
+       ]
+    <> [ "  if you think there is no type error, add an order between the mismatched concepts.",
+         "  You can do so by using a CLASSIFY statement."
+       ]
   where
     exprOf :: P_BoxItem TermPrim -> Term TermPrim
     exprOf x =
@@ -599,35 +636,47 @@ mustBeOrderedLst o lst =
 
 mustBeOrderedConcLst :: Origin -> (SrcOrTgt, Expression) -> (SrcOrTgt, Expression) -> [[A_Concept]] -> Guarded (A_Concept, [A_Concept])
 mustBeOrderedConcLst o (p1, e1) (p2, e2) cs =
-  Errors . pure . CTXE (origin o) . T.unlines $
-    [ "Ambiguous type when matching: " <> tshow p1 <> " of " <> showA e1,
-      " and " <> tshow p2 <> " of " <> showA e2 <> ".",
-      "  The type can be " <> T.intercalate " or " (map (T.intercalate "/" . map (text1ToText . showWithAliases)) cs),
-      "  None of these concepts is known to be the smallest, you may want to add an order between them."
-    ]
+  Errors
+    . pure
+    . CTXE (origin o)
+    . T.unlines
+    $ [ "Ambiguous type when matching: " <> tshow p1 <> " of " <> showA e1,
+        " and " <> tshow p2 <> " of " <> showA e2 <> ".",
+        "  The type can be " <> T.intercalate " or " (map (T.intercalate "/" . map (text1ToText . showWithAliases)) cs),
+        "  None of these concepts is known to be the smallest, you may want to add an order between them."
+      ]
 
 mustBeBound :: Origin -> [(SrcOrTgt, Expression)] -> Guarded a
 mustBeBound o [(p, e)] =
-  Errors . pure . CTXE (origin o) . T.unlines $
-    [ "An ambiguity arises in type checking. Be more specific by binding the " <> tshow p <> " of the term",
-      "  " <> showA e <> ".",
-      "  You could add more types inside the term, or just write",
-      "  " <> writeBind e <> "."
-    ]
+  Errors
+    . pure
+    . CTXE (origin o)
+    . T.unlines
+    $ [ "An ambiguity arises in type checking. Be more specific by binding the " <> tshow p <> " of the term",
+        "  " <> showA e <> ".",
+        "  You could add more types inside the term, or just write",
+        "  " <> writeBind e <> "."
+      ]
 mustBeBound o lst =
-  Errors . pure . CTXE (origin o) . T.unlines $
-    [ "An ambiguity arises in type checking. Be more specific in the terms ",
-      "  " <> T.intercalate " and " (map (showA . snd) lst) <> ".",
-      "  You could add more types inside the term, or write:"
-    ]
-      <> ["  " <> writeBind e | (_, e) <- lst]
+  Errors
+    . pure
+    . CTXE (origin o)
+    . T.unlines
+    $ [ "An ambiguity arises in type checking. Be more specific in the terms ",
+        "  " <> T.intercalate " and " (map (showA . snd) lst) <> ".",
+        "  You could add more types inside the term, or write:"
+      ]
+    <> ["  " <> writeBind e | (_, e) <- lst]
 
 mustBeValidNamePart :: Origin -> Text1 -> Guarded NamePart
 mustBeValidNamePart orig t1 =
-  Errors . pure . CTXE orig . T.unlines $
-    [ "A single word is expected as name, which must start with a letter and may contain only alphanumerical letters, digits and underscore.",
-      "  the following was found: `" <> tshow t1 <> "`."
-    ]
+  Errors
+    . pure
+    . CTXE orig
+    . T.unlines
+    $ [ "A single word is expected as name, which must start with a letter and may contain only alphanumerical letters, digits and underscore.",
+        "  the following was found: `" <> tshow t1 <> "`."
+      ]
 
 writeBind :: Expression -> Text
 writeBind (ECpl e) =
@@ -644,8 +693,8 @@ instance Traced Warning where
 
 mkBoxRowsnhWarning :: Origin -> Warning
 mkBoxRowsnhWarning orig =
-  Warning orig $
-    T.intercalate
+  Warning orig
+    $ T.intercalate
       "\n   "
       [ "The common use of BOX <ROWSNH> has become obsolete. It was used to be able",
         "to have rows without header.",
@@ -657,8 +706,8 @@ mkBoxRowsnhWarning orig =
 
 mkNoBoxItemsWarning :: Origin -> Warning
 mkNoBoxItemsWarning orig =
-  Warning orig $
-    T.intercalate
+  Warning orig
+    $ T.intercalate
       "\n    "
       [ "This list of BOX-items is empty."
       ]
@@ -668,8 +717,8 @@ mkCrudWarning (P_Cruds o _) msg = Warning o (T.unlines msg)
 
 mkCaseProblemWarning :: (Typeable a, Named a) => a -> a -> Warning
 mkCaseProblemWarning x y =
-  Warning OriginUnknown $
-    T.intercalate
+  Warning OriginUnknown
+    $ T.intercalate
       "\n    "
       [ "Ampersand is case sensitive. you might have meant that the following are equal:",
         tshow (typeOf x) <> " `" <> fullName x <> "` and `" <> fullName y <> "`."
@@ -694,7 +743,7 @@ data Guarded a
 
 --   deriving Show
 
-instance Eq a => Eq (Guarded a) where
+instance (Eq a) => Eq (Guarded a) where
   Checked a1 _ == Checked a2 _ = a1 == a2
   _ == _ = False
 
@@ -714,7 +763,7 @@ instance Monad Guarded where
   (>>=) (Errors x) _ = Errors x
 
 -- Shorthand for working with Guarded in a monad
-whenCheckedM :: Monad m => m (Guarded a) -> (a -> m (Guarded b)) -> m (Guarded b)
+whenCheckedM :: (Monad m) => m (Guarded a) -> (a -> m (Guarded b)) -> m (Guarded b)
 whenCheckedM ioGA fIOGB =
   do
     gA <- ioGA
@@ -726,7 +775,8 @@ whenCheckedM ioGA fIOGB =
 
 showFullOrig :: Origin -> Text
 showFullOrig (FileLoc (FilePos filename line column) t) =
-  "Error at symbol " <> t
+  "Error at symbol "
+    <> t
     <> " in file "
     <> T.pack filename
     <> " at line "
diff --git a/src/Ampersand/Input/ADL1/LexerTexts.hs b/src/Ampersand/Input/ADL1/LexerTexts.hs
index 12c5d3c6a..7c6157ec5 100644
--- a/src/Ampersand/Input/ADL1/LexerTexts.hs
+++ b/src/Ampersand/Input/ADL1/LexerTexts.hs
@@ -104,7 +104,7 @@ lexerNonTerminatedString =
 
 -- | Translates 'Close bracket but no open bracket' into the chosen language
 lexerTooManyClose ::
-  Show a =>
+  (Show a) =>
   a ->
   -- | The translated string
   String
diff --git a/src/Ampersand/Input/ADL1/LexerToken.hs b/src/Ampersand/Input/ADL1/LexerToken.hs
index 2c665c3b8..38ddedbfd 100644
--- a/src/Ampersand/Input/ADL1/LexerToken.hs
+++ b/src/Ampersand/Input/ADL1/LexerToken.hs
@@ -97,7 +97,7 @@ lexemeText l = case l of
   LexDateTime val -> tshow val
   LexDate val -> tshow val
 
-toBase :: Integral a => Show a => a -> a -> String
+toBase :: (Integral a) => (Show a) => a -> a -> String
 toBase b x = conv x ""
   where
     conv 0 str = str
diff --git a/src/Ampersand/Input/ADL1/ParsingLib.hs b/src/Ampersand/Input/ADL1/ParsingLib.hs
index 036e450be..cf10c931b 100644
--- a/src/Ampersand/Input/ADL1/ParsingLib.hs
+++ b/src/Ampersand/Input/ADL1/ParsingLib.hs
@@ -291,7 +291,8 @@ pName typ =
       mkName typ . NE.reverse $ nm NE.:| reverse ns
     localNamePart :: AmpParser NamePart
     localNamePart =
-      buildNamePart <$> currPos
+      buildNamePart
+        <$> currPos
         <*> case typ of
           ConceptName -> pUpperCaseID
           ContextName -> pUpperCaseID
@@ -307,10 +308,11 @@ pName typ =
           ViewName -> pUnrestrictedID
     namespacePart :: AmpParser NamePart
     namespacePart =
-      try $
-        buildNamePart <$> currPos
-          <*> pUnrestrictedID
-          <* pDot
+      try
+        $ buildNamePart
+        <$> currPos
+        <*> pUnrestrictedID
+        <* pDot
     buildNamePart :: Origin -> Text1 -> NamePart
     buildNamePart orig txt1 = case toNamePart1 txt1 of
       Nothing -> fatal $ "An unrestrictedID should be a valid namepart, but it isn't: " <> tshow txt1 <> "\n   " <> tshow orig
@@ -348,11 +350,11 @@ pCrudString =
   where
     testCrud :: Text1 -> Maybe Text1
     testCrud (Text1 h tl) =
-      if and $
-        [ not (null s),
-          L.nub caps == caps
-        ]
-          ++ map (`elem` ['C', 'R', 'U', 'D']) caps
+      if and
+        $ [ not (null s),
+            L.nub caps == caps
+          ]
+        ++ map (`elem` ['C', 'R', 'U', 'D']) caps
         then Just (Text1 h tl)
         else Nothing
       where
@@ -377,12 +379,18 @@ pAtomValInPopulation :: Bool -> AmpParser Value
 -- the user can lift the constraints by embeding the value in curly brackets. In
 -- such a case, the user could use a negative number as a singleton term.
 pAtomValInPopulation constrainsApply =
-  VBoolean True <$ pKey (toText1Unsafe "TRUE")
-    <|> VBoolean False <$ pKey (toText1Unsafe "FALSE")
-    <|> VRealString <$> pDoubleQuotedString
-    <|> VDateTime <$> pUTCTime
-    <|> VDate <$> pDay
-    <|> fromNumeric <$> (if constrainsApply then pUnsignedNumeric else pNumeric) -- Motivated in issue #713
+  VBoolean True
+    <$ pKey (toText1Unsafe "TRUE")
+    <|> VBoolean False
+    <$ pKey (toText1Unsafe "FALSE")
+    <|> VRealString
+    <$> pDoubleQuotedString
+    <|> VDateTime
+    <$> pUTCTime
+    <|> VDate
+    <$> pDay
+    <|> fromNumeric
+    <$> (if constrainsApply then pUnsignedNumeric else pNumeric) -- Motivated in issue #713
   where
     fromNumeric :: Either Int Double -> Value
     fromNumeric num = case num of
@@ -431,8 +439,10 @@ pIsNeg :: AmpParser Bool
 pIsNeg =
   fromMaybe False
     <$> pMaybe
-      ( True <$ pDash
-          <|> False <$ pPlus
+      ( True
+          <$ pDash
+          <|> False
+          <$ pPlus
       )
 
 pUnsignedNumeric :: AmpParser (Either Int Double)
@@ -477,14 +487,14 @@ pChevrons parser = pSpec '<' *> parser <* pSpec '>'
 -- Token positioning
 -----------------------------------------------------------
 
-posOrigin :: Show a => a -> SourcePos -> Origin
+posOrigin :: (Show a) => a -> SourcePos -> Origin
 posOrigin sym p = FileLoc (FilePos (sourceName p) (sourceLine p) (sourceColumn p)) (tshow sym)
 
 currPos :: AmpParser Origin
 currPos = posOf $ return ()
 
-posOf :: Show a => AmpParser a -> AmpParser Origin
+posOf :: (Show a) => AmpParser a -> AmpParser Origin
 posOf parser = do pos <- getPosition; a <- parser; return (posOrigin a pos)
 
-valPosOf :: Show a => AmpParser a -> AmpParser (a, Origin)
+valPosOf :: (Show a) => AmpParser a -> AmpParser (a, Origin)
 valPosOf parser = do pos <- getPosition; a <- parser; return (a, posOrigin a pos)
diff --git a/src/Ampersand/Input/PreProcessor.hs b/src/Ampersand/Input/PreProcessor.hs
index c483b447e..b062390e0 100644
--- a/src/Ampersand/Input/PreProcessor.hs
+++ b/src/Ampersand/Input/PreProcessor.hs
@@ -143,7 +143,8 @@ preProcPrefix = whitespace *> string "--" *> many (char '-') *> whitespace *> ch
 
 ifGuard :: Lexer LexLine
 ifGuard =
-  IfStart . Guard
+  IfStart
+    . Guard
     <$> ( try (string "IF")
             *> whitespace
             *> some alphaNum
@@ -152,7 +153,8 @@ ifGuard =
 
 ifNotGuard :: Lexer LexLine
 ifNotGuard =
-  IfNotStart . Guard
+  IfNotStart
+    . Guard
     <$> ( try (string "IFNOT")
             *> whitespace
             *> some alphaNum
@@ -185,14 +187,14 @@ type Block = [BlockElem]
 -- The first BOOL here determines whether this is an IF or IFNOT block
 data GuardedBlock
   = GuardedBlock
+      -- | This covers whether this is an IF or an IFNOT block. True for IF, false for IFNOT.
       Bool
-      -- ^ This covers whether this is an IF or an IFNOT block. True for IF, false for IFNOT.
+      -- | The guard of the IF or IFNOT
       Guard
-      -- ^ The guard of the IF or IFNOT
+      -- | The actual Block
       Block
-      -- ^ The actual Block
+      -- | An optional ELSE block.
       (Maybe Block)
-      -- ^ An optional ELSE block.
 
 {- (Note that there is a difference between Maybe [] and Nothing here.
 The first represents and empty ELSE block, the second an absent block.
diff --git a/src/Ampersand/Misc/HasClasses.hs b/src/Ampersand/Misc/HasClasses.hs
index 91d5d191b..a6ca2aee3 100644
--- a/src/Ampersand/Misc/HasClasses.hs
+++ b/src/Ampersand/Misc/HasClasses.hs
@@ -10,10 +10,10 @@ import qualified RIO.List as L
 import qualified RIO.Text as T
 
 class HasOptions a where
-  showOptions :: HasLogFunc env => a -> RIO env ()
+  showOptions :: (HasLogFunc env) => a -> RIO env ()
   showOptions opts = mapM_ showOpt . L.sortOn fst . optsList $ opts
     where
-      showOpt :: HasLogFunc env => (Text, Text) -> RIO env ()
+      showOpt :: (HasLogFunc env) => (Text, Text) -> RIO env ()
       showOpt (key, value) =
         logDebug . display $ key <> " " <> value
   optsList :: a -> [(Text, Text)] -- A tuple containing the 'key' and the value of the options.
@@ -22,7 +22,7 @@ class HasOptions a where
 instance (HasOptions a, HasOptions b) => HasOptions (a, b) where
   optsList (a, b) = optsList a <> optsList b
 
---instance (HasOptions a, Foldable f, Functor f) => HasOptions (f a) where
+-- instance (HasOptions a, Foldable f, Functor f) => HasOptions (f a) where
 --  optsList xs = concat . toList . fmap optsList $ xs
 
 class HasFSpecGenOpts a where
@@ -73,7 +73,7 @@ instance HasFSpecGenOpts DaemonOpts where
 instance HasFSpecGenOpts ProtoOpts where
   fSpecGenOptsL = lens x1fSpecGenOpts (\x y -> x {x1fSpecGenOpts = y})
 
-class HasProtoOpts a => HasDirPrototype a where
+class (HasProtoOpts a) => HasDirPrototype a where
   dirPrototypeL :: Lens' a (Maybe FilePath)
   getTemplateDir :: a -> FilePath
   getTemplateDir x =
@@ -135,7 +135,7 @@ class HasRootFile a where
   dirSource :: a -> FilePath -- the directory of the script that is being compiled
   dirSource = takeDirectory . baseName
 
-instance HasFSpecGenOpts a => HasRootFile a where
+instance (HasFSpecGenOpts a) => HasRootFile a where
   rootFileL = fSpecGenOptsL . lens xrootFile (\x y -> x {xrootFile = y})
 
 class HasOutputLanguage a where
@@ -153,13 +153,13 @@ instance HasOutputLanguage UmlOpts where
 class HasShowWarnings a where
   showWarningsL :: Lens' a Bool -- Should warnings be given to the output?
 
-instance HasDaemonOpts a => HasShowWarnings a where
+instance (HasDaemonOpts a) => HasShowWarnings a where
   showWarningsL = daemonOptsL . lens xshowWarnings (\x y -> x {xshowWarnings = y})
 
 class HasDirOutput a where
   dirOutputL :: Lens' a FilePath -- the directory to generate the output in.
 
-class HasOutputLanguage a => HasDocumentOpts a where
+class (HasOutputLanguage a) => HasDocumentOpts a where
   documentOptsL :: Lens' a DocOpts
   chaptersL :: Lens' a [Chapter]
   chaptersL = documentOptsL . lens xchapters (\x y -> x {xchapters = y})
@@ -269,7 +269,7 @@ data Recipe
   deriving (Show, Enum, Bounded)
 
 data FSpecGenOpts = FSpecGenOpts
-  { xrootFile :: !Roots, --relative paths. Must be set the first time it is read.
+  { xrootFile :: !Roots, -- relative paths. Must be set the first time it is read.
     xsqlBinTables :: !Bool,
     xgenInterfaces :: !Bool, --
     xnamespace :: !Text, -- prefix database identifiers with this namespace, to isolate namespaces within the same database.
@@ -325,13 +325,13 @@ data FrontendVersion = Angular | AngularJS
 
 -- | Options for @ampersand export@.
 newtype ExportOpts = ExportOpts
-  { xexport2adl :: FilePath --relative path
+  { xexport2adl :: FilePath -- relative path
   }
 
 -- | Options for @ampersand dataAnalysis@ and @ampersand export@.
 data InputOutputOpts = InputOutputOpts
   { x4fSpecGenOpts :: !FSpecGenOpts,
-    x4outputFile :: !FilePath --relative path
+    x4outputFile :: !FilePath -- relative path
   }
 
 instance HasOptions InputOutputOpts where
@@ -471,7 +471,7 @@ instance HasOptions ValidateOpts where
 data DevOutputOpts = DevOutputOpts
   { -- | Options required to build the fSpec
     x8fSpecGenOpts :: !FSpecGenOpts,
-    x5outputFile :: !FilePath --relative path
+    x5outputFile :: !FilePath -- relative path
   }
   deriving (Show)
 
@@ -482,7 +482,7 @@ instance HasOptions DevOutputOpts where
          ]
 
 newtype TestOpts = TestOpts
-  { rootTestDir :: FilePath --relative path to directory containing test scripts
+  { rootTestDir :: FilePath -- relative path to directory containing test scripts
   }
   deriving (Show)
 
diff --git a/src/Ampersand/Options/DocOptsParser.hs b/src/Ampersand/Options/DocOptsParser.hs
index c7640da46..cfd6b1561 100644
--- a/src/Ampersand/Options/DocOptsParser.hs
+++ b/src/Ampersand/Options/DocOptsParser.hs
@@ -37,30 +37,30 @@ docOptsParser =
       where
         build intro sharedlang diagnosis conceptualanalysis dataanalysis
           | length x /= length [c :: Chapter | c <- [minBound ..]] =
-            --To fix this: make sure all chapters are handled in this function.
-            fatal "Not all chapters are implemented thru options."
+              -- To fix this: make sure all chapters are handled in this function.
+              fatal "Not all chapters are implemented thru options."
           | otherwise = case both (fmap fst) . L.partition isTrue . filter (isJust . snd) $ x of
-            ([], []) -> [minBound ..]
-            (xs, []) -> xs -- Only explicit requested chapters
-            ([], ys) -> case [minBound ..] L.\\ ys of
-              [] ->
-                exitWith $
-                  PosAndNegChaptersSpecified
-                    ["Are you kidding? do you realy want an empty document?"]
-              cs -> cs -- All chapters exept ys
-            (xs, ys) ->
-              let otherChapters = ([minBound ..] L.\\ xs) L.\\ ys
-               in if null otherChapters
-                    then xs
-                    else
-                      exitWith $
-                        PosAndNegChaptersSpecified
-                          [ "It is unclear what chapters you want in your document.",
-                            "  You want: " <> (T.intercalate ", " . map tshow $ xs),
-                            "  You don't want: " <> (T.intercalate ", " . map tshow $ ys),
-                            "  What about the other chapters: " <> (T.intercalate ", " . map tshow $ otherChapters) <> " ?",
-                            "  Please don't mix `--no-<chapter>` with `--<chapter>`."
-                          ]
+              ([], []) -> [minBound ..]
+              (xs, []) -> xs -- Only explicit requested chapters
+              ([], ys) -> case [minBound ..] L.\\ ys of
+                [] ->
+                  exitWith
+                    $ PosAndNegChaptersSpecified
+                      ["Are you kidding? do you realy want an empty document?"]
+                cs -> cs -- All chapters exept ys
+              (xs, ys) ->
+                let otherChapters = ([minBound ..] L.\\ xs) L.\\ ys
+                 in if null otherChapters
+                      then xs
+                      else
+                        exitWith
+                          $ PosAndNegChaptersSpecified
+                            [ "It is unclear what chapters you want in your document.",
+                              "  You want: " <> (T.intercalate ", " . map tshow $ xs),
+                              "  You don't want: " <> (T.intercalate ", " . map tshow $ ys),
+                              "  What about the other chapters: " <> (T.intercalate ", " . map tshow $ otherChapters) <> " ?",
+                              "  Please don't mix `--no-<chapter>` with `--<chapter>`."
+                            ]
           where
             x = [intro, sharedlang, diagnosis, conceptualanalysis, dataanalysis]
 
@@ -82,7 +82,8 @@ docOptsParser =
 
     fSpecFormatP :: Parser FSpecFormat
     fSpecFormatP =
-      toFormat . T.pack
+      toFormat
+        . T.pack
         <$> strOption
           ( long "format"
               <> metavar "FORMAT"
@@ -95,15 +96,15 @@ docOptsParser =
           -- FIXME: The fatals here should be plain parse errors. Not sure yet how that should be done.
           --        See https://hackage.haskell.org/package/optparse-applicative
           [] ->
-            fatal $
-              T.unlines
+            fatal
+              $ T.unlines
                 [ "No matching formats found. Possible formats are:",
                   "  " <> T.intercalate ", " (map stripF allFormats)
                 ]
           [f] -> f
           xs ->
-            fatal $
-              T.unlines
+            fatal
+              $ T.unlines
                 [ "Ambiguous format specified. Possible matches are:",
                   "  " <> T.intercalate ", " (map stripF xs)
                 ]
diff --git a/src/Ampersand/Options/FSpecGenOptsParser.hs b/src/Ampersand/Options/FSpecGenOptsParser.hs
index 728afd03c..02f116097 100644
--- a/src/Ampersand/Options/FSpecGenOptsParser.hs
+++ b/src/Ampersand/Options/FSpecGenOptsParser.hs
@@ -100,7 +100,8 @@ fSpecGenOptsParser isForDaemon =
 
     knownRecipeP :: Parser Recipe
     knownRecipeP =
-      toKnownRecipe . T.pack
+      toKnownRecipe
+        . T.pack
         <$> strOption
           ( long "build-recipe"
               <> metavar "RECIPE"
@@ -120,16 +121,16 @@ fSpecGenOptsParser isForDaemon =
           -- TODO: The fatals here should be plain parse errors. Not sure yet how that should be done.
           --       See https://hackage.haskell.org/package/optparse-applicative
           [] ->
-            fatal $
-              T.unlines
+            fatal
+              $ T.unlines
                 [ "No matching recipe found. Possible recipes are:",
                   "  " <> T.intercalate ", " (map tshow allKnownRecipes),
                   "  You specified: `" <> s <> "`"
                 ]
           [f] -> f
           xs ->
-            fatal $
-              T.unlines
+            fatal
+              $ T.unlines
                 [ "Ambiguous recipe specified. Possible matches are:",
                   "  " <> T.intercalate ", " (map tshow xs)
                 ]
diff --git a/src/Ampersand/Options/GlobalParser.hs b/src/Ampersand/Options/GlobalParser.hs
index 75f51616e..f9a257875 100644
--- a/src/Ampersand/Options/GlobalParser.hs
+++ b/src/Ampersand/Options/GlobalParser.hs
@@ -7,17 +7,17 @@ import Ampersand.Basics
 import Ampersand.Options.LogLevelParser
 import Ampersand.Options.Utils
 import Ampersand.Types.Config
---import           Control.Monad.Trans.Except
---import           Control.Monad.Trans.Writer
+-- import           Control.Monad.Trans.Except
+-- import           Control.Monad.Trans.Writer
 
 import Data.Monoid (First (..)) -- , Any (..), Sum (..), Endo (..))
---import           Options.Applicative.Builder.Internal
---import           Options.Applicative.Help (errorHelp, stringChunk, vcatChunks)
---import           Options.Applicative.Types
---import qualified RIO.List as L
---import qualified System.Directory as D
---import           System.Environment (getProgName, getArgs, withArgs)
---import           System.FilePath (isValid, pathSeparator, takeDirectory)
+-- import           Options.Applicative.Builder.Internal
+-- import           Options.Applicative.Help (errorHelp, stringChunk, vcatChunks)
+-- import           Options.Applicative.Types
+-- import qualified RIO.List as L
+-- import qualified System.Directory as D
+-- import           System.Environment (getProgName, getArgs, withArgs)
+-- import           System.FilePath (isValid, pathSeparator, takeDirectory)
 import Generics.Deriving.Monoid (mappenddefault, memptydefault)
 import Options.Applicative
 import Options.Applicative.Builder.Extra
@@ -87,7 +87,7 @@ globalOptsParser _currentDir defLogLevel =
     hide0 = False
 
 -- | Create GlobalOpts from GlobalOptsMonoid.
-globalOptsFromMonoid :: MonadIO m => Bool -> FilePath -> GlobalOptsMonoid -> m GlobalOpts
+globalOptsFromMonoid :: (MonadIO m) => Bool -> FilePath -> GlobalOptsMonoid -> m GlobalOpts
 globalOptsFromMonoid defaultTerminal defaultOutputDir GlobalOptsMonoid {..} = do
   --  resolver <- for (getFirst globalMonoidResolver) $ \ur -> do
   --    root <-
diff --git a/src/Ampersand/Options/LogLevelParser.hs b/src/Ampersand/Options/LogLevelParser.hs
index 9cc7371bc..2a617ad71 100644
--- a/src/Ampersand/Options/LogLevelParser.hs
+++ b/src/Ampersand/Options/LogLevelParser.hs
@@ -20,7 +20,8 @@ logLevelOptsParser hide defLogLevel =
     )
     <|> flag'
       (Just verboseLevel)
-      ( short 'v' <> long "verbose"
+      ( short 'v'
+          <> long "verbose"
           <> help ("Enable verbose mode: verbosity level \"" <> showLevel verboseLevel <> "\"")
           <> hideMods hide
       )
diff --git a/src/Ampersand/Options/PopulationOptsParser.hs b/src/Ampersand/Options/PopulationOptsParser.hs
index e9142e60c..32d64c721 100644
--- a/src/Ampersand/Options/PopulationOptsParser.hs
+++ b/src/Ampersand/Options/PopulationOptsParser.hs
@@ -11,11 +11,12 @@ populationOptsParser :: Parser PopulationOpts
 populationOptsParser =
   PopulationOpts
     <$> fSpecGenOptsParser False
-      <*> outputFormatP
+    <*> outputFormatP
 
 outputFormatP :: Parser PopulationOutputFormat
 outputFormatP =
-  toFormat . T.pack
+  toFormat
+    . T.pack
     <$> strOption
       ( long "output-format"
           <> metavar "FORMAT"
@@ -35,16 +36,16 @@ outputFormatP =
       -- FIXME: The fatals here should be plain parse errors. Not sure yet how that should be done.
       --        See https://hackage.haskell.org/package/optparse-applicative
       [] ->
-        fatal $
-          T.unlines
+        fatal
+          $ T.unlines
             [ "No matching recipe found. Possible recipes are:",
               "  " <> T.intercalate ", " (map tshow allformats),
               "  You specified: `" <> s <> "`"
             ]
       [f] -> f
       xs ->
-        fatal $
-          T.unlines
+        fatal
+          $ T.unlines
             [ "Ambiguous recipe specified. Possible matches are:",
               "  " <> T.intercalate ", " (map tshow xs)
             ]
diff --git a/src/Ampersand/Options/UmlOptsParser.hs b/src/Ampersand/Options/UmlOptsParser.hs
index cfb3d0933..31db0ae36 100644
--- a/src/Ampersand/Options/UmlOptsParser.hs
+++ b/src/Ampersand/Options/UmlOptsParser.hs
@@ -11,4 +11,4 @@ umlOptsParser :: Parser UmlOpts
 umlOptsParser =
   UmlOpts
     <$> fSpecGenOptsParser False
-      <*> outputLanguageP
+    <*> outputLanguageP
diff --git a/src/Ampersand/Output/FSpec2Pandoc.hs b/src/Ampersand/Output/FSpec2Pandoc.hs
index 62bd2d398..3f750c288 100644
--- a/src/Ampersand/Output/FSpec2Pandoc.hs
+++ b/src/Ampersand/Output/FSpec2Pandoc.hs
@@ -8,49 +8,49 @@ import qualified RIO.Text as T
 import RIO.Time
 import Text.Pandoc.CrossRef
 
---DESCR ->
---The functional design document starts with an introduction
---The second chapter defines the functionality of the system for stakeholders.
---Because we assume these stakeholders to speak the language of the primary process without any technical knowledge,
---the second chapter contains natural language only.
---The third chapter is intended for the analyst. It contains all the rules mentioned in
---natural language in the second chapter. It presents the trace from natural language
---to the formal rule.
---The fourth chapter presents a datamodel together with all the property rules.
+-- DESCR ->
+-- The functional design document starts with an introduction
+-- The second chapter defines the functionality of the system for stakeholders.
+-- Because we assume these stakeholders to speak the language of the primary process without any technical knowledge,
+-- the second chapter contains natural language only.
+-- The third chapter is intended for the analyst. It contains all the rules mentioned in
+-- natural language in the second chapter. It presents the trace from natural language
+-- to the formal rule.
+-- The fourth chapter presents a datamodel together with all the property rules.
 -- by datasets and rules.
---Datasets are specified through PLUGS in Ampersand. The dataset is build around one concept,
---also called the theme. Functionalities defined on the theme by one or more plugs are
---described together with the rules that apply to the dataset. Rules not described by
---the dataset are described in the last section of chapter 2.
---The following chapters each present one INTERFACE
---The specification end with a glossary.
+-- Datasets are specified through PLUGS in Ampersand. The dataset is build around one concept,
+-- also called the theme. Functionalities defined on the theme by one or more plugs are
+-- described together with the rules that apply to the dataset. Rules not described by
+-- the dataset are described in the last section of chapter 2.
+-- The following chapters each present one INTERFACE
+-- The specification end with a glossary.
 
---TODO: Invent a syntax for meta information that is included in the source file...
+-- TODO: Invent a syntax for meta information that is included in the source file...
 
---The following general requirements apply to the functional design document:
---Descriptive title, number, identifier, etc. of the specification
---Date of last effective revision and revision designation
---A logo (trademark recommended) to declare the document copyright, ownership and origin
---Table of Contents
---Person, office, or agency responsible for questions on the specification, updates, and deviations.
---The significance, scope or importance of the specification and its intended use.
---Terminology, definitions and abbreviations to clarify the meanings of the specification
---Test methods for measuring all specified characteristics
---Material requirements: physical, mechanical, electrical, chemical, etc. Targets and tolerances.
---Performance testing requirements. Targets and tolerances.
---Drawings, photographs, or technical illustrations
---Workmanship
---Certifications required.
---Safety considerations and requirements
---Environmental considerations and requirements
---Quality control requirements, Sampling (statistics), inspections, acceptance criteria
---Person, office, or agency responsible for enforcement of the specification.
---Completion and delivery.
---Provisions for rejection, reinspection, rehearing, corrective measures
---References and citations for which any instructions in the content maybe required to fulfill the traceability and clarity of the document
---Signatures of approval, if necessary
---Change record to summarize the chronological development, revision and completion if the document is to be circulated internally
---Annexes and Appendices that are expand details, add clarification, or offer options.
+-- The following general requirements apply to the functional design document:
+-- Descriptive title, number, identifier, etc. of the specification
+-- Date of last effective revision and revision designation
+-- A logo (trademark recommended) to declare the document copyright, ownership and origin
+-- Table of Contents
+-- Person, office, or agency responsible for questions on the specification, updates, and deviations.
+-- The significance, scope or importance of the specification and its intended use.
+-- Terminology, definitions and abbreviations to clarify the meanings of the specification
+-- Test methods for measuring all specified characteristics
+-- Material requirements: physical, mechanical, electrical, chemical, etc. Targets and tolerances.
+-- Performance testing requirements. Targets and tolerances.
+-- Drawings, photographs, or technical illustrations
+-- Workmanship
+-- Certifications required.
+-- Safety considerations and requirements
+-- Environmental considerations and requirements
+-- Quality control requirements, Sampling (statistics), inspections, acceptance criteria
+-- Person, office, or agency responsible for enforcement of the specification.
+-- Completion and delivery.
+-- Provisions for rejection, reinspection, rehearing, corrective measures
+-- References and citations for which any instructions in the content maybe required to fulfill the traceability and clarity of the document
+-- Signatures of approval, if necessary
+-- Change record to summarize the chronological development, revision and completion if the document is to be circulated internally
+-- Annexes and Appendices that are expand details, add clarification, or offer options.
 
 fSpec2Pandoc ::
   (HasDirOutput env, HasDocumentOpts env) =>
@@ -91,7 +91,7 @@ fSpec2Pandoc env now fSpec = (thePandoc, thePictures)
               [ (str . l) (NL "hoofdstuk", EN "chapter"),
                 (str . l) (NL "hoofdstukken", EN "chapters")
               ]
-            <> cref True --required for pandoc-crossref to do its work properly
+            <> cref True -- required for pandoc-crossref to do its work properly
             <> chapters True -- Numbering with subnumbers per chapter
     thePandoc =
       wrap
@@ -118,7 +118,7 @@ fSpec2Pandoc env now fSpec = (thePandoc, thePictures)
                             )
                 )
                   <> (singleQuoted . text . fullName) fSpec
-              titles -> (text . T.concat . L.nub) titles --reduce doubles, for when multiple script files are included, this could cause titles to be mentioned several times.
+              titles -> (text . T.concat . L.nub) titles -- reduce doubles, for when multiple script files are included, this could cause titles to be mentioned several times.
           )
         . setAuthors
           ( case metaValues (toText1Unsafe "authors") fSpec of
@@ -128,7 +128,7 @@ fSpec2Pandoc env now fSpec = (thePandoc, thePictures)
                       EN "Specify authors in Ampersand with: META \"authors\" \"<author names>\""
                     )
                 ]
-              xs -> text <$> L.nub xs --reduce doubles, for when multiple script files are included, this could cause authors to be mentioned several times.
+              xs -> text <$> L.nub xs -- reduce doubles, for when multiple script files are included, this could cause authors to be mentioned several times.
           )
         . setDate (text (T.pack $ formatTime (lclForLang outputLang') "%-d %B %Y" now))
         . doc
diff --git a/src/Ampersand/Output/FSpec2SQL.hs b/src/Ampersand/Output/FSpec2SQL.hs
index 7a651f89b..96f37ac07 100644
--- a/src/Ampersand/Output/FSpec2SQL.hs
+++ b/src/Ampersand/Output/FSpec2SQL.hs
@@ -12,10 +12,10 @@ import qualified RIO.Text as T
 
 databaseStructureSql :: FSpec -> Text
 databaseStructureSql fSpec =
-  T.intercalate "\n" $
-    header (longVersion appVersion)
-      <> header "Database structure queries"
-      <> map (addSeparator . queryAsSQL) (generateDBstructQueries fSpec True)
+  T.intercalate "\n"
+    $ header (longVersion appVersion)
+    <> header "Database structure queries"
+    <> map (addSeparator . queryAsSQL) (generateDBstructQueries fSpec True)
 
 generateDBstructQueries :: FSpec -> Bool -> [SqlQuery]
 generateDBstructQueries fSpec withComment =
@@ -24,16 +24,16 @@ generateDBstructQueries fSpec withComment =
 
 dumpSQLqueries :: env -> FSpec -> Text
 dumpSQLqueries env fSpec =
-  T.intercalate "\n" $
-    header (longVersion appVersion)
-      <> header "Database structure queries"
-      <> map (addSeparator . queryAsSQL) (generateDBstructQueries fSpec True)
-      <> header "Violations of conjuncts"
-      <> concatMap showConjunct (allConjuncts fSpec)
-      <> header "Queries per relation"
-      <> concatMap showDecl (vrels fSpec)
-      <> header "Queries of interfaces"
-      <> concatMap showInterface y
+  T.intercalate "\n"
+    $ header (longVersion appVersion)
+    <> header "Database structure queries"
+    <> map (addSeparator . queryAsSQL) (generateDBstructQueries fSpec True)
+    <> header "Violations of conjuncts"
+    <> concatMap showConjunct (allConjuncts fSpec)
+    <> header "Queries per relation"
+    <> concatMap showDecl (vrels fSpec)
+    <> header "Queries of interfaces"
+    <> concatMap showInterface y
   where
     y :: [Interface]
     y = interfaceS fSpec <> interfaceG fSpec
@@ -81,7 +81,7 @@ header :: Text -> [Text]
 header title =
   [ "/*",
     T.replicate width "*",
-    "***" <> spaces firstspaces <> title <> spaces (width -6 - firstspaces - l) <> "***",
+    "***" <> spaces firstspaces <> title <> spaces (width - 6 - firstspaces - l) <> "***",
     T.replicate width "*",
     "*/"
   ]
diff --git a/src/Ampersand/Output/PandocAux.hs b/src/Ampersand/Output/PandocAux.hs
index 618fdee3a..b8d079360 100644
--- a/src/Ampersand/Output/PandocAux.hs
+++ b/src/Ampersand/Output/PandocAux.hs
@@ -36,81 +36,81 @@ import qualified Text.Pandoc.UTF8 as UTF8
 -- | Default key-value pairs for use with the Pandoc template
 defaultWriterVariables :: (HasDocumentOpts env) => env -> FSpec -> PT.Context Text -- [(Text , Text)]
 defaultWriterVariables env fSpec =
-  mkContext $
-    [ ( "title",
-        ( case (outputLang', view chaptersL env) of
-            (Dutch, [Diagnosis]) -> "Diagnose van "
-            (English, [Diagnosis]) -> "Diagnosis of "
-            (Dutch, [SharedLang]) -> "Taalmodel van "
-            (English, [SharedLang]) -> "Shared language of "
-            (Dutch, _) -> "Functioneel Ontwerp van "
-            (English, _) -> "Functional Design of "
-        )
-          <> fullName fSpec
-      ),
-      ("fontsize", "12pt"), --can be overridden by geometry package (see below)
-      ( "lang",
-        case outputLang' of
-          Dutch -> "nl-NL"
-          English -> "en-US"
-      ),
-      ("papersize", "a4"),
-      ( "babel-lang",
-        case outputLang' of
-          Dutch -> "dutch"
-          English -> "english"
-      ),
-      ("documentclass", "report")
-    ]
-      <> [("toc", "<<TheTableOfContentsShouldGoHere>>") | [Diagnosis] == view chaptersL env]
-      <> [ ( "header-includes",
-             T.unlines
-               [ "% ============Ampersand specific Begin=================",
-                 "% First a couple of LaTeX packages are included:",
-                 "",
-                 "% The glossaries package supports acronyms and multiple glossaries",
-                 "\\usepackage[toc]{glossaries}    % Add the glossaries to the table of contents",
-                 "% \\makeglossaries", -- Disabled because of warnings in LaTeX. TODO: Have to generate glossaries using Pandoc, not only for LaTeX.
-                 "",
-                 "% geometry provides a flexible and easy interface to page dimentions",
-                 "\\usepackage[ top=1.5cm, bottom=1.5cm, outer=5cm, inner=2cm",
-                 "            , heightrounded, footskip=.5cm",
-                 "            , marginparwidth=2.5cm, marginparsep=0.5cm]{geometry}",
-                 "",
-                 "% breqn – Automatic line breaking of displayed equations",
-                 "\\usepackage{breqn}",
-                 "",
-                 "% colonequals – Colon equals symbols",
-                 "\\usepackage{colonequals}",
-                 "",
-                 "% caption – Customising captions in floating environments",
-                 "\\usepackage{caption}",
-                 "\\captionsetup{format=plain",
-                 "              ,textfont=bf,labelfont=small",
-                 "              ,labelsep=none",
-                 "              ,labelformat=empty",
-                 "              ,width=.85\\textwidth",
-                 "              }",
-                 "",
-                 "% textcomp – LATEX support for the Text Companion fonts -- Disabled because obsolete.",
-                 "% \\usepackage{textcomp}",
-                 "",
-                 "% hypcap – Adjusting the anchors of captions",
-                 "\\usepackage[all]{hypcap}",
-                 "",
-                 "% <Adaptation>: The LaTeX commands \\[ and \\], are redefined in the amsmath package, making sure that equations are",
-                 "% not numbered. This is undesireable behaviour. this is fixed with the following hack, inspired on a note",
-                 "% found at http://tex.stackexchange.com/questions/40492/what-are-the-differences-between-align-equation-and-displaymath",
-                 "\\DeclareRobustCommand{\\[}{\\begin{equation}}",
-                 "\\DeclareRobustCommand{\\]}{\\end{equation}}",
-                 "% <End-adaptation>",
-                 "",
-                 "",
-                 "% ============Ampersand specific End==================="
-               ]
-           )
-           | view fspecFormatL env `elem` [Fpdf, Flatex]
-         ]
+  mkContext
+    $ [ ( "title",
+          ( case (outputLang', view chaptersL env) of
+              (Dutch, [Diagnosis]) -> "Diagnose van "
+              (English, [Diagnosis]) -> "Diagnosis of "
+              (Dutch, [SharedLang]) -> "Taalmodel van "
+              (English, [SharedLang]) -> "Shared language of "
+              (Dutch, _) -> "Functioneel Ontwerp van "
+              (English, _) -> "Functional Design of "
+          )
+            <> fullName fSpec
+        ),
+        ("fontsize", "12pt"), -- can be overridden by geometry package (see below)
+        ( "lang",
+          case outputLang' of
+            Dutch -> "nl-NL"
+            English -> "en-US"
+        ),
+        ("papersize", "a4"),
+        ( "babel-lang",
+          case outputLang' of
+            Dutch -> "dutch"
+            English -> "english"
+        ),
+        ("documentclass", "report")
+      ]
+    <> [("toc", "<<TheTableOfContentsShouldGoHere>>") | [Diagnosis] == view chaptersL env]
+    <> [ ( "header-includes",
+           T.unlines
+             [ "% ============Ampersand specific Begin=================",
+               "% First a couple of LaTeX packages are included:",
+               "",
+               "% The glossaries package supports acronyms and multiple glossaries",
+               "\\usepackage[toc]{glossaries}    % Add the glossaries to the table of contents",
+               "% \\makeglossaries", -- Disabled because of warnings in LaTeX. TODO: Have to generate glossaries using Pandoc, not only for LaTeX.
+               "",
+               "% geometry provides a flexible and easy interface to page dimentions",
+               "\\usepackage[ top=1.5cm, bottom=1.5cm, outer=5cm, inner=2cm",
+               "            , heightrounded, footskip=.5cm",
+               "            , marginparwidth=2.5cm, marginparsep=0.5cm]{geometry}",
+               "",
+               "% breqn – Automatic line breaking of displayed equations",
+               "\\usepackage{breqn}",
+               "",
+               "% colonequals – Colon equals symbols",
+               "\\usepackage{colonequals}",
+               "",
+               "% caption – Customising captions in floating environments",
+               "\\usepackage{caption}",
+               "\\captionsetup{format=plain",
+               "              ,textfont=bf,labelfont=small",
+               "              ,labelsep=none",
+               "              ,labelformat=empty",
+               "              ,width=.85\\textwidth",
+               "              }",
+               "",
+               "% textcomp – LATEX support for the Text Companion fonts -- Disabled because obsolete.",
+               "% \\usepackage{textcomp}",
+               "",
+               "% hypcap – Adjusting the anchors of captions",
+               "\\usepackage[all]{hypcap}",
+               "",
+               "% <Adaptation>: The LaTeX commands \\[ and \\], are redefined in the amsmath package, making sure that equations are",
+               "% not numbered. This is undesireable behaviour. this is fixed with the following hack, inspired on a note",
+               "% found at http://tex.stackexchange.com/questions/40492/what-are-the-differences-between-align-equation-and-displaymath",
+               "\\DeclareRobustCommand{\\[}{\\begin{equation}}",
+               "\\DeclareRobustCommand{\\]}{\\end{equation}}",
+               "% <End-adaptation>",
+               "",
+               "",
+               "% ============Ampersand specific End==================="
+             ]
+         )
+         | view fspecFormatL env `elem` [Fpdf, Flatex]
+       ]
   where
     outputLang' :: Lang
     outputLang' = outputLang env fSpec
@@ -120,7 +120,7 @@ defaultWriterVariables env fSpec =
         fun :: (Text, Text) -> (Text, PT.Val Text)
         fun (k, v) = (k, SimpleVal (Text (T.length v) v))
 
---DESCR -> functions to write the pandoc
+-- DESCR -> functions to write the pandoc
 writepandoc ::
   (HasDirOutput env, HasFSpecGenOpts env, HasDocumentOpts env, HasLogFunc env) =>
   FSpec ->
@@ -175,7 +175,9 @@ writepandoc' env fSpec thePandoc = liftIO . runIOorExplode $ do
         case res of
           Right pdf -> writeFnBinary (outputFile env) pdf
           Left err' ->
-            liftIO . throwIO . PandocPDFError
+            liftIO
+              . throwIO
+              . PandocPDFError
               . decodeUtf8
               . BL.toStrict
               $ err'
@@ -183,7 +185,7 @@ writepandoc' env fSpec thePandoc = liftIO . runIOorExplode $ do
         output <- runIO (f writerOptions thePandoc) >>= handleError
         writeFileUtf8 (outputFile env) output
   where
-    writer :: PandocMonad m => Writer m
+    writer :: (PandocMonad m) => Writer m
     writer = case lookup writerName writers of
       Nothing -> fatal $ "There is no such Pandoc writer: " <> writerName
       Just w -> w
@@ -194,7 +196,7 @@ writepandoc' env fSpec thePandoc = liftIO . runIOorExplode $ do
         FPandoc -> "native"
         Fhtml -> "html5"
         fmt -> T.toLower . T.drop 1 . tshow $ fmt
-    writeFnBinary :: MonadIO m => FilePath -> BL.ByteString -> m ()
+    writeFnBinary :: (MonadIO m) => FilePath -> BL.ByteString -> m ()
     writeFnBinary f bs = do
       liftIO $ createDirectoryIfMissing True (takeDirectory f)
       BL.writeFile (UTF8.encodePath f) bs
@@ -257,7 +259,7 @@ chptTitle lang cpt =
     l :: LocalizedStr -> Text
     l = localize lang
 
---DESCR -> pandoc print functions for Ampersand data structures
+-- DESCR -> pandoc print functions for Ampersand data structures
 ---------------------------------------
 -- LaTeX math markup
 ---------------------------------------
@@ -298,7 +300,7 @@ instance ShowMath Expression where
       showExpr (EDcI c) = "I_{ \\lbrack " <> (inMathText . fullName) c <> " \\rbrack }"
       showExpr EEps {} = "" -- fatal "EEps may occur only in combination with composition (semicolon)."  -- SJ 2014-03-11: Are we sure about this? Let's see if it ever occurs...
       showExpr (EDcV sgn) = "V_{ \\lbrack " <> (inMathText . fullName . source) sgn <> "*" <> (inMathText . fullName . target) sgn <> " \\rbrack }"
-      showExpr (EMp1 val _) = atomVal2Math val --"\texttt{"<>show val<>"}"
+      showExpr (EMp1 val _) = atomVal2Math val -- "\texttt{"<>show val<>"}"
 
 atomVal2Math :: PAtomValue -> Text
 atomVal2Math pav =
@@ -323,12 +325,14 @@ addParensToSuper e = e
 
 instance ShowMath Relation where
   showMath decl =
-    math . noBreaking $
-      (inMathText . fullName) decl <> " \\lbrack "
-        <> (inMathText . fullName . source) decl
-        <> (if isFunction (EDcD decl) then " \\mapsto " else "*")
-        <> (inMathText . fullName . target) decl
-        <> " \\rbrack "
+    math
+      . noBreaking
+      $ (inMathText . fullName) decl
+      <> " \\lbrack "
+      <> (inMathText . fullName . source) decl
+      <> (if isFunction (EDcD decl) then " \\mapsto " else "*")
+      <> (inMathText . fullName . target) decl
+      <> " \\rbrack "
 
 noBreaking :: (IsString a, Semigroup a) => a -> a
 noBreaking x = "{" <> x <> "}"
diff --git a/src/Ampersand/Output/ToJSON/JSONutils.hs b/src/Ampersand/Output/ToJSON/JSONutils.hs
index 832ddb911..8b401c221 100644
--- a/src/Ampersand/Output/ToJSON/JSONutils.hs
+++ b/src/Ampersand/Output/ToJSON/JSONutils.hs
@@ -72,7 +72,7 @@ ampersandDefault = defaultOptions {AT.fieldLabelModifier = alterLabel}
 
 -- | Replaces all instances of a value in a list by another value.
 replace ::
-  Eq a =>
+  (Eq a) =>
   -- | Value to look for
   a ->
   -- | Value to replace it with
diff --git a/src/Ampersand/Output/ToJSON/Rules.hs b/src/Ampersand/Output/ToJSON/Rules.hs
index 73b3f34f4..dddfc71db 100644
--- a/src/Ampersand/Output/ToJSON/Rules.hs
+++ b/src/Ampersand/Output/ToJSON/Rules.hs
@@ -113,5 +113,5 @@ instance JSON (Int, PairViewSegment Expression) JsonPairViewSegment where
           PairViewExp _ _ e -> Just . sqlQuery fSpec $ e,
         pvsJSONexpIsIdent = case pvs of
           PairViewText {} -> Nothing
-          PairViewExp _ _ e -> Just . isIdent $ e --show $ e
+          PairViewExp _ _ e -> Just . isIdent $ e -- show $ e
       }
diff --git a/src/Ampersand/Output/ToJSON/ToJson.hs b/src/Ampersand/Output/ToJSON/ToJson.hs
index 9c2753e8c..fb55068d3 100644
--- a/src/Ampersand/Output/ToJSON/ToJson.hs
+++ b/src/Ampersand/Output/ToJSON/ToJson.hs
@@ -51,7 +51,7 @@ rolesToJSON env fSpec = encodePretty'' (fromAmpersand env fSpec fSpec :: Roles)
 populationToJSON :: env -> FSpec -> BL.ByteString
 populationToJSON env fSpec = encodePretty'' (fromAmpersand env fSpec fSpec :: Populations)
 
-encodePretty'' :: ToJSON a => a -> BL.ByteString
+encodePretty'' :: (ToJSON a) => a -> BL.ByteString
 encodePretty'' =
   encodePretty'
     Config
diff --git a/src/Ampersand/Output/ToPandoc/ChapterConceptualAnalysis.hs b/src/Ampersand/Output/ToPandoc/ChapterConceptualAnalysis.hs
index 86ecd8240..ef196d501 100644
--- a/src/Ampersand/Output/ToPandoc/ChapterConceptualAnalysis.hs
+++ b/src/Ampersand/Output/ToPandoc/ChapterConceptualAnalysis.hs
@@ -70,48 +70,48 @@ chpConceptualAnalysis env lev fSpec =
           && null (dclsOfTheme themeContent)
           && null (rulesOfTheme themeContent)
           && null (idRulesOfTheme themeContent) =
-        mempty
+          mempty
       | otherwise =
-        --  *** Header of the theme: ***
-        (xDefBlck env fSpec . XRefSharedLangTheme . patOfTheme) themeContent
-          -- The section starts with the reason(s) why this pattern exist(s)
-          <> case patOfTheme themeContent of
-            Just pat -> purposes2Blocks env (purposesOf fSpec outputLang' pat)
-            Nothing -> mempty
-          -- followed by one subsection for every concept that is defined (by a CONCEPT statement) in this pattern, containing the purposes and definitions of that concept.
-          <> (mconcat . map (printConcept env (localize outputLang')) . cptsOfTheme) themeContent
-          -- At this point the reader gets a diagram with the classes and relations between those classes.
-          <> ( case (outputLang', patOfTheme themeContent) of
-                 (Dutch, Just pat) ->
-                   -- announce the conceptual diagram
-                   para (hyperLinkTo (pictOfPat pat) <> "Conceptueel diagram van " <> (singleQuoted . str . label) pat <> ".")
-                     -- draw the conceptual diagram
-                     <> (xDefBlck env fSpec . pictOfPat) pat
-                 (English, Just pat) ->
-                   para (hyperLinkTo (pictOfPat pat) <> "Conceptual diagram of " <> (singleQuoted . str . label) pat <> ".")
-                     <> (xDefBlck env fSpec . pictOfPat) pat
-                 (_, Nothing) -> mempty
-             )
-          -- Now we discuss the attributes of each entity (with sufficiently documented attributes) in one subsection
-          <> mconcat (map fst caSubsections)
-          -- Finally we discuss the remaining attributes (of smaller entities) and remaining relations
-          -- This list contains empty spots for relations without documentation.
-          <> caRemainingRelations
-          <> (
-               -- print the rules that are defined in this pattern.
-               case map caRule . toList $ invariants fSpec `Set.intersection` (Set.fromList . map (cRul . theLoad) . rulesOfTheme) themeContent of
-                 [] -> mempty
-                 blocks ->
-                   ( case outputLang' of
-                       Dutch ->
-                         header (lev + 3) "Regels"
-                           <> plain "Deze paragraaf geeft een opsomming van de regels met een verwijzing naar de gemeenschappelijke taal van de belanghebbenden ten behoeve van de traceerbaarheid."
-                       English ->
-                         header (lev + 3) "Rules"
-                           <> plain "This section itemizes the rules with a reference to the shared language of stakeholders for the sake of traceability."
-                   )
-                     <> definitionList blocks
-             )
+          --  *** Header of the theme: ***
+          (xDefBlck env fSpec . XRefSharedLangTheme . patOfTheme) themeContent
+            -- The section starts with the reason(s) why this pattern exist(s)
+            <> case patOfTheme themeContent of
+              Just pat -> purposes2Blocks env (purposesOf fSpec outputLang' pat)
+              Nothing -> mempty
+            -- followed by one subsection for every concept that is defined (by a CONCEPT statement) in this pattern, containing the purposes and definitions of that concept.
+            <> (mconcat . map (printConcept env (localize outputLang')) . cptsOfTheme) themeContent
+            -- At this point the reader gets a diagram with the classes and relations between those classes.
+            <> ( case (outputLang', patOfTheme themeContent) of
+                   (Dutch, Just pat) ->
+                     -- announce the conceptual diagram
+                     para (hyperLinkTo (pictOfPat pat) <> "Conceptueel diagram van " <> (singleQuoted . str . label) pat <> ".")
+                       -- draw the conceptual diagram
+                       <> (xDefBlck env fSpec . pictOfPat) pat
+                   (English, Just pat) ->
+                     para (hyperLinkTo (pictOfPat pat) <> "Conceptual diagram of " <> (singleQuoted . str . label) pat <> ".")
+                       <> (xDefBlck env fSpec . pictOfPat) pat
+                   (_, Nothing) -> mempty
+               )
+            -- Now we discuss the attributes of each entity (with sufficiently documented attributes) in one subsection
+            <> mconcat (map fst caSubsections)
+            -- Finally we discuss the remaining attributes (of smaller entities) and remaining relations
+            -- This list contains empty spots for relations without documentation.
+            <> caRemainingRelations
+            <> (
+                 -- print the rules that are defined in this pattern.
+                 case map caRule . toList $ invariants fSpec `Set.intersection` (Set.fromList . map (cRul . theLoad) . rulesOfTheme) themeContent of
+                   [] -> mempty
+                   blocks ->
+                     ( case outputLang' of
+                         Dutch ->
+                           header (lev + 3) "Regels"
+                             <> plain "Deze paragraaf geeft een opsomming van de regels met een verwijzing naar de gemeenschappelijke taal van de belanghebbenden ten behoeve van de traceerbaarheid."
+                         English ->
+                           header (lev + 3) "Rules"
+                             <> plain "This section itemizes the rules with a reference to the shared language of stakeholders for the sake of traceability."
+                     )
+                       <> definitionList blocks
+               )
       where
         -- all classes (i.e. entities) from this pattern
         themeClasses :: [Class]
@@ -219,7 +219,8 @@ chpConceptualAnalysis env lev fSpec =
                 (plain . l) (NL "Betekenis", EN "Meaning")
               ]
               ( [ [ (plain . text)
-                      ( label rel <> " "
+                      ( label rel
+                          <> " "
                           <> if null cls
                             then tshow (sign rel)
                             else localize outputLang' (NL " (Attribuut van ", EN " (Attribute of ") <> (T.concat . map fullName) cls <> ")"
diff --git a/src/Ampersand/Output/ToPandoc/ChapterDataAnalysis.hs b/src/Ampersand/Output/ToPandoc/ChapterDataAnalysis.hs
index cbb5b7577..06563ce47 100644
--- a/src/Ampersand/Output/ToPandoc/ChapterDataAnalysis.hs
+++ b/src/Ampersand/Output/ToPandoc/ChapterDataAnalysis.hs
@@ -3,7 +3,7 @@ module Ampersand.Output.ToPandoc.ChapterDataAnalysis (chpDataAnalysis) where
 import Ampersand.ADL1
 import Ampersand.FSpec.Crud
 import Ampersand.FSpec.ToFSpec.ADL2Plug
-import Ampersand.Graphic.ClassDiagram --(Class(..),CdAttribute(..))
+import Ampersand.Graphic.ClassDiagram -- (Class(..),CdAttribute(..))
 import Ampersand.Graphic.Fspec2ClassDiagrams
 import Ampersand.Output.ToPandoc.SharedAmongChapters
 import qualified RIO.List as L
@@ -12,7 +12,7 @@ import qualified RIO.Set as Set
 import qualified RIO.Text as T
 
 ------------------------------------------------------------
---DESCR -> the data analysis contains a section for each class diagram in the fSpec
+-- DESCR -> the data analysis contains a section for each class diagram in the fSpec
 --         the class diagram and property rules are printed
 chpDataAnalysis ::
   (HasDirOutput env, HasDocumentOpts env) =>
@@ -135,10 +135,11 @@ chpDataAnalysis env fSpec = (theBlocks, [])
     -- The second table contains all other concepts.
     conceptTables =
       legacyTable
-        ( text . l $
-            ( NL "Logische gegevensverzamelingen",
-              EN "Logical entity types"
-            )
+        ( text
+            . l
+            $ ( NL "Logische gegevensverzamelingen",
+                EN "Logical entity types"
+              )
         )
         [(AlignLeft, 2 / 8), (AlignLeft, 4 / 8), (AlignLeft, 1 / 8), (AlignLeft, 1 / 8)]
         [ (plain . text . l) (NL "Concept", EN "Concept"),
@@ -169,10 +170,11 @@ chpDataAnalysis env fSpec = (theBlocks, [])
                 $ concs fSpec
         ]
         <> legacyTable
-          ( text . l $
-              ( NL "Overige attributen",
-                EN "Other attributes"
-              )
+          ( text
+              . l
+              $ ( NL "Overige attributen",
+                  EN "Other attributes"
+                )
           )
           [(AlignLeft, 1 / 6), (AlignLeft, 4 / 6), (AlignLeft, 1 / 6)]
           [ (plain . text . l) (NL "Concept", EN "Concept"),
@@ -429,14 +431,15 @@ chpDataAnalysis env fSpec = (theBlocks, [])
     daRulesSection =
       mconcat
         [ header sectionLevel . text $ l (NL "Regels", EN "Rules"),
-          para . text $
-            l
-              ( NL $
-                  "Nu volgt een opsomming van alle regels door de term van elke regel af te drukken. "
-                    <> "Eerst worden de procesregels gegeven, vervolgens de invarianten.",
-                EN $
-                  "In this section an overview of all rules by printing the term of each rule. "
-                    <> "The process rules are given first, followed by the invariants."
+          para
+            . text
+            $ l
+              ( NL
+                  $ "Nu volgt een opsomming van alle regels door de term van elke regel af te drukken. "
+                  <> "Eerst worden de procesregels gegeven, vervolgens de invarianten.",
+                EN
+                  $ "In this section an overview of all rules by printing the term of each rule. "
+                  <> "The process rules are given first, followed by the invariants."
               ),
           docRules
             (NL "Procesregels", EN "Process rules")
@@ -465,11 +468,11 @@ chpDataAnalysis env fSpec = (theBlocks, [])
           if null rules
             then (para . text . l) noRules
             else
-              mconcat $
-                [ header (sectionLevel + 1) . text $ l title,
-                  para . text $ l intro
-                ]
-                  <> map (docRule heading) (toList rules)
+              mconcat
+                $ [ header (sectionLevel + 1) . text $ l title,
+                    para . text $ l intro
+                  ]
+                <> map (docRule heading) (toList rules)
 
         docRule :: LocalizedStr -> Rule -> Blocks
         docRule heading rule =
diff --git a/src/Ampersand/Output/ToPandoc/ChapterDiagnosis.hs b/src/Ampersand/Output/ToPandoc/ChapterDiagnosis.hs
index 29544aa76..5f1900f75 100644
--- a/src/Ampersand/Output/ToPandoc/ChapterDiagnosis.hs
+++ b/src/Ampersand/Output/ToPandoc/ChapterDiagnosis.hs
@@ -17,36 +17,36 @@ chpDiagnosis ::
 chpDiagnosis env fSpec
   | Diagnosis `notElem` view chaptersL env = mempty
   | otherwise =
-    ( xDefBlck env fSpec Diagnosis
-        <> para
-          ( (str . l)
-              ( NL "Dit hoofdstuk geeft een analyse van het Ampersand-script van ",
-                EN "This chapter provides an analysis of the Ampersand script of "
-              )
-              <> (emph . singleQuoted . str . fullName) fSpec
-              <> str ". "
-              <> (str . l)
-                ( NL $
-                    "Deze analyse is bedoeld voor de auteur(s) van dit script. "
+      ( xDefBlck env fSpec Diagnosis
+          <> para
+            ( (str . l)
+                ( NL "Dit hoofdstuk geeft een analyse van het Ampersand-script van ",
+                  EN "This chapter provides an analysis of the Ampersand script of "
+                )
+                <> (emph . singleQuoted . str . fullName) fSpec
+                <> str ". "
+                <> (str . l)
+                  ( NL
+                      $ "Deze analyse is bedoeld voor de auteur(s) van dit script. "
                       <> "Op basis hiervan kunnen zij het script completeren en mogelijke tekortkomingen verbeteren.",
-                  EN $
-                    "This analysis is intended for the author(s) of this script. "
+                    EN
+                      $ "This analysis is intended for the author(s) of this script. "
                       <> "It can be used to complete the script or to improve possible flaws."
-                )
-          )
-        <> roleomissions -- tells which role-rule, role-interface, and role-relation assignments are missing
-        <> roleRuleTable -- gives an overview of rule-rule assignments
-        <> missingConceptDefs -- tells which concept definitions have been declared without a purpose
-        <> missingRels -- tells which relations have been declared without a purpose and/or without a meaning
-        <> unusedConceptDefs -- tells which concept definitions are not used in any relation
-        <> relsNotUsed -- tells which relations are not used in any rule
-        <> missingRules -- tells which rule definitions are missing
-        <> ruleRelationRefTable -- table that shows percentages of relations and rules that have references
-        <> processrulesInPatterns --
-        <> wipReport -- sums up the work items (i.e. the violations of process rules)
-        <> violationReport, -- sums up the violations caused by the population of this script.
-      pics
-    )
+                  )
+            )
+          <> roleomissions -- tells which role-rule, role-interface, and role-relation assignments are missing
+          <> roleRuleTable -- gives an overview of rule-rule assignments
+          <> missingConceptDefs -- tells which concept definitions have been declared without a purpose
+          <> missingRels -- tells which relations have been declared without a purpose and/or without a meaning
+          <> unusedConceptDefs -- tells which concept definitions are not used in any relation
+          <> relsNotUsed -- tells which relations are not used in any rule
+          <> missingRules -- tells which rule definitions are missing
+          <> ruleRelationRefTable -- table that shows percentages of relations and rules that have references
+          <> processrulesInPatterns --
+          <> wipReport -- sums up the work items (i.e. the violations of process rules)
+          <> violationReport, -- sums up the violations caused by the population of this script.
+        pics
+      )
   where
     -- shorthand for easy localizing
     l :: LocalizedStr -> Text
@@ -56,67 +56,67 @@ chpDiagnosis env fSpec
     roleomissions
       | null (instanceList fSpec :: [Pattern]) = mempty
       | (null . fRoleRuls) fSpec && (not . null . vrules) fSpec =
-        plain
-          ( (emph . str . upCap . fullName) fSpec
-              <> (str . l)
-                ( NL " kent geen regels aan rollen toe. ",
-                  EN " does not assign rules to roles. "
-                )
-              <> (str . l)
-                ( NL "Een generieke rol, User, zal worden gedefinieerd om al het werk te doen wat in het bedrijfsproces moet worden uitgevoerd.",
-                  EN "A generic role, User, will be defined to do all the work that is necessary in the business process."
-                )
-          )
+          plain
+            ( (emph . str . upCap . fullName) fSpec
+                <> (str . l)
+                  ( NL " kent geen regels aan rollen toe. ",
+                    EN " does not assign rules to roles. "
+                  )
+                <> (str . l)
+                  ( NL "Een generieke rol, User, zal worden gedefinieerd om al het werk te doen wat in het bedrijfsproces moet worden uitgevoerd.",
+                    EN "A generic role, User, will be defined to do all the work that is necessary in the business process."
+                  )
+            )
       | otherwise = mempty
 
     roleRuleTable :: Blocks
     roleRuleTable
       | null ruls = mempty
       | null (fRoles fSpec) =
-        para
-          ( (emph . str . upCap . fullName) fSpec
-              <> (str . l)
-                ( NL " specificeert geen rollen. ",
-                  EN " does not define any roles. "
-                )
-          )
+          para
+            ( (emph . str . upCap . fullName) fSpec
+                <> (str . l)
+                  ( NL " specificeert geen rollen. ",
+                    EN " does not define any roles. "
+                  )
+            )
       | otherwise =
-        case filter (isSignal fSpec) . toList $ ruls of
-          [] ->
-            para
-              ( (emph . str . upCap . fullName) fSpec
-                  <> (str . l)
-                    ( NL " kent geen procesregels. ",
-                      EN " does not define any process rules. "
-                    )
-              )
-          sigs ->
-            para
-              ( (emph . str . upCap . fullName) fSpec
-                  <> (str . l)
-                    ( NL " kent regels aan rollen toe. ",
-                      EN " assigns rules to roles. "
-                    )
-                  <> (str . l)
-                    ( NL "De volgende tabel toont welke regels door een bepaalde rol worden bewaakt.",
-                      EN "The following table shows the rules that are being maintained by a given role."
-                    )
-              )
-              <> legacyTable -- No caption:
-                mempty
-                -- Alignment:
-                ( (AlignLeft, 0.4) :
-                  replicate (length . fRoles $ fSpec) (AlignLeft, 0.6 / (fromIntegral . length . fRoles $ fSpec))
+          case filter (isSignal fSpec) . toList $ ruls of
+            [] ->
+              para
+                ( (emph . str . upCap . fullName) fSpec
+                    <> (str . l)
+                      ( NL " kent geen procesregels. ",
+                        EN " does not define any process rules. "
+                      )
                 )
-                -- Header row:
-                ( (plain . str . l) (NL "Regel", EN "Rule") :
-                  map (plain . str . fullName . fst) (fRoles fSpec)
+            sigs ->
+              para
+                ( (emph . str . upCap . fullName) fSpec
+                    <> (str . l)
+                      ( NL " kent regels aan rollen toe. ",
+                        EN " assigns rules to roles. "
+                      )
+                    <> (str . l)
+                      ( NL "De volgende tabel toont welke regels door een bepaalde rol worden bewaakt.",
+                        EN "The following table shows the rules that are being maintained by a given role."
+                      )
                 )
-                -- Content rows:
-                [ (plain . str . label) rul :
-                    [f rol rul | (rol, _) <- fRoles fSpec]
-                  | rul <- sigs
-                ]
+                <> legacyTable -- No caption:
+                  mempty
+                  -- Alignment:
+                  ( (AlignLeft, 0.4)
+                      : replicate (length . fRoles $ fSpec) (AlignLeft, 0.6 / (fromIntegral . length . fRoles $ fSpec))
+                  )
+                  -- Header row:
+                  ( (plain . str . l) (NL "Regel", EN "Rule")
+                      : map (plain . str . fullName . fst) (fRoles fSpec)
+                  )
+                  -- Content rows:
+                  [ (plain . str . label) rul
+                      : [f rol rul | (rol, _) <- fRoles fSpec]
+                    | rul <- sigs
+                  ]
       where
         ruls = Set.filter (isSignal fSpec) . vrules $ fSpec
         f :: Role -> Rule -> Blocks
@@ -162,9 +162,9 @@ chpDiagnosis env fSpec
             )
       where
         missing =
-          L.nub $
-            [c | c <- ccs, null (purposesOf fSpec outputLang' c)]
-              <> [c | c <- ccs, null (concDefs fSpec c)]
+          L.nub
+            $ [c | c <- ccs, null (purposesOf fSpec outputLang' c)]
+            <> [c | c <- ccs, null (concDefs fSpec c)]
         ccs = toList . concs . vrels $ fSpec
 
     unusedConceptDefs :: Blocks
@@ -174,10 +174,12 @@ chpDiagnosis env fSpec
           if (null . conceptDefs) fSpec
             then mempty
             else
-              para . str . l $
-                ( NL "Alle concepten, die in dit document zijn voorzien van een definitie, worden gebruikt in relaties.",
-                  EN "All concepts defined in this document are used in relations."
-                )
+              para
+                . str
+                . l
+                $ ( NL "Alle concepten, die in dit document zijn voorzien van een definitie, worden gebruikt in relaties.",
+                    EN "All concepts defined in this document are used in relations."
+                  )
         [c] ->
           para
             ( (str . l)
@@ -313,9 +315,9 @@ chpDiagnosis env fSpec
         meaningOnlyMissing = filter hasPurpose . filter (not . hasMeaning) . toList $ decls
         decls = vrels fSpec
         showDclMath = math . tshow
-    hasPurpose :: Motivated a => a -> Bool
+    hasPurpose :: (Motivated a) => a -> Bool
     hasPurpose = not . null . purposesOf fSpec outputLang'
-    hasMeaning :: HasMeaning a => a -> Bool
+    hasMeaning :: (HasMeaning a) => a -> Bool
     hasMeaning = isJust . meaning outputLang'
 
     relsNotUsed :: Blocks
@@ -467,14 +469,14 @@ chpDiagnosis env fSpec
     ruleRelationRefTable :: Blocks
     ruleRelationRefTable =
       (para . str . l)
-        ( NL $
-            "Onderstaande tabel bevat per thema (dwz. patroon) tellingen van het aantal relaties en regels, "
-              <> "gevolgd door het aantal en het percentage daarvan dat een referentie bevat. Relaties die in meerdere thema's "
-              <> "gedeclareerd worden, worden ook meerdere keren geteld.",
-          EN $
-            "The table below shows for each theme (i.e. pattern) the number of relations and rules, followed "
-              <> "by the number and percentage that have a reference. Relations declared in multiple themes are counted multiple "
-              <> "times."
+        ( NL
+            $ "Onderstaande tabel bevat per thema (dwz. patroon) tellingen van het aantal relaties en regels, "
+            <> "gevolgd door het aantal en het percentage daarvan dat een referentie bevat. Relaties die in meerdere thema's "
+            <> "gedeclareerd worden, worden ook meerdere keren geteld.",
+          EN
+            $ "The table below shows for each theme (i.e. pattern) the number of relations and rules, followed "
+            <> "by the number and percentage that have a reference. Relations declared in multiple themes are counted multiple "
+            <> "times."
         )
         <> legacyTable -- No caption:
           mempty
@@ -499,7 +501,7 @@ chpDiagnosis env fSpec
       where
         mkTableRow ::
           Text -> -- The name of the pattern / fSpec
-          Relations -> --The user-defined relations of the pattern / fSpec
+          Relations -> -- The user-defined relations of the pattern / fSpec
           Rules -> -- The user-defined rules of the pattern / fSpec
           [Blocks]
         mkTableRowPat p = mkTableRow (label p) (relsDefdIn p) (udefrules p)
@@ -580,7 +582,7 @@ chpDiagnosis env fSpec
               mempty
               -- Alignment:
               ((AlignLeft, 1 / 3) : replicate 2 (AlignRight, 1 / 3))
-              --Header:
+              -- Header:
               ( map
                   (plain . str . l)
                   [ (NL "regel", EN "rule"),
@@ -648,7 +650,9 @@ chpDiagnosis env fSpec
                     <> (str . showValADL . apLeft) p
                 )
             else
-              "(" <> (str . label . source . formalExpression) r <> (str . showValADL . apLeft) p
+              "("
+                <> (str . label . source . formalExpression) r
+                <> (str . showValADL . apLeft) p
                 <> ", "
                 <> (str . label . target . formalExpression) r
                 <> (str . showValADL . apRight) p
@@ -721,19 +725,19 @@ chpDiagnosis env fSpec
       where
         violationMessage :: Text
         violationMessage =
-          T.unlines $
-            [ if length ps == 1
-                then "There is a violation of RULE " <> fullName r <> ":"
-                else "There are " <> tshow (length ps) <> " violations of RULE " <> fullName r <> ":"
-            ]
-              <> (map ("  " <>) . listPairs 10 . Set.toList $ ps)
+          T.unlines
+            $ [ if length ps == 1
+                  then "There is a violation of RULE " <> fullName r <> ":"
+                  else "There are " <> tshow (length ps) <> " violations of RULE " <> fullName r <> ":"
+              ]
+            <> (map ("  " <>) . listPairs 10 . Set.toList $ ps)
         listPairs :: Int -> [AAtomPair] -> [Text]
         listPairs i xs =
           case xs of
             [] -> []
             h : tl
               | i == 0 -> ["  ... (" <> tshow (length xs) <> " more)"]
-              | otherwise -> applyViolText' r h : listPairs (i -1) tl
+              | otherwise -> applyViolText' r h : listPairs (i - 1) tl
 
     violtable :: Rule -> AAtomPairs -> Blocks
     violtable r ps =
@@ -747,7 +751,7 @@ chpDiagnosis env fSpec
             [(plain . str . label . source . formalExpression) r]
             -- Data rows:
             [ [(plain . str . showValADL . apLeft) p]
-              | p <- take 10 . toList $ ps --max 10 rows
+              | p <- take 10 . toList $ ps -- max 10 rows
             ]
         else
           legacyTable -- No caption:
@@ -758,5 +762,5 @@ chpDiagnosis env fSpec
             [(plain . str . label . source . formalExpression) r, (plain . str . label . target . formalExpression) r]
             -- Data rows:
             [ [(plain . str . showValADL . apLeft) p, (plain . str . showValADL . apRight) p]
-              | p <- take 10 . toList $ ps --max 10 rows
+              | p <- take 10 . toList $ ps -- max 10 rows
             ]
diff --git a/src/Ampersand/Output/ToPandoc/ChapterNatLangReqs.hs b/src/Ampersand/Output/ToPandoc/ChapterNatLangReqs.hs
index 632480da8..5f53a47eb 100644
--- a/src/Ampersand/Output/ToPandoc/ChapterNatLangReqs.hs
+++ b/src/Ampersand/Output/ToPandoc/ChapterNatLangReqs.hs
@@ -58,7 +58,7 @@ chpNatLangReqs env lev fSpec =
         <> legacyTable
           caption'
           [(AlignLeft, 1 / 4), (AlignLeft, 3 / 4)]
-          [plain lawHeader, plain articleHeader] --headers
+          [plain lawHeader, plain articleHeader] -- headers
           [ [(para . str . aOlLaw) art, (para . str . unscanRef . aOlArt) art]
             | art <- (L.sort . L.nub . concatMap getArticlesOfLaw . getRefs) fSpec
           ]
@@ -76,24 +76,24 @@ chpNatLangReqs env lev fSpec =
           && null (cptsOfTheme tc)
           && null (dclsOfTheme tc)
           && null (rulesOfTheme tc) =
-        mempty
+          mempty
       | otherwise =
-        --  *** Header of the theme: ***
-        xDefBlck env fSpec (XRefSharedLangTheme (patOfTheme tc))
-          <> ( case patOfTheme tc of --  *** Purpose of the theme: ***
-                 Nothing ->
-                   (para . str . l)
-                     ( NL "Deze paragraaf beschrijft de relaties en concepten die niet in voorgaande secties zijn beschreven.",
-                       EN "This paragraph shows remaining artifacts that have not been described in previous paragraphs."
-                     )
-                 Just pat ->
-                   case purposesOf fSpec outputLang' pat of
-                     [] -> printIntro (cptsOfTheme tc)
-                     purps -> purposes2Blocks env purps
-             )
-          <> (mconcat . map (printConcept env l) . cptsOfTheme) tc
-          <> (mconcat . map printRel . dclsOfTheme) tc
-          <> (mconcat . map printRule . rulesOfTheme) tc
+          --  *** Header of the theme: ***
+          xDefBlck env fSpec (XRefSharedLangTheme (patOfTheme tc))
+            <> ( case patOfTheme tc of --  *** Purpose of the theme: ***
+                   Nothing ->
+                     (para . str . l)
+                       ( NL "Deze paragraaf beschrijft de relaties en concepten die niet in voorgaande secties zijn beschreven.",
+                         EN "This paragraph shows remaining artifacts that have not been described in previous paragraphs."
+                       )
+                   Just pat ->
+                     case purposesOf fSpec outputLang' pat of
+                       [] -> printIntro (cptsOfTheme tc)
+                       purps -> purposes2Blocks env purps
+               )
+            <> (mconcat . map (printConcept env l) . cptsOfTheme) tc
+            <> (mconcat . map printRel . dclsOfTheme) tc
+            <> (mconcat . map printRule . rulesOfTheme) tc
       where
         -- The following paragraph produces an introduction of one theme (i.e. pattern or process).
         printIntro :: [Numbered CptCont] -> Blocks
@@ -221,9 +221,9 @@ chpNatLangReqs env lev fSpec =
                 <> xDefInln env fSpec (XRefSharedLangRule rul),
               case (cRulMeanings . theLoad) nRul of
                 [] ->
-                  [ plain $
-                      (str . l) (NL "Deze regel ", EN "The rule ")
-                        <> (str . l) (NL " is ongedocumenteerd.", EN " is undocumented.")
+                  [ plain
+                      $ (str . l) (NL "Deze regel ", EN "The rule ")
+                      <> (str . l) (NL " is ongedocumenteerd.", EN " is undocumented.")
                   ]
                 ms -> fmap (printMarkup . ameaMrk) ms
             )
@@ -313,8 +313,8 @@ getArticlesOfLaw ref = map buildLA . T'.splitOn ", " . T.unwords . NE.init . wor
               ( case readMaybe (T.unpack digits) of
                   Nothing -> fatal $ "Impossible: This cannot be interpreted as digits: " <> digits
                   Just x -> x
-              ) :
-            scanRefTxt rest
+              )
+              : scanRefTxt rest
             where
               (digits, rest) = T.span isDigit txt
 
diff --git a/src/Ampersand/Prototype/GenAngularFrontend.hs b/src/Ampersand/Prototype/GenAngularFrontend.hs
index f857e953d..62b4d81f6 100644
--- a/src/Ampersand/Prototype/GenAngularFrontend.hs
+++ b/src/Ampersand/Prototype/GenAngularFrontend.hs
@@ -73,28 +73,28 @@ genComponentFileFromTemplate fSpec interf templateFunction templateFilePath targ
           . T.lines
           . renderTemplate Nothing template
           $ setAttribute "contextName" (addSlashes . fullName $ fSpec)
-            . setAttribute "isSessionInterface" (isSessionInterface interf)
-            . setAttribute "roles" (map show . feiRoles $ interf) -- show string, since StringTemplate does not elegantly allow to quote and separate
-            . setAttribute "ampersandVersionStr" (longVersion appVersion)
-            . setAttribute "ifcName" (ifcName interf)
-            . setAttribute "ifcNamePascal" (ifcNamePascal interf)
-            . setAttribute "ifcNameKebab" (ifcNameKebab interf)
-            . setAttribute "ifcLabel" (ifcLabel interf) -- no escaping for labels in templates needed
-            . setAttribute "expAdl" (showA . toExpr . ifcExp $ interf)
-            . setAttribute "exprIsUni" (exprIsUni (feiObj interf))
-            . setAttribute "exprIsTot" (exprIsTot (feiObj interf))
-            . setAttribute "source" (idWithoutType' . source . ifcExp $ interf)
-            . setAttribute "target" (idWithoutType' . target . ifcExp $ interf)
-            . setAttribute "crudC" (objCrudC (feiObj interf))
-            . setAttribute "crudR" (objCrudR (feiObj interf))
-            . setAttribute "crudU" (objCrudU (feiObj interf))
-            . setAttribute "crudD" (objCrudD (feiObj interf))
-            . setAttribute "crud" (crudsToString . objCrud . feiObj $ interf)
-            . setAttribute "contents" lns
-            . setAttribute "verbose" (loglevel' == LevelDebug)
-            . setAttribute "loglevel" (show loglevel')
-            . setAttribute "templateFilePath" templateFilePath
-            . setAttribute "targetFilePath" targetFilePath
+          . setAttribute "isSessionInterface" (isSessionInterface interf)
+          . setAttribute "roles" (map show . feiRoles $ interf) -- show string, since StringTemplate does not elegantly allow to quote and separate
+          . setAttribute "ampersandVersionStr" (longVersion appVersion)
+          . setAttribute "ifcName" (ifcName interf)
+          . setAttribute "ifcNamePascal" (ifcNamePascal interf)
+          . setAttribute "ifcNameKebab" (ifcNameKebab interf)
+          . setAttribute "ifcLabel" (ifcLabel interf) -- no escaping for labels in templates needed
+          . setAttribute "expAdl" (showA . toExpr . ifcExp $ interf)
+          . setAttribute "exprIsUni" (exprIsUni (feiObj interf))
+          . setAttribute "exprIsTot" (exprIsTot (feiObj interf))
+          . setAttribute "source" (idWithoutType' . source . ifcExp $ interf)
+          . setAttribute "target" (idWithoutType' . target . ifcExp $ interf)
+          . setAttribute "crudC" (objCrudC (feiObj interf))
+          . setAttribute "crudR" (objCrudR (feiObj interf))
+          . setAttribute "crudU" (objCrudU (feiObj interf))
+          . setAttribute "crudD" (objCrudD (feiObj interf))
+          . setAttribute "crud" (crudsToString . objCrud . feiObj $ interf)
+          . setAttribute "contents" lns
+          . setAttribute "verbose" (loglevel' == LevelDebug)
+          . setAttribute "loglevel" (show loglevel')
+          . setAttribute "templateFilePath" templateFilePath
+          . setAttribute "targetFilePath" targetFilePath
   writePrototypeAppFile targetFilePath contents
 
 genSingleFileFromTemplate :: (HasRunner env, HasDirPrototype env) => FSpec -> FESpec -> FilePath -> FilePath -> RIO env ()
@@ -104,18 +104,18 @@ genSingleFileFromTemplate fSpec feSpec templateFilePath targetFilePath = do
   template <- readTemplate templateFilePath
   mapM_ (logDebug . display) (showTemplate template)
   let contents =
-        renderTemplate Nothing template $
-          setAttribute "contextName" (fsName fSpec)
-            . setAttribute "ampersandVersionStr" (longVersion appVersion)
-            . setAttribute "ifcs" (interfaces feSpec) -- all interfaces
-            . setAttribute "uis" (filter (not . isApi) $ interfaces feSpec) -- only the interfaces that need UI
-            . setAttribute "apis" (filter isApi $ interfaces feSpec) -- only the interfaces that have API (no UI)
-            . setAttribute "concepts" (concepts feSpec)
-            . setAttribute "views" (views feSpec)
-            . setAttribute "verbose" (loglevel' == LevelDebug)
-            . setAttribute "loglevel" (show loglevel')
-            . setAttribute "templateFilePath" templateFilePath
-            . setAttribute "targetFilePath" targetFilePath
+        renderTemplate Nothing template
+          $ setAttribute "contextName" (fsName fSpec)
+          . setAttribute "ampersandVersionStr" (longVersion appVersion)
+          . setAttribute "ifcs" (interfaces feSpec) -- all interfaces
+          . setAttribute "uis" (filter (not . isApi) $ interfaces feSpec) -- only the interfaces that need UI
+          . setAttribute "apis" (filter isApi $ interfaces feSpec) -- only the interfaces that have API (no UI)
+          . setAttribute "concepts" (concepts feSpec)
+          . setAttribute "views" (views feSpec)
+          . setAttribute "verbose" (loglevel' == LevelDebug)
+          . setAttribute "loglevel" (show loglevel')
+          . setAttribute "templateFilePath" templateFilePath
+          . setAttribute "targetFilePath" targetFilePath
   writePrototypeAppFile targetFilePath contents
 
 objectAttributes :: FEObject -> LogLevel -> StringTemplate String -> StringTemplate String
@@ -181,7 +181,8 @@ genHTMLView fSpec depth obj =
           let (templateFilename, _) = fromMaybe (conceptTemplate, []) (objMPrimTemplate . atomicOrBox $ obj) -- Atomic is the default template
           template <- readTemplate templateFilename
 
-          return . T.intercalate eol
+          return
+            . T.intercalate eol
             . T.lines
             . renderTemplate Nothing template
             $ objectAttributes obj (logLevel runner)
@@ -197,8 +198,8 @@ genHTMLView fSpec depth obj =
               . indentSubStructure
               . renderTemplate (Just . btKeys $ header) parentTemplate
               $ objectAttributes obj (logLevel runner)
-                . setAttribute "isRoot" (depth == 0)
-                . setAttribute "subObjects" subObjAttrs
+              . setAttribute "isRoot" (depth == 0)
+              . setAttribute "subObjects" subObjAttrs
     FEObjT {} -> pure $ "<span>" <> objTxt obj <> "</span>"
   where
     getTemplateForObject ::
@@ -207,7 +208,7 @@ genHTMLView fSpec depth obj =
     getTemplateForObject
       | relIsProp obj && (not . exprIsIdent) obj -- special 'checkbox-like' template for propery relations
         =
-        return $ "View-PROPERTY" <> ".html"
+          return $ "View-PROPERTY" <> ".html"
       | otherwise = getTemplateForConcept . target . objExp $ obj
     getTemplateForConcept ::
       (HasDirPrototype env) =>
@@ -215,8 +216,8 @@ genHTMLView fSpec depth obj =
       RIO env FilePath
     getTemplateForConcept cpt = do
       exists <- doesTemplateExist cptfn
-      return $
-        if exists
+      return
+        $ if exists
           then cptfn
           else "Atomic-" <> show ttp <.> "html"
       where
@@ -237,8 +238,8 @@ indentEOL :: Text -> [Text]
 indentEOL x = case Partial.splitOn eol x of
   [] -> []
   (h : tl) ->
-    h :
-    map (prefix <>) tl
+    h
+      : map (prefix <>) tl
   where
     prefix = T.takeWhile (== ' ') x
 
@@ -270,8 +271,8 @@ genTypescriptInterface fSpec depth obj =
               . indentSubStructure
               . renderTemplate (Just . btKeys $ header) boxTemplate
               $ objectAttributes obj (logLevel runner)
-                . setAttribute "isRoot" (depth == 0)
-                . setAttribute "subObjects" subObjAttrs
+              . setAttribute "isRoot" (depth == 0)
+              . setAttribute "subObjects" subObjAttrs
     FEObjT {} -> pure $ "'" <> objTxt obj <> "'"
   where
     tgtCpt = target . objExp $ obj
@@ -287,14 +288,15 @@ genTypescriptInterface fSpec depth obj =
       | exprIsUni obj = typescriptTypeForConcept tgtCpt -- for univalent expressions use the Typescript type for target concept
       | cptTType fSpec tgtCpt == Object -- for non-uni Object expressions wrap Array<T> with newlines around Typescript type
         =
-        "Array<\n"
-          <> prefixAllLines "  " (typescriptTypeForConcept tgtCpt)
-          <> "\n>"
+          "Array<\n"
+            <> prefixAllLines "  " (typescriptTypeForConcept tgtCpt)
+            <> "\n>"
       | otherwise = "Array<" <> typescriptTypeForConcept tgtCpt <> ">" -- otherwise simply wrap Array<T>
     typescriptTypeForConcept :: A_Concept -> Text
     typescriptTypeForConcept cpt = case cptTType fSpec cpt of
       Object ->
-        conceptIdWithImportAlias cpt <> " & {\n"
+        conceptIdWithImportAlias cpt
+          <> " & {\n"
           <> prefixAllLines "  " ("_view_: " <> addViewDefinition <> ";")
           <> "\n}"
       _ -> conceptIdWithImportAlias cpt
diff --git a/src/Ampersand/Prototype/GenAngularJSFrontend.hs b/src/Ampersand/Prototype/GenAngularJSFrontend.hs
index 3c91304ac..e1b5d26bb 100644
--- a/src/Ampersand/Prototype/GenAngularJSFrontend.hs
+++ b/src/Ampersand/Prototype/GenAngularJSFrontend.hs
@@ -45,12 +45,12 @@ genRouteProvider fSpec ifcs = do
   template <- readTemplate "routeProvider.config.js"
   mapM_ (logDebug . display) (showTemplate template)
   let contents =
-        renderTemplate Nothing template $
-          setAttribute "contextName" (fsName fSpec)
-            . setAttribute "ampersandVersionStr" (longVersion appVersion)
-            . setAttribute "ifcs" ifcs
-            . setAttribute "verbose" (loglevel' == LevelDebug)
-            . setAttribute "loglevel" (show loglevel')
+        renderTemplate Nothing template
+          $ setAttribute "contextName" (fsName fSpec)
+          . setAttribute "ampersandVersionStr" (longVersion appVersion)
+          . setAttribute "ifcs" ifcs
+          . setAttribute "verbose" (loglevel' == LevelDebug)
+          . setAttribute "loglevel" (show loglevel')
   mapM_ (logDebug . display) $ "Generated template: " : (map ("   " <>) . T.lines $ contents)
   writePrototypeAppFile "routeProvider.config.js" contents
   logDebug "Finish genRouteProvider."
@@ -77,23 +77,23 @@ genViewInterface fSpec interf = do
   lns <- genViewObject fSpec 0 (feiObj interf)
   template <- readTemplate "interface.html"
   let contents =
-        renderTemplate Nothing template $
-          setAttribute "contextName" (addSlashes . fullName $ fSpec)
-            . setAttribute "isTopLevel" (isTopLevel . source . ifcExp $ interf)
-            . setAttribute "roles" (map show . feiRoles $ interf) -- show string, since StringTemplate does not elegantly allow to quote and separate
-            . setAttribute "ampersandVersionStr" (longVersion appVersion)
-            . setAttribute "interfaceName" (ifcName interf)
-            . setAttribute "interfaceLabel" (ifcLabel interf) -- no escaping for labels in templates needed
-            . setAttribute "expAdl" (showA . toExpr . ifcExp $ interf)
-            . setAttribute "source" (idWithoutType . source . ifcExp $ interf)
-            . setAttribute "target" (idWithoutType . target . ifcExp $ interf)
-            . setAttribute "crudC" (objCrudC (feiObj interf))
-            . setAttribute "crudR" (objCrudR (feiObj interf))
-            . setAttribute "crudU" (objCrudU (feiObj interf))
-            . setAttribute "crudD" (objCrudD (feiObj interf))
-            . setAttribute "contents" (T.intercalate "\n" lns) -- intercalate, because unlines introduces a trailing \n
-            . setAttribute "verbose" (loglevel' == LevelDebug)
-            . setAttribute "loglevel" (show loglevel')
+        renderTemplate Nothing template
+          $ setAttribute "contextName" (addSlashes . fullName $ fSpec)
+          . setAttribute "isTopLevel" (isTopLevel . source . ifcExp $ interf)
+          . setAttribute "roles" (map show . feiRoles $ interf) -- show string, since StringTemplate does not elegantly allow to quote and separate
+          . setAttribute "ampersandVersionStr" (longVersion appVersion)
+          . setAttribute "interfaceName" (ifcName interf)
+          . setAttribute "interfaceLabel" (ifcLabel interf) -- no escaping for labels in templates needed
+          . setAttribute "expAdl" (showA . toExpr . ifcExp $ interf)
+          . setAttribute "source" (idWithoutType . source . ifcExp $ interf)
+          . setAttribute "target" (idWithoutType . target . ifcExp $ interf)
+          . setAttribute "crudC" (objCrudC (feiObj interf))
+          . setAttribute "crudR" (objCrudR (feiObj interf))
+          . setAttribute "crudU" (objCrudU (feiObj interf))
+          . setAttribute "crudD" (objCrudD (feiObj interf))
+          . setAttribute "contents" (T.intercalate "\n" lns) -- intercalate, because unlines introduces a trailing \n
+          . setAttribute "verbose" (loglevel' == LevelDebug)
+          . setAttribute "loglevel" (show loglevel')
   let filename :: FilePath
       filename = "ifc" <> (T.unpack . ifcName $ interf) <> ".view.html"
   writePrototypeAppFile filename contents
@@ -152,7 +152,8 @@ genViewObject fSpec depth obj =
           let (templateFilename, _) = fromMaybe (conceptTemplate, []) (objMPrimTemplate . atomicOrBox $ obj) -- Atomic is the default template
           template <- readTemplate templateFilename
 
-          return . indentation
+          return
+            . indentation
             . T.lines
             . renderTemplate Nothing template
             $ atomicAndBoxAttrs
@@ -164,12 +165,13 @@ genViewObject fSpec depth obj =
 
             parentTemplate <- readTemplate $ "Box-" <> (T.unpack . text1ToText . btType) header <.> "html"
 
-            return . indentation
+            return
+              . indentation
               . T.lines
               . renderTemplate (Just . btKeys $ header) parentTemplate
               $ atomicAndBoxAttrs
-                . setAttribute "isRoot" (depth == 0)
-                . setAttribute "subObjects" subObjAttrs
+              . setAttribute "isRoot" (depth == 0)
+              . setAttribute "subObjects" subObjAttrs
     FEObjT {} -> pure []
   where
     indentation :: [Text] -> [Text]
@@ -209,7 +211,7 @@ genViewObject fSpec depth obj =
     getTemplateForObject
       | relIsProp obj && (not . exprIsIdent) obj -- special 'checkbox-like' template for propery relations
         =
-        return $ "View-PROPERTY" <> ".html"
+          return $ "View-PROPERTY" <> ".html"
       | otherwise = getTemplateForConcept . target . objExp $ obj
     getTemplateForConcept ::
       (HasDirPrototype env) =>
@@ -217,8 +219,8 @@ genViewObject fSpec depth obj =
       RIO env FilePath
     getTemplateForConcept cpt = do
       exists <- doesTemplateExist cptfn
-      return $
-        if exists
+      return
+        $ if exists
           then cptfn
           else "Atomic-" <> show ttp <.> "html"
       where
@@ -236,23 +238,23 @@ genControllerInterface fSpec interf = do
   runner <- view runnerL
   let loglevel' = logLevel runner
   let contents =
-        renderTemplate Nothing template $
-          setAttribute "contextName" (fsName fSpec)
-            . setAttribute "isRoot" (isTopLevel . source . ifcExp $ interf)
-            . setAttribute "roles" (map show . feiRoles $ interf) -- show string, since StringTemplate does not elegantly allow to quote and separate
-            . setAttribute "ampersandVersionStr" (longVersion appVersion)
-            . setAttribute "interfaceName" (ifcName interf)
-            . setAttribute "interfaceLabel" (ifcLabel interf) -- no escaping for labels in templates needed
-            . setAttribute "expAdl" (showA . toExpr . ifcExp $ interf)
-            . setAttribute "exprIsUni" (exprIsUni (feiObj interf))
-            . setAttribute "source" (idWithoutType . source . ifcExp $ interf)
-            . setAttribute "target" (idWithoutType . target . ifcExp $ interf)
-            . setAttribute "crudC" (objCrudC (feiObj interf))
-            . setAttribute "crudR" (objCrudR (feiObj interf))
-            . setAttribute "crudU" (objCrudU (feiObj interf))
-            . setAttribute "crudD" (objCrudD (feiObj interf))
-            . setAttribute "verbose" (loglevel' == LevelDebug)
-            . setAttribute "loglevel" (show loglevel')
-            . setAttribute "usedTemplate" controlerTemplateName
+        renderTemplate Nothing template
+          $ setAttribute "contextName" (fsName fSpec)
+          . setAttribute "isRoot" (isTopLevel . source . ifcExp $ interf)
+          . setAttribute "roles" (map show . feiRoles $ interf) -- show string, since StringTemplate does not elegantly allow to quote and separate
+          . setAttribute "ampersandVersionStr" (longVersion appVersion)
+          . setAttribute "interfaceName" (ifcName interf)
+          . setAttribute "interfaceLabel" (ifcLabel interf) -- no escaping for labels in templates needed
+          . setAttribute "expAdl" (showA . toExpr . ifcExp $ interf)
+          . setAttribute "exprIsUni" (exprIsUni (feiObj interf))
+          . setAttribute "source" (idWithoutType . source . ifcExp $ interf)
+          . setAttribute "target" (idWithoutType . target . ifcExp $ interf)
+          . setAttribute "crudC" (objCrudC (feiObj interf))
+          . setAttribute "crudR" (objCrudR (feiObj interf))
+          . setAttribute "crudU" (objCrudU (feiObj interf))
+          . setAttribute "crudD" (objCrudD (feiObj interf))
+          . setAttribute "verbose" (loglevel' == LevelDebug)
+          . setAttribute "loglevel" (show loglevel')
+          . setAttribute "usedTemplate" controlerTemplateName
   let filename = "ifc" <> T.unpack (ifcName interf) <> ".controller.js"
   writePrototypeAppFile filename contents
diff --git a/src/Ampersand/Prototype/GenFrontend.hs b/src/Ampersand/Prototype/GenFrontend.hs
index 95df99896..175307340 100644
--- a/src/Ampersand/Prototype/GenFrontend.hs
+++ b/src/Ampersand/Prototype/GenFrontend.hs
@@ -83,7 +83,9 @@ buildConcepts fSpec =
             typescriptType = typescriptTypeForConcept fSpec cpt
           }
     )
-    $ toList . allConcepts $ fSpec
+    $ toList
+    . allConcepts
+    $ fSpec
 
 buildViews :: FSpec -> [FEView]
 buildViews fSpec =
diff --git a/src/Ampersand/Prototype/ProtoUtil.hs b/src/Ampersand/Prototype/ProtoUtil.hs
index 891defaf5..156d865d1 100644
--- a/src/Ampersand/Prototype/ProtoUtil.hs
+++ b/src/Ampersand/Prototype/ProtoUtil.hs
@@ -75,7 +75,7 @@ data FEInterface = FEInterface
     ifcLabel :: Text,
     ifcExp :: FEExpression,
     isApi :: Bool,
-    isSessionInterface :: Bool, --True if the source concept is the session. (then the interface will show a list of all)
+    isSessionInterface :: Bool, -- True if the source concept is the session. (then the interface will show a list of all)
     srcConcept :: Text,
     feiRoles :: [Role],
     feiObj :: FEObject
@@ -201,22 +201,22 @@ copyDirRecursively ::
   RIO env ()
 copyDirRecursively srcBase tgtBase
   | srcBase == tgtBase =
-    mapM_
-      logError
-      [ "Are you kidding me? I got the instruction to copy ",
-        "     " <> display (T.pack srcBase),
-        "  to itself!"
-      ]
+      mapM_
+        logError
+        [ "Are you kidding me? I got the instruction to copy ",
+          "     " <> display (T.pack srcBase),
+          "  to itself!"
+        ]
   | otherwise = do
-    srcBaseA <- liftIO $ makeAbsolute srcBase
-    tgtBaseA <- liftIO $ makeAbsolute tgtBase
-    mapM_
-      logDebug
-      [ "Recursively copying ",
-        "     " <> display (T.pack srcBaseA),
-        "  to " <> display (T.pack tgtBaseA)
-      ]
-    copy ("." </> tgtBase) ""
+      srcBaseA <- liftIO $ makeAbsolute srcBase
+      tgtBaseA <- liftIO $ makeAbsolute tgtBase
+      mapM_
+        logDebug
+        [ "Recursively copying ",
+          "     " <> display (T.pack srcBaseA),
+          "  to " <> display (T.pack tgtBaseA)
+        ]
+      copy ("." </> tgtBase) ""
   where
     copy shouldSkip fileOrDirPth = do
       let srcPath = srcBase </> fileOrDirPth
@@ -230,7 +230,7 @@ copyDirRecursively srcBase tgtBase
             else
               if takeExtension srcPath == defaultDirPrototype
                 then do
-                  logDebug $ "Skipping " <> display (T.pack srcPath) <> " because its extension is excluded by design" --This is because of regression tests. (See what happend at https://travis-ci.org/AmpersandTarski/Ampersand/jobs/621565925 )
+                  logDebug $ "Skipping " <> display (T.pack srcPath) <> " because its extension is excluded by design" -- This is because of regression tests. (See what happend at https://travis-ci.org/AmpersandTarski/Ampersand/jobs/621565925 )
                 else do
                   logDebug $ " Copying dir... " <> display (T.pack srcPath)
                   logDebug $ "      to dir... " <> display (T.pack tgtPath)
@@ -243,7 +243,7 @@ copyDirRecursively srcBase tgtBase
 
 -- Remove all files in directory dirPath, but don't enter subdirectories (for which a warning is emitted.)
 removeAllDirectoryFiles ::
-  HasLogFunc env =>
+  (HasLogFunc env) =>
   FilePath ->
   RIO env ()
 removeAllDirectoryFiles dirPath = do
@@ -288,7 +288,7 @@ strReplace src dst inp =
 
 phpIndent :: Int -> Text
 phpIndent i
-  | i < 0 = T.pack " " --space instead of \n
+  | i < 0 = T.pack " " -- space instead of \n
   | otherwise = T.pack $ '\n' : replicate i ' '
 
 addSlashes :: Text -> Text
@@ -348,22 +348,25 @@ renderTemplate userAtts (Template template absPath) setRuntimeAtts =
     --         for each interface provided.
     ([], [], []) -> T.pack $ render appliedTemplate
     (parseErrs@(_ : _), _, _) ->
-      templateError . T.concat $
-        [ T.pack $ "Parse error in " <> tmplt <> " " <> err <> "\n"
-          | (tmplt, err) <- parseErrs
-        ]
+      templateError
+        . T.concat
+        $ [ T.pack $ "Parse error in " <> tmplt <> " " <> err <> "\n"
+            | (tmplt, err) <- parseErrs
+          ]
     ([], attrs@(_ : _), _)
       | isJust userAtts -> T.pack . render . fillInTheBlanks (L.nub attrs) $ appliedTemplate
       | otherwise ->
-        templateError $
-          "The following attributes are expected by the template, but not supplied: " <> tshow attrs
+          templateError
+            $ "The following attributes are expected by the template, but not supplied: "
+            <> tshow attrs
     ([], [], ts@(_ : _)) ->
-      templateError $
-        "Missing invoked templates: " <> tshow ts -- should not happen as we don't invoke templates
+      templateError
+        $ "Missing invoked templates: "
+        <> tshow ts -- should not happen as we don't invoke templates
   where
     templateError msg =
-      exitWith $
-        ReadFileError
+      exitWith
+        $ ReadFileError
           [ "*** TEMPLATE ERROR in:" <> T.pack absPath,
             msg
           ]
@@ -384,8 +387,9 @@ renderTemplate userAtts (Template template absPath) setRuntimeAtts =
 
 showTemplate :: Template -> [Text]
 showTemplate (Template a b) =
-  T.lines . T.intercalate "\n" $
-    ("Template (" <> T.pack b <> ")") :
-    map
+  T.lines
+    . T.intercalate "\n"
+    $ ("Template (" <> T.pack b <> ")")
+    : map
       ("  " <>)
       [T.pack $ toString a]
diff --git a/src/Ampersand/Prototype/ValidateSQL.hs b/src/Ampersand/Prototype/ValidateSQL.hs
index 61fe0e874..5a547ac43 100644
--- a/src/Ampersand/Prototype/ValidateSQL.hs
+++ b/src/Ampersand/Prototype/ValidateSQL.hs
@@ -50,9 +50,9 @@ validateRulesSQL fSpec = do
           logDebug "\nValidation successful.\nWith the provided populations, all generated SQL code has passed validation."
           return []
         ves ->
-          return $
-            "Validation error. The following terms failed validation:" :
-            map showVExp ves
+          return
+            $ "Validation error. The following terms failed validation:"
+            : map showVExp ves
 
 -- functions for extracting all terms from the context
 
@@ -64,8 +64,8 @@ getAllInterfaceExps fSpec =
     ]
   where
     getObjExps iName objDef =
-      (objExpression objDef, "interface " <> tshow iName) :
-      concatMap (getObjExps iName) (fields objDef)
+      (objExpression objDef, "interface " <> tshow iName)
+        : concatMap (getObjExps iName) (fields objDef)
 
 -- we check the complement of the rule, since that is the term evaluated in the prototype
 getAllRuleExps :: FSpec -> [ValidationExp]
diff --git a/src/Ampersand/Test/Parser/QuickChecks.hs b/src/Ampersand/Test/Parser/QuickChecks.hs
index 838a4e8e0..a5fe86a9d 100644
--- a/src/Ampersand/Test/Parser/QuickChecks.hs
+++ b/src/Ampersand/Test/Parser/QuickChecks.hs
@@ -74,9 +74,10 @@ prop_parserRoundtrip pCtx =
   case roundtrip pCtx of
     Checked _ _ -> True
     Errors err ->
-      exitWith . SomeTestsFailed $
-        T.lines (tshow err)
-          <> T.lines (prettyCtx pCtx)
+      exitWith
+        . SomeTestsFailed
+        $ T.lines (tshow err)
+        <> T.lines (prettyCtx pCtx)
 
 roundtrip :: P_Context -> Guarded P_Context
 roundtrip pCtx =
diff --git a/src/Ampersand/Test/Regression.hs b/src/Ampersand/Test/Regression.hs
index 029b8a1e2..b3dfe2c05 100644
--- a/src/Ampersand/Test/Regression.hs
+++ b/src/Ampersand/Test/Regression.hs
@@ -81,8 +81,8 @@ walkDirTree fp = do
       entries <- getDirectoryContents fp >>= filterHidden
       subdirs <- filterM isDir entries
       files <- filterM isFile entries
-      return $
-        DirList
+      return
+        $ DirList
           { filesOf = files,
             subdirsOf = subdirs
           }
@@ -144,15 +144,15 @@ doTestsInDir = awaitForever once
       where
         doFilesWithCommand :: (HasProcessContext env, HasLogFunc env) => [FilePath] -> TestSpec -> RIO env TestResults
         doFilesWithCommand candidates ti =
-          runConduit $
-            doAll candidates (testCmds ti)
-              .| mapMC runTestcase
-              .| sumarizeTestCases
+          runConduit
+            $ doAll candidates (testCmds ti)
+            .| mapMC runTestcase
+            .| sumarizeTestCases
           where
             doAll :: [FilePath] -> [TestInstruction] -> ConduitT () TestCase (RIO env) ()
             doAll cs tis =
-              yieldMany $
-                foo [\nr -> TestCase (traversalNr x, nr) f ti' | f <- cs, ti' <- tis] 1
+              yieldMany
+                $ foo [\nr -> TestCase (traversalNr x, nr) f ti' | f <- cs, ti' <- tis] 1
               where
                 foo :: [Int -> TestCase] -> Int -> [TestCase]
                 foo [] _ = []
@@ -162,8 +162,8 @@ doTestsInDir = awaitForever once
               let instr = instruction tc
                   indnt = ">> " <> (display . fst . testNr $ tc) <> "." <> (display . snd . testNr $ tc) <> ": "
               res <- testAdlfile indnt (path x) (testFile tc) instr
-              return $
-                if res
+              return
+                $ if res
                   then TestResults {successes = 1, failures = 0}
                   else TestResults {successes = 0, failures = 1}
 
@@ -178,9 +178,9 @@ doTestsInDir = awaitForever once
                       (\result -> loop $! add sofar result)
         parseYaml :: RIO env (Either ParseException TestSpec)
         parseYaml = liftIO . decodeFileEither $ path x </> yaml
-    sayInstruction :: HasLogFunc env => TestInstruction -> RIO env ()
+    sayInstruction :: (HasLogFunc env) => TestInstruction -> RIO env ()
     sayInstruction x = logDebug $ indent <> "  Command: " <> display (command x) <> if exitcode x == 0 then " (should succeed)." else " (should fail with exitcode " <> display (exitcode x) <> ")."
-    indent :: IsString a => a
+    indent :: (IsString a) => a
     indent = "    "
 
 data TestCase = TestCase
@@ -230,12 +230,12 @@ testAdlfile ::
   Utf8Builder -> -- prefix to use in all output
   FilePath -> -- the filepath of the directory where the test should be done
   FilePath -> -- the script that is undergoing the test
-  TestInstruction -> --The instruction to test, so it is known how to test the script
+  TestInstruction -> -- The instruction to test, so it is known how to test the script
   RIO env Bool -- Indicator telling if the test passed or not
 testAdlfile indent dir adl tinfo = do
   logInfo $ indent <> "Start: " <> (display . command $ tinfo) <> " " <> (display . T.pack $ adl)
-  (exit_code, out, err) <- withWorkingDir dir $
-    case words . T.unpack . command $ tinfo of
+  (exit_code, out, err) <- withWorkingDir dir
+    $ case words . T.unpack . command $ tinfo of
       [] -> fatal "No command given!"
       h : tl -> do
         proc h (tl <> [adl]) readProcess
@@ -251,16 +251,19 @@ testAdlfile indent dir adl tinfo = do
       logInfo $ indent <> "✅ Passed."
     failHandler :: (HasLogFunc env) => (ExitCode, BL.ByteString, BL.ByteString) -> RIO env ()
     failHandler (exit_code, out, err) = do
-      logError $
-        "❗❗❗ Failed. " <> indent <> (display . T.pack $ adl) <> " "
-          <> "(Expected: "
-          <> ( if exitcode tinfo == 0
-                 then "ExitSuccess"
-                 else "ExitFailure " <> display (exitcode tinfo)
-             )
-          <> ", Actual: "
-          <> display (tshow exit_code)
-          <> ")"
+      logError
+        $ "❗❗❗ Failed. "
+        <> indent
+        <> (display . T.pack $ adl)
+        <> " "
+        <> "(Expected: "
+        <> ( if exitcode tinfo == 0
+               then "ExitSuccess"
+               else "ExitFailure " <> display (exitcode tinfo)
+           )
+        <> ", Actual: "
+        <> display (tshow exit_code)
+        <> ")"
       mapM_ (logError . indnt) . toUtf8Builders $ out
 
       logError . indnt $ "------------------- "
diff --git a/src/Ampersand/Types/Config.hs b/src/Ampersand/Types/Config.hs
index 650f7a15d..397837e38 100644
--- a/src/Ampersand/Types/Config.hs
+++ b/src/Ampersand/Types/Config.hs
@@ -136,19 +136,21 @@ instance Yaml.FromJSON ColorWhen where
       "auto" -> return ColorAuto
       _ ->
         fail
-          ( "Unknown color use: " <> s <> ". Expected values of "
+          ( "Unknown color use: "
+              <> s
+              <> ". Expected values of "
               <> "option are 'never', 'always', or 'auto'."
           )
 
 -- | The top-level Stackage configuration.
 newtype Config = Config
   { -- | this allows to override .stack-work directory
-    configWorkDir :: FilePath --Dummy, to make sure Config has some stuff in it.
+    configWorkDir :: FilePath -- Dummy, to make sure Config has some stuff in it.
   }
 
 -- An uninterpreted representation of configuration options.
 -- Configurations may be "cascaded" using mappend (left-biased).
---data ConfigMonoid =
+-- data ConfigMonoid =
 --  ConfigMonoid
 --    {configMonoidWorkDir :: !(First FilePath)
 --    -- ^ See: 'configWorkDir'.
@@ -175,40 +177,40 @@ data ExtendedRunner a = ExtendedRunner
 cmdOptsL :: Lens' (ExtendedRunner a) a
 cmdOptsL = lens eCmdOpts (\x y -> x {eCmdOpts = y})
 
-instance HasOutputLanguage a => HasOutputLanguage (ExtendedRunner a) where
+instance (HasOutputLanguage a) => HasOutputLanguage (ExtendedRunner a) where
   languageL = cmdOptsL . languageL
 
-instance HasFSpecGenOpts a => HasFSpecGenOpts (ExtendedRunner a) where
+instance (HasFSpecGenOpts a) => HasFSpecGenOpts (ExtendedRunner a) where
   fSpecGenOptsL = cmdOptsL . fSpecGenOptsL
 
-instance HasDocumentOpts a => HasDocumentOpts (ExtendedRunner a) where
+instance (HasDocumentOpts a) => HasDocumentOpts (ExtendedRunner a) where
   documentOptsL = cmdOptsL . documentOptsL
 
-instance HasDaemonOpts a => HasDaemonOpts (ExtendedRunner a) where
+instance (HasDaemonOpts a) => HasDaemonOpts (ExtendedRunner a) where
   daemonOptsL = cmdOptsL . daemonOptsL
 
-instance HasTestOpts a => HasTestOpts (ExtendedRunner a) where
+instance (HasTestOpts a) => HasTestOpts (ExtendedRunner a) where
   testOptsL = cmdOptsL . testOptsL
 
-instance HasGenerateFrontend a => HasGenerateFrontend (ExtendedRunner a) where
+instance (HasGenerateFrontend a) => HasGenerateFrontend (ExtendedRunner a) where
   generateFrontendL = cmdOptsL . generateFrontendL
 
-instance HasGenerateBackend a => HasGenerateBackend (ExtendedRunner a) where
+instance (HasGenerateBackend a) => HasGenerateBackend (ExtendedRunner a) where
   generateBackendL = cmdOptsL . generateBackendL
 
-instance HasGenerateMetamodel a => HasGenerateMetamodel (ExtendedRunner a) where
+instance (HasGenerateMetamodel a) => HasGenerateMetamodel (ExtendedRunner a) where
   generateMetamodelL = cmdOptsL . generateMetamodelL
 
 instance (HasFSpecGenOpts a, HasDirPrototype a) => HasDirPrototype (ExtendedRunner a) where
   dirPrototypeL = cmdOptsL . dirPrototypeL
 
-instance HasProtoOpts a => HasProtoOpts (ExtendedRunner a) where
+instance (HasProtoOpts a) => HasProtoOpts (ExtendedRunner a) where
   protoOptsL = cmdOptsL . protoOptsL
 
-instance HasPopulationOpts a => HasPopulationOpts (ExtendedRunner a) where
+instance (HasPopulationOpts a) => HasPopulationOpts (ExtendedRunner a) where
   populationOptsL = cmdOptsL . populationOptsL
 
-instance HasOutputFile a => HasOutputFile (ExtendedRunner a) where
+instance (HasOutputFile a) => HasOutputFile (ExtendedRunner a) where
   outputfileL = cmdOptsL . outputfileL
 
 instance HasRunner (ExtendedRunner a) where
@@ -223,5 +225,5 @@ instance HasProcessContext (ExtendedRunner a) where
 instance HasDirOutput (ExtendedRunner a) where
   dirOutputL = runnerL . dirOutputL
 
-instance HasBlackWhite a => HasBlackWhite (ExtendedRunner a) where
+instance (HasBlackWhite a) => HasBlackWhite (ExtendedRunner a) where
   blackWhiteL = cmdOptsL . blackWhiteL
diff --git a/src/MainApps.hs b/src/MainApps.hs
index a05806e78..556911ad2 100644
--- a/src/MainApps.hs
+++ b/src/MainApps.hs
@@ -45,8 +45,9 @@ ampersandWorker eGlobalRun = do
       global <- globalOptsFromMonoid isTerminal defaultOuptutDir globalMonoid
       -- when (globalLogLevel global == LevelDebug) $ hPutStrLn stderr versionString'
 
-      withRunnerGlobal global $
-        run `catch` \e ->
+      withRunnerGlobal global
+        $ run
+        `catch` \e ->
           -- This special handler stops "ampersand: " from being printed before the
           -- exception
           case fromException e of
diff --git a/src/Options/Applicative/Builder/Extra.hs b/src/Options/Applicative/Builder/Extra.hs
index 50dd59d12..c79b6cf55 100644
--- a/src/Options/Applicative/Builder/Extra.hs
+++ b/src/Options/Applicative/Builder/Extra.hs
@@ -31,7 +31,7 @@ module Options.Applicative.Builder.Extra
   )
 where
 
---import Path hiding ((</>))
+-- import Path hiding ((</>))
 import Ampersand.Basics
 import Data.List (isPrefixOf)
 import Data.Monoid hiding ((<>))
@@ -52,8 +52,8 @@ boolFlags ::
   Mod FlagFields Bool ->
   Parser Bool
 boolFlags defaultValue name' helpSuffix =
-  enableDisableFlags defaultValue True False name' $
-    concat
+  enableDisableFlags defaultValue True False name'
+    $ concat
       [ helpSuffix,
         " (default: ",
         if defaultValue then "enabled" else "disabled",
@@ -90,7 +90,8 @@ firstBoolFlagsTrue name' helpSuffix =
     (FirstTrue (Just True))
     (FirstTrue (Just False))
     name'
-    $ helpSuffix ++ " (default: enabled)"
+    $ helpSuffix
+    ++ " (default: enabled)"
 
 -- | Flag with a Semigroup instance and a default of False
 firstBoolFlagsFalse :: String -> String -> Mod FlagFields FirstFalse -> Parser FirstFalse
@@ -100,7 +101,8 @@ firstBoolFlagsFalse name' helpSuffix =
     (FirstFalse (Just True))
     (FirstFalse (Just False))
     name'
-    $ helpSuffix ++ " (default: disabled)"
+    $ helpSuffix
+    ++ " (default: disabled)"
 
 -- | Enable/disable flags for any type.
 enableDisableFlags ::
@@ -198,35 +200,35 @@ textArgument :: Mod ArgumentFields Text -> Parser Text
 textArgument = argument (T.pack <$> readerAsk)
 
 -- | Like 'optional', but returning a 'First'.
-optionalFirst :: Alternative f => f a -> f (First a)
+optionalFirst :: (Alternative f) => f a -> f (First a)
 optionalFirst = fmap First . optional
 
 -- | Like 'optional', but returning a 'FirstTrue'.
-optionalFirstTrue :: Alternative f => f Bool -> f FirstTrue
+optionalFirstTrue :: (Alternative f) => f Bool -> f FirstTrue
 optionalFirstTrue = fmap FirstTrue . optional
 
 -- | Like 'optional', but returning a 'FirstFalse'.
-optionalFirstFalse :: Alternative f => f Bool -> f FirstFalse
+optionalFirstFalse :: (Alternative f) => f Bool -> f FirstFalse
 optionalFirstFalse = fmap FirstFalse . optional
 
---absFileOption :: Mod OptionFields (Path Abs File) -> Parser (Path Abs File)
---absFileOption mods = option (eitherReader' parseAbsFile) $
+-- absFileOption :: Mod OptionFields (Path Abs File) -> Parser (Path Abs File)
+-- absFileOption mods = option (eitherReader' parseAbsFile) $
 --  completer (pathCompleterWith defaultPathCompleterOpts { pcoRelative = False }) <> mods
 
---relFileOption :: Mod OptionFields (Path Rel File) -> Parser (Path Rel File)
---relFileOption mods = option (eitherReader' parseRelFile) $
+-- relFileOption :: Mod OptionFields (Path Rel File) -> Parser (Path Rel File)
+-- relFileOption mods = option (eitherReader' parseRelFile) $
 --  completer (pathCompleterWith defaultPathCompleterOpts { pcoAbsolute = False }) <> mods
 
---absDirOption :: Mod OptionFields (Path Abs Dir) -> Parser (Path Abs Dir)
---absDirOption mods = option (eitherReader' parseAbsDir) $
+-- absDirOption :: Mod OptionFields (Path Abs Dir) -> Parser (Path Abs Dir)
+-- absDirOption mods = option (eitherReader' parseAbsDir) $
 --  completer (pathCompleterWith defaultPathCompleterOpts { pcoRelative = False, pcoFileFilter = const False }) <> mods
 
---relDirOption :: Mod OptionFields (Path Rel Dir) -> Parser (Path Rel Dir)
---relDirOption mods = option (eitherReader' parseRelDir) $
+-- relDirOption :: Mod OptionFields (Path Rel Dir) -> Parser (Path Rel Dir)
+-- relDirOption mods = option (eitherReader' parseRelDir) $
 --  completer (pathCompleterWith defaultPathCompleterOpts { pcoAbsolute = False, pcoFileFilter = const False }) <> mods
 
 -- | Like 'eitherReader', but accepting any @'Show' e@ on the 'Left'.
-eitherReader' :: Show e => (String -> Either e a) -> ReadM a
+eitherReader' :: (Show e) => (String -> Either e a) -> ReadM a
 eitherReader' f = eitherReader (mapLeft show . f)
 
 data PathCompleterOpts = PathCompleterOpts
@@ -277,8 +279,9 @@ pathCompleterWith PathCompleterOpts {..} = mkCompleter $ \inputRaw -> do
       | otherwise -> return []
     Just searchDir -> do
       entries <- getDirectoryContents searchDir `catch` \(_ :: IOException) -> return []
-      fmap catMaybes $
-        forM entries $ \entry ->
+      fmap catMaybes
+        $ forM entries
+        $ \entry ->
           -- Skip . and .. unless user is typing . or ..
           if entry `elem` ["..", "."] && searchPrefix `notElem` ["..", "."]
             then return Nothing

From 82f686cfc4a37ac4d888e320db40200bc2368323 Mon Sep 17 00:00:00 2001
From: hanjoosten <han.joosten@ordina.nl>
Date: Fri, 19 Apr 2024 17:13:17 +0200
Subject: [PATCH 29/43] discontinue Windows build

---
 .github/workflows/ci2.yml     |  50 ++++++++--------
 .github/workflows/release.yml | 106 +++++++++++++++++-----------------
 ReleaseNotes.md               |   5 ++
 3 files changed, 83 insertions(+), 78 deletions(-)

diff --git a/.github/workflows/ci2.yml b/.github/workflows/ci2.yml
index afad592e8..dde13aa5a 100644
--- a/.github/workflows/ci2.yml
+++ b/.github/workflows/ci2.yml
@@ -69,28 +69,28 @@ jobs:
         with:
           stack-build-arguments: "--copy-bins --flag ampersand:buildAll"
 
-  build-and-test-windows:
-    name: Build and test on Windows 🏗 🧪
-    runs-on: windows-latest
-    steps:
-      - name: Checkout project contents 📡
-        uses: actions/checkout@v3
-      - uses: suisei-cn/actions-download-file@818d6b7dc8fe73f2f924b6241f2b1134ca1377d9 # 1.6.0
-        id: expatLibraryZip  # Remember to give an ID if you need the output filename
-        name: Download the expat library
-        with:
-          url: "https://github.com/libexpat/libexpat/releases/download/R_2_6_2/expat-win32bin-2.6.2.zip"
-          target: public/
-      - name: Set up Mariadb 🧰
-        uses: shogo82148/actions-setup-mysql@v1
-        with:
-          mysql-version: "mariadb-10.6"
-      - name: Setup PHP 🧰
-        uses: shivammathur/setup-php@v2
-        with:
-          php-version: "8.0"
-          extensions: mysqli
-      - name: Build and test 🏗 🧪
-        uses: freckle/stack-action@v5
-        with:
-          stack-build-arguments: "--copy-bins --flag ampersand:buildAll"
+  # build-and-test-windows:
+  #   name: Build and test on Windows 🏗 🧪
+  #   runs-on: windows-latest
+  #   steps:
+  #     - name: Checkout project contents 📡
+  #       uses: actions/checkout@v3
+  #     - uses: suisei-cn/actions-download-file@818d6b7dc8fe73f2f924b6241f2b1134ca1377d9 # 1.6.0
+  #       id: expatLibraryZip  # Remember to give an ID if you need the output filename
+  #       name: Download the expat library
+  #       with:
+  #         url: "https://github.com/libexpat/libexpat/releases/download/R_2_6_2/expat-win32bin-2.6.2.zip"
+  #         target: public/
+  #     - name: Set up Mariadb 🧰
+  #       uses: shogo82148/actions-setup-mysql@v1
+  #       with:
+  #         mysql-version: "mariadb-10.6"
+  #     - name: Setup PHP 🧰
+  #       uses: shivammathur/setup-php@v2
+  #       with:
+  #         php-version: "8.0"
+  #         extensions: mysqli
+  #     - name: Build and test 🏗 🧪
+  #       uses: freckle/stack-action@v5
+  #       with:
+  #         stack-build-arguments: "--copy-bins --flag ampersand:buildAll"
diff --git a/.github/workflows/release.yml b/.github/workflows/release.yml
index dae1e7043..da0eff396 100644
--- a/.github/workflows/release.yml
+++ b/.github/workflows/release.yml
@@ -64,7 +64,7 @@ jobs:
 
   add-release-artefacts:
     name: Add artefacts to release
-    needs: [build-and-test-ubuntu, build-and-test-macOS, build-and-test-windows]
+    needs: [build-and-test-ubuntu, build-and-test-macOS]
     runs-on: ubuntu-latest
     steps:
       - name: Download artifacts (Linux)
@@ -98,17 +98,17 @@ jobs:
           files: release/macOS/
           dest: release/macOS-binaries-v${{ steps.get-version.outputs.version }}.zip
 
-      - name: Download artifacts (Windows)
-        uses: actions/download-artifact@v2
-        with:
-          name: Windows-binaries
-          path: release/Windows
+      # - name: Download artifacts (Windows)
+      #   uses: actions/download-artifact@v2
+      #   with:
+      #     name: Windows-binaries
+      #     path: release/Windows
 
-      - name: zip the binaries (Windows)
-        uses: papeloto/action-zip@v1
-        with:
-          files: release/Windows/
-          dest: release/Windows-binaries-v${{ steps.get-version.outputs.version }}.zip
+      # - name: zip the binaries (Windows)
+      #   uses: papeloto/action-zip@v1
+      #   with:
+      #     files: release/Windows/
+      #     dest: release/Windows-binaries-v${{ steps.get-version.outputs.version }}.zip
 
       - name: Upload Linux artifact
         uses: actions/upload-release-asset@v1
@@ -130,15 +130,15 @@ jobs:
           asset_path: release/macOS-binaries-v${{ steps.get-version.outputs.version }}.zip
           asset_content_type: application/zip
 
-      - name: Upload Windows artifact
-        uses: actions/upload-release-asset@v1
-        env:
-          GITHUB_TOKEN: ${{ github.token }}
-        with:
-          upload_url: ${{ github.event.release.upload_url }}
-          asset_name: ampersand-${{ steps.get-version.outputs.version }}-Windows-binaries.zip
-          asset_path: release/Windows-binaries-v${{ steps.get-version.outputs.version }}.zip
-          asset_content_type: application/zip
+      # - name: Upload Windows artifact
+      #   uses: actions/upload-release-asset@v1
+      #   env:
+      #     GITHUB_TOKEN: ${{ github.token }}
+      #   with:
+      #     upload_url: ${{ github.event.release.upload_url }}
+      #     asset_name: ampersand-${{ steps.get-version.outputs.version }}-Windows-binaries.zip
+      #     asset_path: release/Windows-binaries-v${{ steps.get-version.outputs.version }}.zip
+      #     asset_content_type: application/zip
 
   build-and-test-ubuntu:
     name: Build and test on ubuntu-latest 🏗 🧪
@@ -184,36 +184,36 @@ jobs:
           name: macOS-binaries
           path: /Users/runner/.local/bin/*
 
-  build-and-test-windows:
-    name: Build and test on Windows 🏗 🧪
-    runs-on: windows-latest
-    steps:
-      - name: Checkout project contents 📡
-        uses: actions/checkout@v3
-      # - name: Use cache (manually) 📦 # See https://github.com/freckle/stack-cache-action/issues/5
-      # uses: actions/cache@v3.3.2
-      # # TODO: Cache might be done better, see for inspiration:  https://github.com/godu/advent-of-code-2020/blob/46796832f59d185457a8edf8de043a54a451d688/.github/workflows/ci.yml
-      # with:
-      #   path: |
-      #     ~/.ghc
-      #     ~/.stack
-      #     ~/.stack-work
-      #   key: ${{ runner.os }}-stack
-      - name: Set up Mariadb 🧰
-        uses: shogo82148/actions-setup-mysql@v1
-        with:
-          mysql-version: "mariadb-10.6"
-      - name: Setup PHP 🧰
-        uses: shivammathur/setup-php@v2
-        with:
-          php-version: "8.0"
-          extensions: mysqli
-      - name: Build and test 🏗 🧪
-        uses: freckle/stack-action@v5
-        with:
-          stack-build-arguments: "--copy-bins --flag ampersand:buildAll"
-      - name: Upload artifacts (Windows)
-        uses: actions/upload-artifact@v2
-        with:
-          name: Windows-binaries
-          path: C:\Users\runneradmin\AppData\Roaming\local\bin\*
+  # build-and-test-windows:
+  #   name: Build and test on Windows 🏗 🧪
+  #   runs-on: windows-latest
+  #   steps:
+  #     - name: Checkout project contents 📡
+  #       uses: actions/checkout@v3
+  #     # - name: Use cache (manually) 📦 # See https://github.com/freckle/stack-cache-action/issues/5
+  #     # uses: actions/cache@v3.3.2
+  #     # # TODO: Cache might be done better, see for inspiration:  https://github.com/godu/advent-of-code-2020/blob/46796832f59d185457a8edf8de043a54a451d688/.github/workflows/ci.yml
+  #     # with:
+  #     #   path: |
+  #     #     ~/.ghc
+  #     #     ~/.stack
+  #     #     ~/.stack-work
+  #     #   key: ${{ runner.os }}-stack
+  #     - name: Set up Mariadb 🧰
+  #       uses: shogo82148/actions-setup-mysql@v1
+  #       with:
+  #         mysql-version: "mariadb-10.6"
+  #     - name: Setup PHP 🧰
+  #       uses: shivammathur/setup-php@v2
+  #       with:
+  #         php-version: "8.0"
+  #         extensions: mysqli
+  #     - name: Build and test 🏗 🧪
+  #       uses: freckle/stack-action@v5
+  #       with:
+  #         stack-build-arguments: "--copy-bins --flag ampersand:buildAll"
+  #     - name: Upload artifacts (Windows)
+  #       uses: actions/upload-artifact@v2
+  #       with:
+  #         name: Windows-binaries
+  #         path: C:\Users\runneradmin\AppData\Roaming\local\bin\*
diff --git a/ReleaseNotes.md b/ReleaseNotes.md
index 0fb1b090d..2b9c1c9dd 100644
--- a/ReleaseNotes.md
+++ b/ReleaseNotes.md
@@ -1,5 +1,10 @@
 # Release notes of Ampersand
 
+## v5.1.0 (19 april 2024)
+
+- Upgrade development toolstack to ghc 9.6. This involved upgrades of several dependencies. 
+- We discontinue support for Windows. This is due to the upgrade of xlsx (used for the .xlsx reader/writer), which now uses hexpat. We see no longer value in supporting windows, because of the Docker support we have.
+
 ## v5.0.2 (21 february 2024)
 - Eliminated warnings and hints in CI/CD and in Haskell code. Doing some tests for a [strange issue with stack](https://github.com/commercialhaskell/stack/issues/6477)
 

From 6865cf7b061e8642281703626a0da3b2891504c7 Mon Sep 17 00:00:00 2001
From: hanjoosten <han.joosten@ordina.nl>
Date: Fri, 19 Apr 2024 17:13:26 +0200
Subject: [PATCH 30/43] Bump to version 5.1.0

---
 ampersand.cabal | 2 +-
 package.yaml    | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/ampersand.cabal b/ampersand.cabal
index 87edb514d..b98a01c91 100644
--- a/ampersand.cabal
+++ b/ampersand.cabal
@@ -5,7 +5,7 @@ cabal-version: 2.0
 -- see: https://github.com/sol/hpack
 
 name:           ampersand
-version:        5.0.2
+version:        5.1.0
 synopsis:       Toolsuite for automated design of enterprise information systems.
 description:    You can define your business processes by means of rules, written in Relation Algebra.
 category:       Database Design
diff --git a/package.yaml b/package.yaml
index f0f665adf..03a26df4f 100644
--- a/package.yaml
+++ b/package.yaml
@@ -1,5 +1,5 @@
 name: ampersand
-version: 5.0.2
+version: 5.1.0
 author: Stef Joosten
 maintainer: stef.joosten@ou.nl
 synopsis: Toolsuite for automated design of enterprise information systems.

From d32efe83347145b21b870ed2f5c1b5ef5522fb27 Mon Sep 17 00:00:00 2001
From: hanjoosten <han.joosten@ordina.nl>
Date: Fri, 19 Apr 2024 17:27:08 +0200
Subject: [PATCH 31/43] upgrade ormolu action to match our current version

---
 .github/workflows/ormolu-formatting-code.yml | 4 +++-
 1 file changed, 3 insertions(+), 1 deletion(-)

diff --git a/.github/workflows/ormolu-formatting-code.yml b/.github/workflows/ormolu-formatting-code.yml
index ceaf35d67..1ef4d795f 100644
--- a/.github/workflows/ormolu-formatting-code.yml
+++ b/.github/workflows/ormolu-formatting-code.yml
@@ -19,4 +19,6 @@ jobs:
       # The checkout step is needed since the enforcer relies on local git commands
       - uses: actions/checkout@v3
 
-      - uses: mrkkrp/ormolu-action@v4
+      - uses: mrkkrp/ormolu-action@v15
+        with:
+          version: "0.7.2.0"

From bcb4b80dafae7b25f280c5b4b9cf4797897b0069 Mon Sep 17 00:00:00 2001
From: hanjoosten <han.joosten@ordina.nl>
Date: Mon, 29 Apr 2024 16:26:55 +0200
Subject: [PATCH 32/43] Update FROM statement for release image

---
 Dockerfile            | 2 +-
 ReleaseNotes.md       | 4 ++--
 docs/docker/README.md | 2 +-
 3 files changed, 4 insertions(+), 4 deletions(-)

diff --git a/Dockerfile b/Dockerfile
index 1469f6dc5..2210fa5de 100644
--- a/Dockerfile
+++ b/Dockerfile
@@ -1,5 +1,5 @@
 # The purpose of this docker file is to produce a latest Ampersand-compiler in the form of a docker image.
-FROM haskell:8.10.7 AS buildstage
+FROM haskell:9.6.4 AS buildstage
 
 RUN mkdir /opt/ampersand
 WORKDIR /opt/ampersand
diff --git a/ReleaseNotes.md b/ReleaseNotes.md
index 2b9c1c9dd..4870fa6aa 100644
--- a/ReleaseNotes.md
+++ b/ReleaseNotes.md
@@ -1,8 +1,8 @@
 # Release notes of Ampersand
 
-## v5.1.0 (19 april 2024)
+## v5.1.0 (29 april 2024)
 
-- Upgrade development toolstack to ghc 9.6. This involved upgrades of several dependencies. 
+- Upgrade development toolstack to ghc 9.6.4 This involved upgrades of several dependencies. 
 - We discontinue support for Windows. This is due to the upgrade of xlsx (used for the .xlsx reader/writer), which now uses hexpat. We see no longer value in supporting windows, because of the Docker support we have.
 
 ## v5.0.2 (21 february 2024)
diff --git a/docs/docker/README.md b/docs/docker/README.md
index eeee543d3..6bbdc6557 100644
--- a/docs/docker/README.md
+++ b/docs/docker/README.md
@@ -7,7 +7,7 @@ description: >-
 
 # Ampersand and [Docker](https://docs.docker.com/get-started/overview/#images)
 Ampersand uses the following container images:
-1. **haskell:8.10.7(https://hub.docker.com/r/haskell:8.10.7)**  
+1. **haskell:9.6.4(https://hub.docker.com/r/haskell:9.6.4)**  
    This image features the Haskell compiler, which is used to compile the Ampersand compiler.
    It is used by ~/git/Ampersand/Dockerfile.
 2. **[debian:bullseye](https://hub.docker.com/_/debian)**  

From 982994fcbf983dd4acaf69bb1b2821b93fef4f32 Mon Sep 17 00:00:00 2001
From: hanjoosten <han.joosten@ordina.nl>
Date: Sat, 4 May 2024 07:17:35 +0200
Subject: [PATCH 33/43] Upgrade of stack is not required here, for it is
 handpicked earlier in the process

---
 .github/workflows/release.yml | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/.github/workflows/release.yml b/.github/workflows/release.yml
index da0eff396..fb3642b75 100644
--- a/.github/workflows/release.yml
+++ b/.github/workflows/release.yml
@@ -156,6 +156,7 @@ jobs:
         uses: freckle/stack-action@v5 # stack-action does all these steps: dependencies, build, test.
         with:
           stack-build-arguments: "--copy-bins --flag ampersand:buildAll"
+          upgrade-stack: false
       - name: Upload artifacts (Linux)
         uses: actions/upload-artifact@v2
         with:
@@ -178,6 +179,7 @@ jobs:
         uses: freckle/stack-action@v5
         with:
           stack-build-arguments: "--copy-bins --flag ampersand:buildAll --verbose"
+          upgrade-stack: false
       - name: Upload artifacts (macOS)
         uses: actions/upload-artifact@v2
         with:

From 66e5b6a0e85d9b40f5a960471dafd53da770a64f Mon Sep 17 00:00:00 2001
From: hanjoosten <han.joosten@ordina.nl>
Date: Sat, 4 May 2024 07:38:13 +0200
Subject: [PATCH 34/43] no need to test over and over each time

---
 .github/workflows/ci2.yml         | 4 ----
 .github/workflows/codeQuality.yml | 4 +---
 .github/workflows/release.yml     | 8 +++-----
 3 files changed, 4 insertions(+), 12 deletions(-)

diff --git a/.github/workflows/ci2.yml b/.github/workflows/ci2.yml
index dde13aa5a..6941393e7 100644
--- a/.github/workflows/ci2.yml
+++ b/.github/workflows/ci2.yml
@@ -41,8 +41,6 @@ jobs:
     steps:
       - name: Checkout project contents 📡
         uses: actions/checkout@v3
-      # - name: Use cache when available 📦
-      #   uses: freckle/stack-cache-action@main
       - name: Set up Mariadb 🧰
         uses: shogo82148/actions-setup-mysql@v1
         with:
@@ -58,8 +56,6 @@ jobs:
     steps:
       - name: Checkout project contents 📡
         uses: actions/checkout@v3
-      # - name: Use cache when available 📦
-      #   uses: freckle/stack-cache-action@main
       - name: Set up Mariadb 🧰
         uses: shogo82148/actions-setup-mysql@v1
         with:
diff --git a/.github/workflows/codeQuality.yml b/.github/workflows/codeQuality.yml
index ba942479f..903376566 100644
--- a/.github/workflows/codeQuality.yml
+++ b/.github/workflows/codeQuality.yml
@@ -23,10 +23,8 @@ jobs:
     steps:
       - name: Checkout project contents 📡
         uses: actions/checkout@v3.1.0
-      - name: Use cache when available 📦
-        uses: freckle/stack-cache-action@main
       - name: Build the project 🌿🌿🌿
-        uses: freckle/stack-action@v4
+        uses: freckle/stack-action@v5
         with:
           test: false
 
diff --git a/.github/workflows/release.yml b/.github/workflows/release.yml
index fb3642b75..14afdf268 100644
--- a/.github/workflows/release.yml
+++ b/.github/workflows/release.yml
@@ -146,8 +146,6 @@ jobs:
     steps:
       - name: Checkout project contents 📡
         uses: actions/checkout@v3
-      # - name: Use cache when available 📦
-      #   uses: freckle/stack-cache-action@main
       - name: Set up Mariadb 🧰
         uses: shogo82148/actions-setup-mysql@v1
         with:
@@ -157,6 +155,7 @@ jobs:
         with:
           stack-build-arguments: "--copy-bins --flag ampersand:buildAll"
           upgrade-stack: false
+          test: false
       - name: Upload artifacts (Linux)
         uses: actions/upload-artifact@v2
         with:
@@ -169,8 +168,6 @@ jobs:
     steps:
       - name: Checkout project contents 📡
         uses: actions/checkout@v3
-      # - name: Use cache when available 📦
-      #   uses: freckle/stack-cache-action@main
       - name: Set up Mariadb 🧰
         uses: shogo82148/actions-setup-mysql@v1
         with:
@@ -178,8 +175,9 @@ jobs:
       - name: Build and test  🏗 🧪
         uses: freckle/stack-action@v5
         with:
-          stack-build-arguments: "--copy-bins --flag ampersand:buildAll --verbose"
+          stack-build-arguments: "--copy-bins --flag ampersand:buildAll"
           upgrade-stack: false
+          test: false
       - name: Upload artifacts (macOS)
         uses: actions/upload-artifact@v2
         with:

From 8cf940072afbe7208a2f7186d7632779b164eb9e Mon Sep 17 00:00:00 2001
From: hanjoosten <han.joosten@ordina.nl>
Date: Sat, 4 May 2024 07:49:58 +0200
Subject: [PATCH 35/43] mac-os doesn't install stack by default

---
 .github/workflows/release.yml | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/.github/workflows/release.yml b/.github/workflows/release.yml
index 14afdf268..3efe281d2 100644
--- a/.github/workflows/release.yml
+++ b/.github/workflows/release.yml
@@ -172,6 +172,8 @@ jobs:
         uses: shogo82148/actions-setup-mysql@v1
         with:
           mysql-version: "mariadb-10.6"
+      # See issue https://github.com/freckle/stack-action/issues/80 for why we need to install stack
+      - run: curl -sSL https://get.haskellstack.org/ | sh
       - name: Build and test  🏗 🧪
         uses: freckle/stack-action@v5
         with:

From 9e32e3aadb13390e18ce9a4e4b27e9c95582f5dc Mon Sep 17 00:00:00 2001
From: hanjoosten <han.joosten@ordina.nl>
Date: Sat, 4 May 2024 07:54:06 +0200
Subject: [PATCH 36/43] fix mac-os build and test

---
 .github/workflows/ci2.yml | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/.github/workflows/ci2.yml b/.github/workflows/ci2.yml
index 6941393e7..74d17bb46 100644
--- a/.github/workflows/ci2.yml
+++ b/.github/workflows/ci2.yml
@@ -60,6 +60,8 @@ jobs:
         uses: shogo82148/actions-setup-mysql@v1
         with:
           mysql-version: "mariadb-10.6"
+      # See issue https://github.com/freckle/stack-action/issues/80 for why we need to install stack
+      - run: curl -sSL https://get.haskellstack.org/ | sh
       - name: Build and test  🏗 🧪
         uses: freckle/stack-action@v5
         with:

From be57c8c1fb0c0f22800fc23cb543a2c9ae99fc5f Mon Sep 17 00:00:00 2001
From: hanjoosten <han.joosten@ordina.nl>
Date: Sat, 4 May 2024 08:53:38 +0200
Subject: [PATCH 37/43] php is no longer autoinstalled on mac-os, so we have to
 do it ourselves

---
 .github/workflows/ci2.yml     |  3 ++-
 .github/workflows/release.yml | 24 +++++++++++++-----------
 2 files changed, 15 insertions(+), 12 deletions(-)

diff --git a/.github/workflows/ci2.yml b/.github/workflows/ci2.yml
index 74d17bb46..dd2de1672 100644
--- a/.github/workflows/ci2.yml
+++ b/.github/workflows/ci2.yml
@@ -60,8 +60,9 @@ jobs:
         uses: shogo82148/actions-setup-mysql@v1
         with:
           mysql-version: "mariadb-10.6"
-      # See issue https://github.com/freckle/stack-action/issues/80 for why we need to install stack
+      # See issue https://github.com/freckle/stack-action/issues/80 for why we need to install stack and php as well
       - run: curl -sSL https://get.haskellstack.org/ | sh
+      - run: brew install php
       - name: Build and test  🏗 🧪
         uses: freckle/stack-action@v5
         with:
diff --git a/.github/workflows/release.yml b/.github/workflows/release.yml
index 3efe281d2..9867bad7c 100644
--- a/.github/workflows/release.yml
+++ b/.github/workflows/release.yml
@@ -64,7 +64,7 @@ jobs:
 
   add-release-artefacts:
     name: Add artefacts to release
-    needs: [build-and-test-ubuntu, build-and-test-macOS]
+    needs: [build-without-test-ubuntu, build-without-test-macOS]
     runs-on: ubuntu-latest
     steps:
       - name: Download artifacts (Linux)
@@ -140,8 +140,8 @@ jobs:
       #     asset_path: release/Windows-binaries-v${{ steps.get-version.outputs.version }}.zip
       #     asset_content_type: application/zip
 
-  build-and-test-ubuntu:
-    name: Build and test on ubuntu-latest 🏗 🧪
+  build-without-test-ubuntu:
+    name: Build without test on ubuntu-latest 🏗 🧪
     runs-on: ubuntu-latest
     steps:
       - name: Checkout project contents 📡
@@ -150,7 +150,7 @@ jobs:
         uses: shogo82148/actions-setup-mysql@v1
         with:
           mysql-version: "mariadb-10.6"
-      - name: Build and test 🏗 🧪
+      - name: build without test 🏗 🧪
         uses: freckle/stack-action@v5 # stack-action does all these steps: dependencies, build, test.
         with:
           stack-build-arguments: "--copy-bins --flag ampersand:buildAll"
@@ -162,8 +162,8 @@ jobs:
           name: Linux-binaries
           path: /home/runner/.local/bin/*
 
-  build-and-test-macOS:
-    name: Build and test on macOS  🏗 🧪
+  build-without-test-macOS:
+    name: Build without test on macOS  🏗 🧪
     runs-on: macos-latest
     steps:
       - name: Checkout project contents 📡
@@ -172,9 +172,10 @@ jobs:
         uses: shogo82148/actions-setup-mysql@v1
         with:
           mysql-version: "mariadb-10.6"
-      # See issue https://github.com/freckle/stack-action/issues/80 for why we need to install stack
+      # See issue https://github.com/freckle/stack-action/issues/80 for why we need to install stack and php as well
       - run: curl -sSL https://get.haskellstack.org/ | sh
-      - name: Build and test  🏗 🧪
+      - run: brew install php
+      - name: Build without test  🏗 🧪
         uses: freckle/stack-action@v5
         with:
           stack-build-arguments: "--copy-bins --flag ampersand:buildAll"
@@ -186,8 +187,8 @@ jobs:
           name: macOS-binaries
           path: /Users/runner/.local/bin/*
 
-  # build-and-test-windows:
-  #   name: Build and test on Windows 🏗 🧪
+  # build-without-test-windows:
+  #   name: build without test on Windows 🏗 🧪
   #   runs-on: windows-latest
   #   steps:
   #     - name: Checkout project contents 📡
@@ -210,10 +211,11 @@ jobs:
   #       with:
   #         php-version: "8.0"
   #         extensions: mysqli
-  #     - name: Build and test 🏗 🧪
+  #     - name: build without test 🏗 🧪
   #       uses: freckle/stack-action@v5
   #       with:
   #         stack-build-arguments: "--copy-bins --flag ampersand:buildAll"
+  #         test: false
   #     - name: Upload artifacts (Windows)
   #       uses: actions/upload-artifact@v2
   #       with:

From aaf0591e5874ba13c0e38950b75dd0399a5cad1b Mon Sep 17 00:00:00 2001
From: hanjoosten <han.joosten@ordina.nl>
Date: Sat, 4 May 2024 09:48:22 +0200
Subject: [PATCH 38/43] upgrade the devcontainer for ampersand 5

---
 .devcontainer/Dockerfile         | 2 +-
 .devcontainer/DockerfileUpstream | 1 +
 .devcontainer/README.md          | 6 ++++--
 .devcontainer/devcontainer.json  | 2 +-
 4 files changed, 7 insertions(+), 4 deletions(-)

diff --git a/.devcontainer/Dockerfile b/.devcontainer/Dockerfile
index 350119612..bc717a842 100644
--- a/.devcontainer/Dockerfile
+++ b/.devcontainer/Dockerfile
@@ -1,4 +1,4 @@
-FROM ampersandtarski/ampersand-devcontainer:ghc9
+FROM ampersandtarski/ampersand-devcontainer:ghc9-6-4
 
 ENV DEBIAN_FRONTEND=dialog
 
diff --git a/.devcontainer/DockerfileUpstream b/.devcontainer/DockerfileUpstream
index 0e2c8a679..77b533eab 100644
--- a/.devcontainer/DockerfileUpstream
+++ b/.devcontainer/DockerfileUpstream
@@ -24,6 +24,7 @@ RUN \
     gcc \
     git \
     gnupg2 \
+    graphviz \
     libbz2-dev \
     libexpat1-dev \
     libgmp-dev \
diff --git a/.devcontainer/README.md b/.devcontainer/README.md
index 0a45af780..8df9788d2 100644
--- a/.devcontainer/README.md
+++ b/.devcontainer/README.md
@@ -20,7 +20,9 @@ NB: This action is currently done by Han, no need for other people to do so. It
 Sometimes there are updates of the Haskell toolchain we use. For instance whenever a new version of the Haskell Language Server is made available, the `DockerfileUpstream` should be updated accordingly. Then, the new image should be built and published at dockerhub. To do so, go to the ampersand root directory and run the following commands:
 
 ```
-docker build -f .devcontainer/DockerfileUpstream -t ampersandtarski/ampersand-devcontainer:latest .
-docker push ampersandtarski/ampersand-devcontainer:latest
+docker build -f .devcontainer/DockerfileUpstream -t ampersandtarski/ampersand-devcontainer:<tag> .
+docker push ampersandtarski/ampersand-devcontainer:<tag>
 
 ```
+
+where `<tag>` must be replaced with an appropriate new tagname reflecting the version of ghc.
diff --git a/.devcontainer/devcontainer.json b/.devcontainer/devcontainer.json
index c4a64b1b1..d88e4dc28 100644
--- a/.devcontainer/devcontainer.json
+++ b/.devcontainer/devcontainer.json
@@ -1,5 +1,5 @@
 {
-  "name": "DevContainer for Ampersand",
+  "name": "Ampersand 5 devcontainer",
   // "remoteUser": "root",
   "runArgs": [],
   "build": {

From f2a2cd502ddd1982d60cef251b0481b530abfbfc Mon Sep 17 00:00:00 2001
From: hanjoosten <han.joosten@ordina.nl>
Date: Sun, 12 May 2024 17:55:06 +0200
Subject: [PATCH 39/43] Don't upgrade stack, it has already the correct version

---
 .github/workflows/ci2.yml | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/.github/workflows/ci2.yml b/.github/workflows/ci2.yml
index dd2de1672..0487ea5e4 100644
--- a/.github/workflows/ci2.yml
+++ b/.github/workflows/ci2.yml
@@ -49,6 +49,8 @@ jobs:
         uses: freckle/stack-action@v5 # stack-action does all these steps: dependencies, build, test.
         with:
           stack-build-arguments: "--copy-bins --flag ampersand:buildAll"
+          upgrade-stack: false
+          cache-save-always: true
 
   build-and-test-macOS:
     name: Build and test on macOS  🏗 🧪

From 79b8e6597f5e0e8aa2ab2b7cb23e77b9f32181e1 Mon Sep 17 00:00:00 2001
From: hanjoosten <han.joosten@ordina.nl>
Date: Sun, 12 May 2024 22:08:38 +0200
Subject: [PATCH 40/43] Add ssh support to devcontainer

---
 .devcontainer/Dockerfile         | 2 +-
 .devcontainer/DockerfileUpstream | 1 +
 .devcontainer/devcontainer.json  | 6 +++++-
 3 files changed, 7 insertions(+), 2 deletions(-)

diff --git a/.devcontainer/Dockerfile b/.devcontainer/Dockerfile
index bc717a842..c26373161 100644
--- a/.devcontainer/Dockerfile
+++ b/.devcontainer/Dockerfile
@@ -1,4 +1,4 @@
-FROM ampersandtarski/ampersand-devcontainer:ghc9-6-4
+FROM ampersandtarski/ampersand-devcontainer:ghc9-6-4_1
 
 ENV DEBIAN_FRONTEND=dialog
 
diff --git a/.devcontainer/DockerfileUpstream b/.devcontainer/DockerfileUpstream
index 77b533eab..cb96ff3ac 100644
--- a/.devcontainer/DockerfileUpstream
+++ b/.devcontainer/DockerfileUpstream
@@ -31,6 +31,7 @@ RUN \
     libgmp10 \
     libnuma-dev \
     lsb-release \
+    openssh-server \
     pkg-config \
     software-properties-common \
     wget \
diff --git a/.devcontainer/devcontainer.json b/.devcontainer/devcontainer.json
index d88e4dc28..4fe1d94ff 100644
--- a/.devcontainer/devcontainer.json
+++ b/.devcontainer/devcontainer.json
@@ -6,8 +6,12 @@
     "context": "..",
     "dockerfile": "Dockerfile"
   },
+  "mounts": [
+    "type=bind,source=${localWorkspaceFolder},target=/work",
+    "type=bind,source=/home/${localEnv:USER}/.ssh,target=/home/vscode/.ssh,readonly"
+  ],
   // "postCreateCommand": "sudo apt-get update && sudo apt-get install -y openssh-client",
-  "postStartCommand": "stack build",
+  //  "postStartCommand": "stack build",
   "customizations": {
     "vscode": {
       "extensions": [

From acf471568212a62bec41a458525cf40832fba8e3 Mon Sep 17 00:00:00 2001
From: hanjoosten <han.joosten@ordina.nl>
Date: Sun, 12 May 2024 22:43:15 +0200
Subject: [PATCH 41/43] minor fix devcontainer

---
 .devcontainer/devcontainer.json | 3 +--
 1 file changed, 1 insertion(+), 2 deletions(-)

diff --git a/.devcontainer/devcontainer.json b/.devcontainer/devcontainer.json
index 4fe1d94ff..ed2d4705b 100644
--- a/.devcontainer/devcontainer.json
+++ b/.devcontainer/devcontainer.json
@@ -10,8 +10,7 @@
     "type=bind,source=${localWorkspaceFolder},target=/work",
     "type=bind,source=/home/${localEnv:USER}/.ssh,target=/home/vscode/.ssh,readonly"
   ],
-  // "postCreateCommand": "sudo apt-get update && sudo apt-get install -y openssh-client",
-  //  "postStartCommand": "stack build",
+  "postStartCommand": "stack build",
   "customizations": {
     "vscode": {
       "extensions": [

From 085e41a7724cf15869b27b8b2e1b35cd44ea7c5a Mon Sep 17 00:00:00 2001
From: hanjoosten <han.joosten@ordina.nl>
Date: Tue, 14 May 2024 22:51:11 +0200
Subject: [PATCH 42/43] Add line history plugin

---
 .devcontainer/devcontainer.json | 26 +++++++++++++-------------
 1 file changed, 13 insertions(+), 13 deletions(-)

diff --git a/.devcontainer/devcontainer.json b/.devcontainer/devcontainer.json
index ed2d4705b..1cae29b00 100644
--- a/.devcontainer/devcontainer.json
+++ b/.devcontainer/devcontainer.json
@@ -7,28 +7,28 @@
     "dockerfile": "Dockerfile"
   },
   "mounts": [
-    "type=bind,source=${localWorkspaceFolder},target=/work",
-    "type=bind,source=/home/${localEnv:USER}/.ssh,target=/home/vscode/.ssh,readonly"
+    "type=bind,source=${localEnv:HOME}${localEnv:USERPROFILE}/.ssh/,target=/home/vscode/.ssh,readonly"
   ],
   "postStartCommand": "stack build",
   "customizations": {
     "vscode": {
       "extensions": [
-        "haskell.haskell",
-        "justusadam.language-haskell",
-        "phoityne.phoityne-vscode",
+        "ampersandtarski.language-ampersand",
+        // Because of bug (see https://github.com/Microsoft/vscode/issues/45997):
+        "bdsoftware.format-on-auto-save",
+        "eamodio.gitlens",
+        "editorconfig.editorconfig",
         "eriksik2.vscode-ghci",
-        "jcanero.hoogle-vscode",
         "github.vscode-pull-request-github",
-        "eamodio.gitlens",
+        "haskell.haskell",
+        "huizhou.githd",
+        "jcanero.hoogle-vscode",
+        "justusadam.language-haskell",
         "me-dutour-mathieu.vscode-github-actions",
-        "redhat.vscode-yaml",
-        "ampersandtarski.language-ampersand",
         "mhutchie.git-graph",
-        "editorconfig.editorconfig",
-        // Because of bug (see https://github.com/Microsoft/vscode/issues/45997):
-        "bdsoftware.format-on-auto-save",
-        "rcook.ghci-helper"
+        "phoityne.phoityne-vscode",
+        "redhat.vscode-yaml",
+        "tintinweb.graphviz-interactive-preview"
       ],
       "settings": {
         "editor.formatonsave": true,

From 9d2ad3f4786f5da2ac565916d61e3b5bfdd5bcaf Mon Sep 17 00:00:00 2001
From: hanjoosten <han.joosten@ordina.nl>
Date: Wed, 15 May 2024 22:16:34 +0200
Subject: [PATCH 43/43] bump version to 5.1.1

---
 ReleaseNotes.md | 3 +++
 ampersand.cabal | 2 +-
 package.yaml    | 2 +-
 3 files changed, 5 insertions(+), 2 deletions(-)

diff --git a/ReleaseNotes.md b/ReleaseNotes.md
index 4870fa6aa..76ae89519 100644
--- a/ReleaseNotes.md
+++ b/ReleaseNotes.md
@@ -1,5 +1,8 @@
 # Release notes of Ampersand
 
+## v5.1.1 (16 may 2024)
+- Some enhancements for the .devcontainer
+
 ## v5.1.0 (29 april 2024)
 
 - Upgrade development toolstack to ghc 9.6.4 This involved upgrades of several dependencies. 
diff --git a/ampersand.cabal b/ampersand.cabal
index b98a01c91..f56bf84b0 100644
--- a/ampersand.cabal
+++ b/ampersand.cabal
@@ -5,7 +5,7 @@ cabal-version: 2.0
 -- see: https://github.com/sol/hpack
 
 name:           ampersand
-version:        5.1.0
+version:        5.1.1
 synopsis:       Toolsuite for automated design of enterprise information systems.
 description:    You can define your business processes by means of rules, written in Relation Algebra.
 category:       Database Design
diff --git a/package.yaml b/package.yaml
index 03a26df4f..3ecb99d2d 100644
--- a/package.yaml
+++ b/package.yaml
@@ -1,5 +1,5 @@
 name: ampersand
-version: 5.1.0
+version: 5.1.1
 author: Stef Joosten
 maintainer: stef.joosten@ou.nl
 synopsis: Toolsuite for automated design of enterprise information systems.