diff --git a/.devcontainer/Dockerfile b/.devcontainer/Dockerfile
new file mode 100644
index 0000000..bccc565
--- /dev/null
+++ b/.devcontainer/Dockerfile
@@ -0,0 +1,30 @@
+ARG UBUNTU_TAG=20.04
+FROM ubuntu:"$UBUNTU_TAG"
+
+ENV LANG=C.UTF-8
+RUN \
+ apt-get update && \
+ apt-get install --assume-yes curl gcc git libgmp-dev libtinfo-dev make sudo
+
+ARG GHCUP_VERSION=0.1.17.3
+RUN \
+ curl --output /usr/local/bin/ghcup "https://downloads.haskell.org/~ghcup/$GHCUP_VERSION/x86_64-linux-ghcup-$GHCUP_VERSION" && \
+ chmod +x /usr/local/bin/ghcup && \
+ ghcup --version
+
+ARG USER_NAME=haskell
+RUN \
+ useradd --create-home --shell "$( which bash )" "$USER_NAME" && \
+ echo "$USER_NAME ALL=(ALL) NOPASSWD: ALL" | tee "/etc/sudoers.d/$USER_NAME"
+USER "$USER_NAME"
+ENV PATH="/home/$USER_NAME/.cabal/bin:/home/$USER_NAME/.ghcup/bin:$PATH"
+
+ARG GHC_VERSION=9.0.1
+RUN \
+ ghcup install ghc "$GHC_VERSION" --set && \
+ ghc --version
+
+ARG CABAL_VERSION=3.6.2.0
+RUN \
+ ghcup install cabal "$CABAL_VERSION" --set && \
+ cabal --version
diff --git a/.devcontainer/devcontainer.json b/.devcontainer/devcontainer.json
new file mode 100644
index 0000000..582acff
--- /dev/null
+++ b/.devcontainer/devcontainer.json
@@ -0,0 +1,6 @@
+{
+ "build": {
+ "dockerfile": "Dockerfile"
+ },
+ "postCreateCommand": "cabal update"
+}
diff --git a/.github/workflows/ci.yaml b/.github/workflows/ci.yaml
index 466e206..11b88e8 100644
--- a/.github/workflows/ci.yaml
+++ b/.github/workflows/ci.yaml
@@ -2,38 +2,33 @@ name: CI
on:
pull_request:
branches:
- - master
+ - main
push:
branches:
- - master
+ - main
+ release:
+ types:
+ - created
jobs:
build:
strategy:
fail-fast: false
matrix:
- os:
- - macos-10.15
- - ubuntu-18.04
- - windows-2019
- ghc:
- - 8.10.2
- cabal:
- - 3.2.0.0
include:
- - os: ubuntu-18.04
- ghc: 8.8.4
- cabal: 3.2.0.0
- - os: ubuntu-18.04
- ghc: 8.6.5
- cabal: 3.2.0.0
+ - { os: macos-11, ghc: 9.0.1, cabal: 3.6.2.0 }
+ - { os: ubuntu-20.04, ghc: 9.0.1, cabal: 3.6.2.0 }
+ - { os: windows-2019, ghc: 9.0.1, cabal: 3.6.2.0, ext: .exe }
runs-on: ${{ matrix.os }}
steps:
- uses: actions/checkout@v2
+ - run: mkdir artifact
+ - run: mkdir artifact/${{ matrix.os }}
- id: setup-haskell
- uses: actions/setup-haskell@v1
+ uses: haskell/actions/setup@v1
with:
ghc-version: ${{ matrix.ghc }}
cabal-version: ${{ matrix.cabal }}
+ - run: cabal configure --enable-tests --flags pedantic --jobs
- run: cabal freeze
- run: cat cabal.project.freeze
- uses: actions/cache@v2
@@ -43,24 +38,66 @@ jobs:
restore-keys: |
${{ matrix.os }}-${{ matrix.ghc }}-${{ matrix.cabal }}-
${{ matrix.os }}-${{ matrix.ghc }}-
+ - run: cabal build
+ - run: cabal install --installdir artifact/${{ matrix.os }} --install-method copy
- run: cabal test --test-show-details direct
- - run: cabal install --installdir output --install-method copy
- - run: strip output/brittany*
+ - run: cabal check
+ - run: cabal sdist --output-dir artifact/${{ matrix.os }}
+ - uses: svenstaro/upx-action@v2
+ with:
+ file: artifact/${{ matrix.os }}/brittany${{ matrix.ext }}
- uses: actions/upload-artifact@v2
with:
- path: output/brittany*
- name: brittany-${{ matrix.os }}-ghc-${{ matrix.ghc }}-${{ github.sha }}
- - if: matrix.os == 'ubuntu-18.04' && matrix.ghc == '8.10.2'
- uses: actions/upload-artifact@v2
- with:
- path: dist-newstyle/sdist/brittany-*.tar.gz
- name: brittany-${{ github.sha }}.tar.gz
- - run: cabal check
+ path: artifact
+ name: brittany-${{ github.sha }}
-
- nix:
- runs-on: ubuntu-latest
+ release:
+ needs: build
+ if: github.event_name == 'release'
+ runs-on: ubuntu-20.04
steps:
- - uses: cachix/install-nix-action@v12
+
- uses: actions/checkout@v2
- - run: nix-build
+
+ - uses: actions/download-artifact@v2
+ with:
+ name: brittany-${{ github.sha }}
+ path: artifact
+
+ - uses: actions/upload-release-asset@v1
+ env:
+ GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }}
+ with:
+ asset_content_type: application/octet-stream
+ asset_name: brittany-${{ github.event.release.tag_name }}-ubuntu
+ asset_path: artifact/ubuntu-20.04/brittany
+ upload_url: ${{ github.event.release.upload_url }}
+
+ - uses: actions/upload-release-asset@v1
+ env:
+ GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }}
+ with:
+ asset_content_type: application/octet-stream
+ asset_name: brittany-${{ github.event.release.tag_name }}-macos
+ asset_path: artifact/macos-11/brittany
+ upload_url: ${{ github.event.release.upload_url }}
+
+ - uses: actions/upload-release-asset@v1
+ env:
+ GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }}
+ with:
+ asset_content_type: application/octet-stream
+ asset_name: brittany-${{ github.event.release.tag_name }}-windows.exe
+ asset_path: artifact/windows-2019/brittany.exe
+ upload_url: ${{ github.event.release.upload_url }}
+
+ - uses: actions/upload-release-asset@v1
+ env:
+ GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }}
+ with:
+ asset_content_type: application/gzip
+ asset_name: brittany-${{ github.event.release.tag_name }}.tar.gz
+ asset_path: artifact/ubuntu-20.04/brittany-${{ github.event.release.tag_name }}.tar.gz
+ upload_url: ${{ github.event.release.upload_url }}
+
+ - run: cabal upload --publish --username '${{ secrets.HACKAGE_USERNAME }}' --password '${{ secrets.HACKAGE_PASSWORD }}' artifact/ubuntu-20.04/brittany-${{ github.event.release.tag_name }}.tar.gz
diff --git a/.gitignore b/.gitignore
index 4cdb828..cdc020e 100644
--- a/.gitignore
+++ b/.gitignore
@@ -8,9 +8,8 @@ dist/
dist-newstyle/
local/
.cabal-sandbox/
-.stack-work/
cabal.sandbox.config
-cabal.project.local
+cabal.project.local*
+cabal.project.freeze
.ghc.environment.*
result
-.stack-work*
diff --git a/.hlint.yaml b/.hlint.yaml
index 6fecf6a..191512f 100644
--- a/.hlint.yaml
+++ b/.hlint.yaml
@@ -5,20 +5,12 @@
# This file contains a template configuration file, which is typically
# placed as .hlint.yaml in the root of your project
-# Specify additional command line arguments
-
-- arguments:
- [ "--cpp-include=srcinc"
- , "--language=GADTs"
- , "--language=LambdaCase"
- , "--language=MultiWayIf"
- , "--language=KindSignatures"
- , "--cross"
- , "--threads=0"
- ]
-
-- ignore: {name: "Use camelCase"}
-- ignore: {name: "Redundant as"}
+- ignore: { name: 'Use :' }
+- ignore: { name: Eta reduce }
+- ignore: { name: Move brackets to avoid $ }
+- ignore: { name: Redundant $ }
+- ignore: { name: Redundant bracket }
+- ignore: { name: Use newtype instead of data }
- ignore: {name: "Redundant do"}
- ignore: {name: "Redundant return"}
-- ignore: {name: "Redundant guard", whithin: "lrdrNameToTextAnn"}
+- ignore: {name: "Use camelCase"}
diff --git a/.travis.yml b/.travis.yml
deleted file mode 100644
index ee15e0e..0000000
--- a/.travis.yml
+++ /dev/null
@@ -1 +0,0 @@
-language: minimal
diff --git a/.vscode/extensions.json b/.vscode/extensions.json
new file mode 100644
index 0000000..c51a4b2
--- /dev/null
+++ b/.vscode/extensions.json
@@ -0,0 +1,5 @@
+{
+ "recommendations": [
+ "taylorfausak.purple-yolk"
+ ]
+}
diff --git a/.vscode/settings.json b/.vscode/settings.json
new file mode 100644
index 0000000..8b52b40
--- /dev/null
+++ b/.vscode/settings.json
@@ -0,0 +1,6 @@
+{
+ "purple-yolk.brittany.command": "cabal exec -- brittany --write-mode inplace",
+ "purple-yolk.ghci.command": "cabal repl --repl-options -ddump-json",
+ "purple-yolk.hlint.command": "false",
+ "purple-yolk.hlint.onSave": false
+}
diff --git a/ChangeLog.md b/ChangeLog.md
index c96c598..baf8314 100644
--- a/ChangeLog.md
+++ b/ChangeLog.md
@@ -1,5 +1,12 @@
# Revision history for brittany
+## 0.14.0.0 -- November 2021
+
+* #357: Added support for GHC 9.0. Dropped support for all other versions of GHC.
+ * ab59e9acc3069551ac4132321b285d000f5f5691: Removed runtime dependency on `ghc-paths`.
+ * fa8365a7fa9372043d5a1018f2f7669ce3853edd: Started providing pre-built binaries for Linux, MacOS, and Windows.
+ * Many other changes to Brittany's internals and exposed Haskell interface, but (hopefully) no changes to its command-line interface.
+
## 0.13.1.2 -- May 2021
* #347: Allowed hspec 2.8. Thanks @felixonmars!
diff --git a/Makefile b/Makefile
deleted file mode 100644
index 2d5b809..0000000
--- a/Makefile
+++ /dev/null
@@ -1,18 +0,0 @@
-.PHONY: test
-test:
- echo "test"
- stack test
-
-.PHONY: test-all
-test-all:
- $(MAKE) test test-8.8.4 test-8.6.5
-
-.PHONY: test-8.8.4
-test-8.8.4:
- echo "test 8.8.4"
- stack test --stack-yaml stack-8.8.4.yaml --work-dir .stack-work-8.8.4
-
-.PHONY: test-8.6.5
-test-8.6.5:
- echo "test 8.6.5"
- stack test --stack-yaml stack-8.6.5.yaml --work-dir .stack-work-8.6.5
diff --git a/README.md b/README.md
index 5ee23ac..76ad1bf 100644
--- a/README.md
+++ b/README.md
@@ -48,7 +48,7 @@ log the size of the input, but _not_ the full input/output of requests.)
# Other usage notes
-- Supports GHC versions `8.6`, `8.8`, `8.10`.
+- Supports GHC version `9.0.x`.
- included in stackage with lts>=10.0 (or nightlies dating to >=2017-11-15)
- config (file) documentation is lacking.
- some config values can not be configured via commandline yet.
@@ -65,14 +65,7 @@ log the size of the input, but _not_ the full input/output of requests.)
~~~~
If you use an lts that includes brittany this should just work; otherwise
- you may want to clone the repo and try again (there are several stack.yamls
- included).
-
-- via `nix`:
- ~~~.sh
- nix build
- nix-env -i ./result
- ~~~
+ you may want to clone the repo and try again.
- via `cabal`
@@ -103,18 +96,6 @@ log the size of the input, but _not_ the full input/output of requests.)
# Development tips
-## Run a hoogle server
-
-To host a local Hoogle server with all of Brittany's dependencies run:
-
-```sh
-echo brittany.cabal |
- $(nix-build '<nixpkgs>' --no-link -A entr)/bin/entr -r -- \
- sh -c "nix-shell --run 'hoogle server --local'"
-```
-
-This will watch `brittany.cabal` for changes and restart the server when new dependencies are added there.
-
# Editor Integration
#### Sublime text
diff --git a/Setup.hs b/Setup.hs
deleted file mode 100644
index 9a994af..0000000
--- a/Setup.hs
+++ /dev/null
@@ -1,2 +0,0 @@
-import Distribution.Simple
-main = defaultMain
diff --git a/brittany.cabal b/brittany.cabal
index fa058f4..45b6a65 100644
--- a/brittany.cabal
+++ b/brittany.cabal
@@ -1,14 +1,15 @@
+cabal-version: 2.2
+
name: brittany
-version: 0.13.1.2
+version: 0.14.0.0
synopsis: Haskell source code formatter
-description: {
+description:
See <https://github.com/lspitzner/brittany/blob/master/README.md the README>.
.
If you are interested in the implementation, have a look at <https://github.com/lspitzner/brittany/blob/master/doc/implementation/theory.md this document>;
.
The implementation is documented in more detail <https://github.com/lspitzner/brittany/blob/master/doc/implementation/index.md here>.
-}
-license: AGPL-3
+license: AGPL-3.0-only
license-file: LICENSE
author: Lennart Spitzner
maintainer: Lennart Spitzner <hexagoxel@hexagoxel.de>
@@ -16,326 +17,133 @@ copyright: Copyright (C) 2016-2019 Lennart Spitzner
Copyright (C) 2019 PRODA LTD
category: Language
build-type: Simple
-cabal-version: 1.18
homepage: https://github.com/lspitzner/brittany/
bug-reports: https://github.com/lspitzner/brittany/issues
-extra-doc-files: {
+extra-doc-files:
ChangeLog.md
README.md
doc/implementation/*.md
-}
-extra-source-files: {
- src-literatetests/*.blt
- srcinc/prelude.inc
-}
+extra-source-files:
+ data/brittany.yaml
+ data/*.hs
-source-repository head {
+source-repository head
type: git
location: https://github.com/lspitzner/brittany.git
-}
-flag brittany-dev-lib
- description: set buildable false for anything but lib
+flag pedantic
default: False
+ description: Enables @-Werror@, which turns warnings into errors.
manual: True
-flag brittany-test-perf
- description: determines if performance test suite is enabled
- default: False
- manual: True
+common library
+ build-depends:
+ , aeson ^>= 2.0.1
+ , base ^>= 4.15.0
+ , butcher ^>= 1.3.3
+ , bytestring ^>= 0.10.12
+ , cmdargs ^>= 0.10.21
+ , containers ^>= 0.6.4
+ , czipwith ^>= 1.0.1
+ , data-tree-print ^>= 0.1.0
+ , deepseq ^>= 1.4.5
+ , directory ^>= 1.3.6
+ , extra ^>= 1.7.10
+ , filepath ^>= 1.4.2
+ , ghc ^>= 9.0.1
+ , ghc-boot ^>= 9.0.1
+ , ghc-boot-th ^>= 9.0.1
+ , ghc-exactprint ^>= 0.6.4
+ , monad-memo ^>= 0.5.3
+ , mtl ^>= 2.2.2
+ , multistate ^>= 0.8.0
+ , pretty ^>= 1.1.3
+ , random ^>= 1.2.1
+ , safe ^>= 0.3.19
+ , semigroups ^>= 0.19.2
+ , strict ^>= 0.4.0
+ , syb ^>= 0.7.2
+ , text ^>= 1.2.5
+ , transformers ^>= 0.5.6
+ , uniplate ^>= 1.6.13
+ , yaml ^>= 0.11.7
+ default-language: Haskell2010
+ ghc-options:
+ -Weverything
+ -Wno-all-missed-specialisations
+ -Wno-incomplete-uni-patterns
+ -Wno-missing-deriving-strategies
+ -Wno-missing-export-lists
+ -Wno-missing-import-lists
+ -Wno-missing-local-signatures
+ -Wno-missing-safe-haskell-mode
+ -Wno-monomorphism-restriction
+ -Wno-prepositive-qualified-module
+ -Wno-safe
+ -Wno-unsafe
-library {
- default-language:
- Haskell2010
- hs-source-dirs:
- src
- include-dirs:
- srcinc
- exposed-modules: {
+ if flag(pedantic)
+ ghc-options: -Werror
+
+common executable
+ import: library
+
+ build-depends: brittany
+ ghc-options:
+ -rtsopts
+ -threaded
+ -Wno-implicit-prelude
+ -Wno-unused-packages
+
+library
+ import: library
+
+ autogen-modules: Paths_brittany
+ hs-source-dirs: source/library
+ exposed-modules:
Language.Haskell.Brittany
- Language.Haskell.Brittany.Main
Language.Haskell.Brittany.Internal
- Language.Haskell.Brittany.Internal.Prelude
- Language.Haskell.Brittany.Internal.PreludeUtils
- Language.Haskell.Brittany.Internal.Types
- Language.Haskell.Brittany.Internal.Utils
+ Language.Haskell.Brittany.Internal.Backend
+ Language.Haskell.Brittany.Internal.BackendUtils
Language.Haskell.Brittany.Internal.Config
Language.Haskell.Brittany.Internal.Config.Types
Language.Haskell.Brittany.Internal.Config.Types.Instances
- Language.Haskell.Brittany.Internal.Obfuscation
- Paths_brittany
- }
- other-modules: {
- Language.Haskell.Brittany.Internal.LayouterBasics
- Language.Haskell.Brittany.Internal.Backend
- Language.Haskell.Brittany.Internal.BackendUtils
Language.Haskell.Brittany.Internal.ExactPrintUtils
- Language.Haskell.Brittany.Internal.Layouters.Type
+ Language.Haskell.Brittany.Internal.LayouterBasics
+ Language.Haskell.Brittany.Internal.Layouters.DataDecl
Language.Haskell.Brittany.Internal.Layouters.Decl
Language.Haskell.Brittany.Internal.Layouters.Expr
- Language.Haskell.Brittany.Internal.Layouters.Stmt
- Language.Haskell.Brittany.Internal.Layouters.Pattern
Language.Haskell.Brittany.Internal.Layouters.IE
Language.Haskell.Brittany.Internal.Layouters.Import
Language.Haskell.Brittany.Internal.Layouters.Module
- Language.Haskell.Brittany.Internal.Layouters.DataDecl
+ Language.Haskell.Brittany.Internal.Layouters.Pattern
+ Language.Haskell.Brittany.Internal.Layouters.Stmt
+ Language.Haskell.Brittany.Internal.Layouters.Type
+ Language.Haskell.Brittany.Internal.Obfuscation
+ Language.Haskell.Brittany.Internal.ParseModule
+ Language.Haskell.Brittany.Internal.Prelude
+ Language.Haskell.Brittany.Internal.PreludeUtils
Language.Haskell.Brittany.Internal.Transformations.Alt
- Language.Haskell.Brittany.Internal.Transformations.Floating
- Language.Haskell.Brittany.Internal.Transformations.Par
Language.Haskell.Brittany.Internal.Transformations.Columns
+ Language.Haskell.Brittany.Internal.Transformations.Floating
Language.Haskell.Brittany.Internal.Transformations.Indent
- }
- ghc-options: {
- -Wall
- -fno-warn-unused-imports
- -fno-warn-redundant-constraints
- }
- build-depends:
- { base >=4.12 && <4.15
- , ghc >=8.6.1 && <8.11
- , ghc-paths >=0.1.0.9 && <0.2
- , ghc-exactprint >=0.5.8 && <0.6.5
- , transformers >=0.5.2.0 && <0.6
- , containers >=0.5.7.1 && <0.7
- , mtl >=2.2.1 && <2.3
- , text >=1.2 && <1.3
- , multistate >=0.7.1.1 && <0.9
- , syb >=0.6 && <0.8
- , data-tree-print
- , pretty >=1.1.3.3 && <1.2
- , bytestring >=0.10.8.1 && <0.11
- , directory >=1.2.6.2 && <1.4
- , butcher >=1.3.1 && <1.4
- , yaml >=0.8.18 && <0.12
- , aeson >=1.0.1.0 && <1.6
- , extra >=1.4.10 && <1.8
- , uniplate >=1.6.12 && <1.7
- , strict >=0.3.2 && <0.5
- , monad-memo >=0.4.1 && <0.6
- , unsafe >=0.0 && <0.1
- , safe >=0.3.9 && <0.4
- , deepseq >=1.4.2.0 && <1.5
- , semigroups >=0.18.2 && <0.20
- , cmdargs >=0.10.14 && <0.11
- , czipwith >=1.0.1.0 && <1.1
- , ghc-boot-th >=8.6.1 && <8.11
- , filepath >=1.4.1.0 && <1.5
- , random >= 1.1 && <1.3
- }
- default-extensions: {
- CPP
-
- NoImplicitPrelude
-
- GADTs
-
- FlexibleContexts
- FlexibleInstances
- ScopedTypeVariables
- MonadComprehensions
- LambdaCase
- MultiWayIf
- KindSignatures
- }
-}
+ Language.Haskell.Brittany.Internal.Transformations.Par
+ Language.Haskell.Brittany.Internal.Types
+ Language.Haskell.Brittany.Internal.Utils
+ Language.Haskell.Brittany.Main
+ Paths_brittany
executable brittany
- if flag(brittany-dev-lib) {
- buildable: False
- } else {
- buildable: True
- }
- main-is: Main.hs
- hs-source-dirs: src-brittany
+ import: executable
+
+ hs-source-dirs: source/executable
+ main-is: Main.hs
+
+test-suite brittany-test-suite
+ import: executable
+
build-depends:
- { base
- , brittany
- }
- default-language: Haskell2010
- ghc-options: {
- -Wall
- -fno-spec-constr
- -fno-warn-unused-imports
- -fno-warn-redundant-constraints
- -rtsopts
- -with-rtsopts "-M2G"
- }
-
-test-suite unittests
- if flag(brittany-dev-lib) || !flag(brittany-test-perf) {
- buildable: False
- } else {
- buildable: True
- }
- type: exitcode-stdio-1.0
- default-language: Haskell2010
- build-depends:
- { brittany
- , base
- , ghc
- , ghc-paths
- , ghc-exactprint
- , transformers
- , containers
- , mtl
- , text
- , multistate
- , syb
- , data-tree-print
- , pretty
- , bytestring
- , directory
- , butcher
- , yaml
- , aeson
- , extra
- , uniplate
- , strict
- , monad-memo
- , unsafe
- , safe
- , deepseq
- , semigroups
- , cmdargs
- , czipwith
- , ghc-boot-th
- , hspec >=2.4.1 && <2.9
- }
- main-is: TestMain.hs
- other-modules: TestUtils
- AsymptoticPerfTests
- hs-source-dirs: src-unittests
- include-dirs: srcinc
- default-extensions: {
- CPP
-
- NoImplicitPrelude
-
- GADTs
-
- FlexibleContexts
- FlexibleInstances
- ScopedTypeVariables
- MonadComprehensions
- LambdaCase
- MultiWayIf
- KindSignatures
- }
- ghc-options: {
- -Wall
- -fno-warn-unused-imports
- -rtsopts
- -with-rtsopts "-M2G"
- -threaded
- -- ^ threaded is not necessary at all, but our CI trusts on being able
- -- to pass -N1, which is not possible without threaded :-/
- -- (plus -no-threaded is not a thing, afaict)
- }
-
-test-suite littests
- if flag(brittany-dev-lib) {
- buildable: False
- } else {
- buildable: True
- }
- type: exitcode-stdio-1.0
- default-language: Haskell2010
- build-depends:
- { brittany
- , base
- , ghc
- , ghc-paths
- , ghc-exactprint
- , transformers
- , containers
- , mtl
- , text
- , multistate
- , syb
- , data-tree-print
- , pretty
- , bytestring
- , directory
- , butcher
- , yaml
- , aeson
- , extra
- , uniplate
- , strict
- , monad-memo
- , unsafe
- , safe
- , deepseq
- , semigroups
- , cmdargs
- , czipwith
- , ghc-boot-th
- , hspec >=2.4.1 && <2.9
- , filepath
- , parsec >=3.1.11 && <3.2
- }
- main-is: Main.hs
- other-modules:
- hs-source-dirs: src-literatetests
- include-dirs: srcinc
- default-extensions: {
- CPP
-
- NoImplicitPrelude
-
- GADTs
-
- FlexibleContexts
- FlexibleInstances
- ScopedTypeVariables
- MonadComprehensions
- LambdaCase
- MultiWayIf
- KindSignatures
- }
- ghc-options: {
- -Wall
- -fno-warn-unused-imports
- -threaded
- -rtsopts
- -with-rtsopts "-M2G -N"
- }
-
-test-suite libinterfacetests
- if flag(brittany-dev-lib) {
- buildable: False
- } else {
- buildable: True
- }
- type: exitcode-stdio-1.0
- default-language: Haskell2010
- build-depends:
- { brittany
- , base
- , text
- , transformers
- , hspec >=2.4.1 && <2.9
- }
- main-is: Main.hs
- other-modules:
- hs-source-dirs: src-libinterfacetests
- include-dirs: srcinc
- default-extensions: {
- FlexibleContexts
- FlexibleInstances
- ScopedTypeVariables
- MonadComprehensions
- LambdaCase
- MultiWayIf
- KindSignatures
- }
- ghc-options: {
- -Wall
- -fno-warn-unused-imports
- -rtsopts
- -with-rtsopts "-M2G"
- -threaded
- -- ^ threaded is not necessary at all, but our CI trusts on being able
- -- to pass -N1, which is not possible without threaded :-/
- -- (plus -no-threaded is not a thing, afaict)
- }
+ , hspec ^>= 2.8.3
+ hs-source-dirs: source/test-suite
+ main-is: Main.hs
+ type: exitcode-stdio-1.0
diff --git a/brittany.yaml b/brittany.yaml
new file mode 100644
index 0000000..b85e4ad
--- /dev/null
+++ b/brittany.yaml
@@ -0,0 +1,4 @@
+conf_layout:
+ lconfig_columnAlignMode:
+ tag: ColumnAlignModeDisabled
+ lconfig_indentPolicy: IndentPolicyLeft
diff --git a/cabal.project b/cabal.project
new file mode 100644
index 0000000..6d724ea
--- /dev/null
+++ b/cabal.project
@@ -0,0 +1,12 @@
+packages: .
+
+allow-newer:
+ , butcher:base
+ , data-tree-print:base
+ , multistate:base
+
+-- https://github.com/lspitzner/czipwith/pull/2
+source-repository-package
+ type: git
+ location: https://github.com/mithrandi/czipwith
+ tag: b6245884ae83e00dd2b5261762549b37390179f8
diff --git a/data/Test1.hs b/data/Test1.hs
new file mode 100644
index 0000000..44e6262
--- /dev/null
+++ b/data/Test1.hs
@@ -0,0 +1 @@
+func :: a -> a
diff --git a/data/Test10.hs b/data/Test10.hs
new file mode 100644
index 0000000..f1b8e0d
--- /dev/null
+++ b/data/Test10.hs
@@ -0,0 +1,3 @@
+func
+ :: lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
+ -> (lakjsdlkjasldkj -> lakjsdlkjasldkj)
diff --git a/data/Test100.hs b/data/Test100.hs
new file mode 100644
index 0000000..f6643c0
--- /dev/null
+++ b/data/Test100.hs
@@ -0,0 +1 @@
+func = klajsdas klajsdas klajsdas
diff --git a/data/Test101.hs b/data/Test101.hs
new file mode 100644
index 0000000..57bac0e
--- /dev/null
+++ b/data/Test101.hs
@@ -0,0 +1,3 @@
+func = lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd
+ lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd
+ lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd
diff --git a/data/Test102.hs b/data/Test102.hs
new file mode 100644
index 0000000..b361b53
--- /dev/null
+++ b/data/Test102.hs
@@ -0,0 +1,3 @@
+func = lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd lakjsdlajsdljas
+ lakjsdlajsdljas
+ lakjsdlajsdljas
diff --git a/data/Test103.hs b/data/Test103.hs
new file mode 100644
index 0000000..2b2b052
--- /dev/null
+++ b/data/Test103.hs
@@ -0,0 +1 @@
+func = (1 +)
diff --git a/data/Test104.hs b/data/Test104.hs
new file mode 100644
index 0000000..e8f99be
--- /dev/null
+++ b/data/Test104.hs
@@ -0,0 +1 @@
+func = (+ 1)
diff --git a/data/Test105.hs b/data/Test105.hs
new file mode 100644
index 0000000..699ead3
--- /dev/null
+++ b/data/Test105.hs
@@ -0,0 +1 @@
+func = (1 `abc`)
diff --git a/data/Test106.hs b/data/Test106.hs
new file mode 100644
index 0000000..ccaa551
--- /dev/null
+++ b/data/Test106.hs
@@ -0,0 +1 @@
+func = (`abc` 1)
diff --git a/data/Test107.hs b/data/Test107.hs
new file mode 100644
index 0000000..99b30ec
--- /dev/null
+++ b/data/Test107.hs
@@ -0,0 +1 @@
+func = (abc, def)
diff --git a/data/Test108.hs b/data/Test108.hs
new file mode 100644
index 0000000..90f6d90
--- /dev/null
+++ b/data/Test108.hs
@@ -0,0 +1 @@
+func = (abc, )
diff --git a/data/Test109.hs b/data/Test109.hs
new file mode 100644
index 0000000..973aed0
--- /dev/null
+++ b/data/Test109.hs
@@ -0,0 +1 @@
+func = (, abc)
diff --git a/data/Test11.hs b/data/Test11.hs
new file mode 100644
index 0000000..25670eb
--- /dev/null
+++ b/data/Test11.hs
@@ -0,0 +1,3 @@
+func
+ :: (lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd -> lakjsdlkjasldkj)
+ -> lakjsdlkjasldkj
diff --git a/data/Test110.hs b/data/Test110.hs
new file mode 100644
index 0000000..78d0c01
--- /dev/null
+++ b/data/Test110.hs
@@ -0,0 +1,6 @@
+myTupleSection =
+ ( verylaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaargefirstelement
+ ,
+ , verylaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaargethirdelement
+ ,
+ )
diff --git a/data/Test111.hs b/data/Test111.hs
new file mode 100644
index 0000000..87acbec
--- /dev/null
+++ b/data/Test111.hs
@@ -0,0 +1,4 @@
+func =
+ ( lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd
+ , lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd
+ )
diff --git a/data/Test112.hs b/data/Test112.hs
new file mode 100644
index 0000000..daf62d6
--- /dev/null
+++ b/data/Test112.hs
@@ -0,0 +1,6 @@
+foo = if True
+ then
+ -- iiiiii
+ "a "
+ else
+ "b "
diff --git a/data/Test113.hs b/data/Test113.hs
new file mode 100644
index 0000000..26bb39d
--- /dev/null
+++ b/data/Test113.hs
@@ -0,0 +1,5 @@
+func = if cond
+ then pure 42
+ else do
+ -- test
+ abc
diff --git a/data/Test114.hs b/data/Test114.hs
new file mode 100644
index 0000000..ea9f935
--- /dev/null
+++ b/data/Test114.hs
@@ -0,0 +1,3 @@
+func = case x of
+ False -> False
+ True -> True
diff --git a/data/Test115.hs b/data/Test115.hs
new file mode 100644
index 0000000..eb88667
--- /dev/null
+++ b/data/Test115.hs
@@ -0,0 +1,7 @@
+func =
+ case
+ lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd
+ lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd
+ of
+ False -> False
+ True -> True
diff --git a/data/Test116.hs b/data/Test116.hs
new file mode 100644
index 0000000..5d7739c
--- /dev/null
+++ b/data/Test116.hs
@@ -0,0 +1,7 @@
+func = do
+ case
+ lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd
+ lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd
+ of
+ False -> False
+ True -> True
diff --git a/data/Test117.hs b/data/Test117.hs
new file mode 100644
index 0000000..43e6130
--- /dev/null
+++ b/data/Test117.hs
@@ -0,0 +1 @@
+func = case x of {}
diff --git a/data/Test118.hs b/data/Test118.hs
new file mode 100644
index 0000000..85c98c6
--- /dev/null
+++ b/data/Test118.hs
@@ -0,0 +1,5 @@
+func =
+ case
+ lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd
+ lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd
+ of {}
diff --git a/data/Test119.hs b/data/Test119.hs
new file mode 100644
index 0000000..195201e
--- /dev/null
+++ b/data/Test119.hs
@@ -0,0 +1,5 @@
+func = do
+ case
+ lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd
+ lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd
+ of {}
diff --git a/data/Test12.hs b/data/Test12.hs
new file mode 100644
index 0000000..fa012f7
--- /dev/null
+++ b/data/Test12.hs
@@ -0,0 +1,5 @@
+func
+ :: ( lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
+ -> lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
+ )
+ -> lakjsdlkjasldkj
diff --git a/data/Test120.hs b/data/Test120.hs
new file mode 100644
index 0000000..5bbd0e6
--- /dev/null
+++ b/data/Test120.hs
@@ -0,0 +1,3 @@
+func = do
+ stmt
+ stmt
diff --git a/data/Test121.hs b/data/Test121.hs
new file mode 100644
index 0000000..aa47dfd
--- /dev/null
+++ b/data/Test121.hs
@@ -0,0 +1,3 @@
+func = do
+ x <- stmt
+ stmt x
diff --git a/data/Test122.hs b/data/Test122.hs
new file mode 100644
index 0000000..589d354
--- /dev/null
+++ b/data/Test122.hs
@@ -0,0 +1,3 @@
+func = do
+ let x = 13
+ stmt x
diff --git a/data/Test123.hs b/data/Test123.hs
new file mode 100644
index 0000000..6319013
--- /dev/null
+++ b/data/Test123.hs
@@ -0,0 +1,7 @@
+func =
+ foooooo
+ $ [ case
+ foooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo
+ of
+ _ -> True
+ ]
diff --git a/data/Test124.hs b/data/Test124.hs
new file mode 100644
index 0000000..1164c0f
--- /dev/null
+++ b/data/Test124.hs
@@ -0,0 +1,4 @@
+testMethod foo bar baz qux =
+ let x = undefined foo bar baz qux qux baz bar :: String
+ -- some comment explaining the in expression
+ in undefined foo x :: String
diff --git a/data/Test125.hs b/data/Test125.hs
new file mode 100644
index 0000000..e711480
--- /dev/null
+++ b/data/Test125.hs
@@ -0,0 +1,4 @@
+testMethod foo bar baz qux =
+ let x = undefined :: String
+ -- some comment explaining the in expression
+ in undefined :: String
diff --git a/data/Test126.hs b/data/Test126.hs
new file mode 100644
index 0000000..e0c379a
--- /dev/null
+++ b/data/Test126.hs
@@ -0,0 +1,3 @@
+testMethod foo bar baz qux =
+ -- some comment explaining the in expression
+ let x = undefined :: String in undefined :: String
diff --git a/data/Test127.hs b/data/Test127.hs
new file mode 100644
index 0000000..e446394
--- /dev/null
+++ b/data/Test127.hs
@@ -0,0 +1,6 @@
+foo foo bar baz qux =
+ let a = 1
+ b = 2
+ c = 3
+ -- some comment explaining the in expression
+ in undefined :: String
diff --git a/data/Test128.hs b/data/Test128.hs
new file mode 100644
index 0000000..8e3a783
--- /dev/null
+++ b/data/Test128.hs
@@ -0,0 +1,6 @@
+func =
+ foo
+ $ [ aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
+ , bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb
+ ]
+ ++ [ccccccccccccccccccccccccccccccccccccccccccccccccccccccccc]
diff --git a/data/Test129.hs b/data/Test129.hs
new file mode 100644
index 0000000..6ca9a1f
--- /dev/null
+++ b/data/Test129.hs
@@ -0,0 +1 @@
+module Main where
diff --git a/data/Test13.hs b/data/Test13.hs
new file mode 100644
index 0000000..68e8e9e
--- /dev/null
+++ b/data/Test13.hs
@@ -0,0 +1,5 @@
+func
+ :: ( ( lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
+ -> lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
+ )
+ )
diff --git a/data/Test130.hs b/data/Test130.hs
new file mode 100644
index 0000000..43a1fee
--- /dev/null
+++ b/data/Test130.hs
@@ -0,0 +1 @@
+module Main () where
diff --git a/data/Test131.hs b/data/Test131.hs
new file mode 100644
index 0000000..0fdcb21
--- /dev/null
+++ b/data/Test131.hs
@@ -0,0 +1 @@
+module Main (main) where
diff --git a/data/Test132.hs b/data/Test132.hs
new file mode 100644
index 0000000..1998fe9
--- /dev/null
+++ b/data/Test132.hs
@@ -0,0 +1 @@
+module Main (main, test1, test2) where
diff --git a/data/Test133.hs b/data/Test133.hs
new file mode 100644
index 0000000..20fd443
--- /dev/null
+++ b/data/Test133.hs
@@ -0,0 +1,12 @@
+module Main
+ ( main
+ , test1
+ , test2
+ , test3
+ , test4
+ , test5
+ , test6
+ , test7
+ , test8
+ , test9
+ ) where
diff --git a/data/Test134.hs b/data/Test134.hs
new file mode 100644
index 0000000..20ea610
--- /dev/null
+++ b/data/Test134.hs
@@ -0,0 +1,12 @@
+module Main
+ ( main
+ -- main
+ , test1
+ , test2
+ -- Test 3
+ , test3
+ , test4
+ -- Test 5
+ , test5
+ -- Test 6
+ ) where
diff --git a/data/Test135.hs b/data/Test135.hs
new file mode 100644
index 0000000..6d7b8eb
--- /dev/null
+++ b/data/Test135.hs
@@ -0,0 +1 @@
+module Main (Test(..)) where
diff --git a/data/Test136.hs b/data/Test136.hs
new file mode 100644
index 0000000..e06cbfc
--- /dev/null
+++ b/data/Test136.hs
@@ -0,0 +1 @@
+module Main (module Main) where
diff --git a/data/Test137.hs b/data/Test137.hs
new file mode 100644
index 0000000..5f1af50
--- /dev/null
+++ b/data/Test137.hs
@@ -0,0 +1 @@
+module Main (Test(Test, a, b)) where
diff --git a/data/Test138.hs b/data/Test138.hs
new file mode 100644
index 0000000..b436099
--- /dev/null
+++ b/data/Test138.hs
@@ -0,0 +1,6 @@
+-- comment1
+module Main
+ ( Test(Test, a, b)
+ , foo -- comment2
+ ) -- comment3
+ where
diff --git a/data/Test139.hs b/data/Test139.hs
new file mode 100644
index 0000000..6fd114e
--- /dev/null
+++ b/data/Test139.hs
@@ -0,0 +1 @@
+module Main (Test()) where
diff --git a/data/Test14.hs b/data/Test14.hs
new file mode 100644
index 0000000..05b4cb6
--- /dev/null
+++ b/data/Test14.hs
@@ -0,0 +1 @@
+func :: asd -> Either a b
diff --git a/data/Test140.hs b/data/Test140.hs
new file mode 100644
index 0000000..6d7a6ef
--- /dev/null
+++ b/data/Test140.hs
@@ -0,0 +1 @@
+-- Intentionally left empty
diff --git a/data/Test141.hs b/data/Test141.hs
new file mode 100644
index 0000000..a053bb5
--- /dev/null
+++ b/data/Test141.hs
@@ -0,0 +1 @@
+import Data.List
diff --git a/data/Test142.hs b/data/Test142.hs
new file mode 100644
index 0000000..1bc9f03
--- /dev/null
+++ b/data/Test142.hs
@@ -0,0 +1 @@
+import Data.List as L
diff --git a/data/Test143.hs b/data/Test143.hs
new file mode 100644
index 0000000..691c0c1
--- /dev/null
+++ b/data/Test143.hs
@@ -0,0 +1 @@
+import qualified Data.List
diff --git a/data/Test144.hs b/data/Test144.hs
new file mode 100644
index 0000000..b64f22f
--- /dev/null
+++ b/data/Test144.hs
@@ -0,0 +1 @@
+import qualified Data.List as L
diff --git a/data/Test145.hs b/data/Test145.hs
new file mode 100644
index 0000000..020afa7
--- /dev/null
+++ b/data/Test145.hs
@@ -0,0 +1 @@
+import safe Data.List as L
diff --git a/data/Test146.hs b/data/Test146.hs
new file mode 100644
index 0000000..cad516e
--- /dev/null
+++ b/data/Test146.hs
@@ -0,0 +1 @@
+import {-# SOURCE #-} Data.List ( )
diff --git a/data/Test147.hs b/data/Test147.hs
new file mode 100644
index 0000000..42148e0
--- /dev/null
+++ b/data/Test147.hs
@@ -0,0 +1 @@
+import safe qualified Data.List
diff --git a/data/Test148.hs b/data/Test148.hs
new file mode 100644
index 0000000..dd2c6b9
--- /dev/null
+++ b/data/Test148.hs
@@ -0,0 +1 @@
+import {-# SOURCE #-} safe qualified Data.List
diff --git a/data/Test149.hs b/data/Test149.hs
new file mode 100644
index 0000000..650a6ad
--- /dev/null
+++ b/data/Test149.hs
@@ -0,0 +1 @@
+import qualified "base" Data.List
diff --git a/data/Test15.hs b/data/Test15.hs
new file mode 100644
index 0000000..668dca4
--- /dev/null
+++ b/data/Test15.hs
@@ -0,0 +1,5 @@
+func
+ :: asd
+ -> Either
+ lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
+ lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
diff --git a/data/Test150.hs b/data/Test150.hs
new file mode 100644
index 0000000..0c30830
--- /dev/null
+++ b/data/Test150.hs
@@ -0,0 +1,3 @@
+import {-# SOURCE #-} safe qualified "base" Data.List as L
+import {-# SOURCE #-} safe qualified "base" Data.List ( )
+import {-# SOURCE #-} safe qualified Data.List hiding ( )
diff --git a/data/Test151.hs b/data/Test151.hs
new file mode 100644
index 0000000..992b081
--- /dev/null
+++ b/data/Test151.hs
@@ -0,0 +1 @@
+import qualified Data.List ( )
diff --git a/data/Test152.hs b/data/Test152.hs
new file mode 100644
index 0000000..631bb4c
--- /dev/null
+++ b/data/Test152.hs
@@ -0,0 +1 @@
+import Data.List ( nub )
diff --git a/data/Test153.hs b/data/Test153.hs
new file mode 100644
index 0000000..537fce6
--- /dev/null
+++ b/data/Test153.hs
@@ -0,0 +1,4 @@
+import Data.List ( foldl'
+ , indexElem
+ , nub
+ )
diff --git a/data/Test154.hs b/data/Test154.hs
new file mode 100644
index 0000000..387f268
--- /dev/null
+++ b/data/Test154.hs
@@ -0,0 +1,14 @@
+import Test ( Long
+ , anymore
+ , fit
+ , items
+ , line
+ , list
+ , not
+ , onA
+ , quite
+ , single
+ , that
+ , will
+ , with
+ )
diff --git a/data/Test155.hs b/data/Test155.hs
new file mode 100644
index 0000000..6150ff3
--- /dev/null
+++ b/data/Test155.hs
@@ -0,0 +1,11 @@
+import Test ( (+)
+ , (:!)(..)
+ , (:*)((:.), T7, t7)
+ , (:.)
+ , T
+ , T2()
+ , T3(..)
+ , T4(T4)
+ , T5(T5, t5)
+ , T6((<|>))
+ )
diff --git a/data/Test156.hs b/data/Test156.hs
new file mode 100644
index 0000000..9eb3db5
--- /dev/null
+++ b/data/Test156.hs
@@ -0,0 +1,3 @@
+import Test hiding ( )
+import Test as T
+ hiding ( )
diff --git a/data/Test157.hs b/data/Test157.hs
new file mode 100644
index 0000000..f78c007
--- /dev/null
+++ b/data/Test157.hs
@@ -0,0 +1,13 @@
+import Prelude as X
+ hiding ( head
+ , init
+ , last
+ , maximum
+ , minimum
+ , pred
+ , read
+ , readFile
+ , succ
+ , tail
+ , undefined
+ )
diff --git a/data/Test158.hs b/data/Test158.hs
new file mode 100644
index 0000000..0fb60c8
--- /dev/null
+++ b/data/Test158.hs
@@ -0,0 +1,3 @@
+import TestJustAbitToLongModuleNameLikeThisOneIs
+ ( )
+import TestJustShortEnoughModuleNameLikeThisOne ( )
diff --git a/data/Test159.hs b/data/Test159.hs
new file mode 100644
index 0000000..886dfdc
--- /dev/null
+++ b/data/Test159.hs
@@ -0,0 +1,3 @@
+import TestJustAbitToLongModuleNameLikeThisOneI
+ as T
+import TestJustShortEnoughModuleNameLikeThisOn as T
diff --git a/data/Test16.hs b/data/Test16.hs
new file mode 100644
index 0000000..a91f667
--- /dev/null
+++ b/data/Test16.hs
@@ -0,0 +1,6 @@
+func
+ :: asd
+ -> Trither
+ lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
+ lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
+ lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
diff --git a/data/Test160.hs b/data/Test160.hs
new file mode 100644
index 0000000..eff7fd4
--- /dev/null
+++ b/data/Test160.hs
@@ -0,0 +1,3 @@
+import TestJustAbitToLongModuleNameLikeTh
+ hiding ( )
+import TestJustShortEnoughModuleNameLike hiding ( )
diff --git a/data/Test161.hs b/data/Test161.hs
new file mode 100644
index 0000000..14bd638
--- /dev/null
+++ b/data/Test161.hs
@@ -0,0 +1,10 @@
+import MoreThanSufficientlyLongModuleNameWithSome
+ ( compact
+ , fit
+ , inA
+ , items
+ , layout
+ , not
+ , that
+ , will
+ )
diff --git a/data/Test162.hs b/data/Test162.hs
new file mode 100644
index 0000000..f09b604
--- /dev/null
+++ b/data/Test162.hs
@@ -0,0 +1,11 @@
+import TestJustAbitToLongModuleNameLikeTh
+ hiding ( abc
+ , def
+ , ghci
+ , jklm
+ )
+import TestJustShortEnoughModuleNameLike hiding ( abc
+ , def
+ , ghci
+ , jklm
+ )
diff --git a/data/Test163.hs b/data/Test163.hs
new file mode 100644
index 0000000..c71aaba
--- /dev/null
+++ b/data/Test163.hs
@@ -0,0 +1,9 @@
+import {-# SOURCE #-} safe qualified "qualifier" A hiding ( )
+import {-# SOURCE #-} safe qualified "qualifiers" A
+ hiding ( )
+import {-# SOURCE #-} safe qualified "qualifiers" AlsoAf as T
+import {-# SOURCE #-} safe qualified "qualifiers" AlsoAff ( )
+import {-# SOURCE #-} safe qualified "qualifiers" AlsoAff
+ as T
+import {-# SOURCE #-} safe qualified "qualifiers" AlsoAffe
+ ( )
diff --git a/data/Test164.hs b/data/Test164.hs
new file mode 100644
index 0000000..26469d9
--- /dev/null
+++ b/data/Test164.hs
@@ -0,0 +1,7 @@
+-- Test
+import Data.List ( nub ) -- Test
+{- Test -}
+import qualified Data.List as L
+ ( foldl' ) {- Test -}
+-- Test
+import Test ( test )
diff --git a/data/Test165.hs b/data/Test165.hs
new file mode 100644
index 0000000..af0b6ab
--- /dev/null
+++ b/data/Test165.hs
@@ -0,0 +1,4 @@
+import Test ( abc
+ , def
+ -- comment
+ )
diff --git a/data/Test166.hs b/data/Test166.hs
new file mode 100644
index 0000000..3f0a3ea
--- /dev/null
+++ b/data/Test166.hs
@@ -0,0 +1,3 @@
+import Test ( abc
+ -- comment
+ )
diff --git a/data/Test167.hs b/data/Test167.hs
new file mode 100644
index 0000000..fb8c357
--- /dev/null
+++ b/data/Test167.hs
@@ -0,0 +1,8 @@
+import Test ( abc
+ -- comment
+ , def
+ , ghi
+ {- comment -}
+ , jkl
+ -- comment
+ )
diff --git a/data/Test168.hs b/data/Test168.hs
new file mode 100644
index 0000000..40ca190
--- /dev/null
+++ b/data/Test168.hs
@@ -0,0 +1,2 @@
+import Test ( -- comment
+ )
diff --git a/data/Test169.hs b/data/Test169.hs
new file mode 100644
index 0000000..12a8008
--- /dev/null
+++ b/data/Test169.hs
@@ -0,0 +1,8 @@
+import Test ( longbindingNameThatoverflowsColum
+ )
+import Test ( Long
+ ( List
+ , Of
+ , Things
+ )
+ )
diff --git a/data/Test17.hs b/data/Test17.hs
new file mode 100644
index 0000000..a4bf487
--- /dev/null
+++ b/data/Test17.hs
@@ -0,0 +1,6 @@
+func
+ :: Trither
+ lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
+ lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
+ lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
+ -> asd
diff --git a/data/Test170.hs b/data/Test170.hs
new file mode 100644
index 0000000..01d0881
--- /dev/null
+++ b/data/Test170.hs
@@ -0,0 +1,18 @@
+import Test ( Thing
+ ( -- Comments
+ )
+ )
+import Test ( Thing
+ ( Item
+ -- and Comment
+ )
+ )
+import Test ( Thing
+ ( With
+ -- Comments
+ , and
+ -- also
+ , items
+ -- !
+ )
+ )
diff --git a/data/Test171.hs b/data/Test171.hs
new file mode 100644
index 0000000..2716a8d
--- /dev/null
+++ b/data/Test171.hs
@@ -0,0 +1,2 @@
+import VeryLongModuleNameThatCouldEvenCauseAnEmptyBindingListToExpandIntoMultipleLine
+ ( )
diff --git a/data/Test172.hs b/data/Test172.hs
new file mode 100644
index 0000000..190cdb1
--- /dev/null
+++ b/data/Test172.hs
@@ -0,0 +1,26 @@
+{-# LANGUAGE BangPatterns #-}
+{-
+ - Test module
+ -}
+module Test
+ ( test1
+ -- ^ test
+ , test2
+ -- | test
+ , test3
+ , test4
+ , test5
+ , test6
+ , test7
+ , test8
+ , test9
+ , test10
+ -- Test 10
+ ) where
+-- Test
+import Data.List ( nub ) -- Test
+{- Test -}
+import qualified Data.List as L
+ ( foldl' ) {- Test -}
+-- Test
+import Test ( test )
diff --git a/data/Test173.hs b/data/Test173.hs
new file mode 100644
index 0000000..ca49c29
--- /dev/null
+++ b/data/Test173.hs
@@ -0,0 +1,2 @@
+import Aaa
+import Baa
diff --git a/data/Test174.hs b/data/Test174.hs
new file mode 100644
index 0000000..cb7a8f3
--- /dev/null
+++ b/data/Test174.hs
@@ -0,0 +1,5 @@
+import Zaa
+import Zab
+
+import Aaa
+import Baa
diff --git a/data/Test175.hs b/data/Test175.hs
new file mode 100644
index 0000000..b25e13a
--- /dev/null
+++ b/data/Test175.hs
@@ -0,0 +1,2 @@
+import Boo
+import qualified Zoo
diff --git a/data/Test176.hs b/data/Test176.hs
new file mode 100644
index 0000000..3ed3401
--- /dev/null
+++ b/data/Test176.hs
@@ -0,0 +1,3 @@
+import Boo ( a )
+
+import Boo ( b )
diff --git a/data/Test177.hs b/data/Test177.hs
new file mode 100644
index 0000000..67b690d
--- /dev/null
+++ b/data/Test177.hs
@@ -0,0 +1,2 @@
+import A.B.C
+import A.B.D
diff --git a/data/Test178.hs b/data/Test178.hs
new file mode 100644
index 0000000..f4d347f
--- /dev/null
+++ b/data/Test178.hs
@@ -0,0 +1 @@
+type MySynonym = String
diff --git a/data/Test179.hs b/data/Test179.hs
new file mode 100644
index 0000000..dff281d
--- /dev/null
+++ b/data/Test179.hs
@@ -0,0 +1 @@
+type MySynonym a = [a]
diff --git a/data/Test18.hs b/data/Test18.hs
new file mode 100644
index 0000000..aed66fd
--- /dev/null
+++ b/data/Test18.hs
@@ -0,0 +1,5 @@
+func
+ :: Trither
+ lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
+ lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
+ (lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd -> asd)
diff --git a/data/Test180.hs b/data/Test180.hs
new file mode 100644
index 0000000..3f41a1a
--- /dev/null
+++ b/data/Test180.hs
@@ -0,0 +1,3 @@
+-- | Important comment thrown in
+type MySynonym b a
+ = MySynonym a b -> MySynonym a b -> MyParamType a b -> MyParamType a b
diff --git a/data/Test181.hs b/data/Test181.hs
new file mode 100644
index 0000000..727c443
--- /dev/null
+++ b/data/Test181.hs
@@ -0,0 +1,7 @@
+type MySynonym3 b a
+ = MySynonym a b
+ -> MySynonym a b
+ -- ^ RandomComment
+ -> MyParamType a b
+ -> MyParamType a b
+ -> MySynonym2 b a
diff --git a/data/Test182.hs b/data/Test182.hs
new file mode 100644
index 0000000..142a73a
--- /dev/null
+++ b/data/Test182.hs
@@ -0,0 +1,7 @@
+{-# LANGUAGE StarIsType #-}
+type MySynonym (a :: * -> *)
+ = MySynonym a b
+ -> MySynonym a b
+ -> MyParamType a b
+ -> MyParamType a b
+ -> MySynonym2 b a
diff --git a/data/Test183.hs b/data/Test183.hs
new file mode 100644
index 0000000..a48b11c
--- /dev/null
+++ b/data/Test183.hs
@@ -0,0 +1 @@
+type MySynonym a = Num a => a -> Int
diff --git a/data/Test184.hs b/data/Test184.hs
new file mode 100644
index 0000000..7b868ea
--- /dev/null
+++ b/data/Test184.hs
@@ -0,0 +1,5 @@
+type MySynonym a
+ = Num a
+ => AReallyLongTypeName
+ -> AnotherReallyLongTypeName
+ -> AThirdTypeNameToOverflow
diff --git a/data/Test185.hs b/data/Test185.hs
new file mode 100644
index 0000000..69107a7
--- /dev/null
+++ b/data/Test185.hs
@@ -0,0 +1,2 @@
+{-# LANGUAGE RankNTypes #-}
+type MySynonym = forall a . [a]
diff --git a/data/Test186.hs b/data/Test186.hs
new file mode 100644
index 0000000..ed9c0e4
--- /dev/null
+++ b/data/Test186.hs
@@ -0,0 +1 @@
+type (:+:) a b = (a, b)
diff --git a/data/Test187.hs b/data/Test187.hs
new file mode 100644
index 0000000..3b94215
--- /dev/null
+++ b/data/Test187.hs
@@ -0,0 +1 @@
+type a `MySynonym` b = a -> b
diff --git a/data/Test188.hs b/data/Test188.hs
new file mode 100644
index 0000000..d7ba4a9
--- /dev/null
+++ b/data/Test188.hs
@@ -0,0 +1 @@
+type a :+: b = (a, b)
diff --git a/data/Test189.hs b/data/Test189.hs
new file mode 100644
index 0000000..7228f6d
--- /dev/null
+++ b/data/Test189.hs
@@ -0,0 +1 @@
+type (a `Foo` b) c = (a, b, c)
diff --git a/data/Test19.hs b/data/Test19.hs
new file mode 100644
index 0000000..92634de
--- /dev/null
+++ b/data/Test19.hs
@@ -0,0 +1,7 @@
+func
+ :: Trither
+ asd
+ lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
+ ( lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
+ -> lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
+ )
diff --git a/data/Test190.hs b/data/Test190.hs
new file mode 100644
index 0000000..b686bf0
--- /dev/null
+++ b/data/Test190.hs
@@ -0,0 +1,3 @@
+type Foo a -- fancy type comment
+ = -- strange comment
+ Int
diff --git a/data/Test191.hs b/data/Test191.hs
new file mode 100644
index 0000000..b6ce836
--- /dev/null
+++ b/data/Test191.hs
@@ -0,0 +1 @@
+type (a :+: b) = (a, b)
diff --git a/data/Test192.hs b/data/Test192.hs
new file mode 100644
index 0000000..f08498a
--- /dev/null
+++ b/data/Test192.hs
@@ -0,0 +1,6 @@
+type Foo
+ = ( -- t1
+ A -- t2
+ , -- t3
+ B -- t4
+ ) -- t5
diff --git a/data/Test193.hs b/data/Test193.hs
new file mode 100644
index 0000000..b422133
--- /dev/null
+++ b/data/Test193.hs
@@ -0,0 +1,2 @@
+instance MyClass Int where
+ myMethod x = x + 1
diff --git a/data/Test194.hs b/data/Test194.hs
new file mode 100644
index 0000000..69107c6
--- /dev/null
+++ b/data/Test194.hs
@@ -0,0 +1,4 @@
+instance MyClass Int where
+ myMethod x =
+ -- insightful comment
+ x + 1
diff --git a/data/Test195.hs b/data/Test195.hs
new file mode 100644
index 0000000..3de314a
--- /dev/null
+++ b/data/Test195.hs
@@ -0,0 +1,3 @@
+instance MyClass Int where
+ myMethod :: Int -> Int
+ myMethod x = x + 1
diff --git a/data/Test196.hs b/data/Test196.hs
new file mode 100644
index 0000000..63f0d95
--- /dev/null
+++ b/data/Test196.hs
@@ -0,0 +1,9 @@
+instance MyClass Int where
+ myMethod
+ :: Int
+ -> Int
+ -> AReallyLongType
+ -> AReallyLongType
+ -> AReallyLongType
+ -> Int
+ myMethod x = x + 1
diff --git a/data/Test197.hs b/data/Test197.hs
new file mode 100644
index 0000000..d7c7d3c
--- /dev/null
+++ b/data/Test197.hs
@@ -0,0 +1,3 @@
+instance MyClass Int where
+ myMethod x = x + 1
+ myMethod2 x = x + 1
diff --git a/data/Test198.hs b/data/Test198.hs
new file mode 100644
index 0000000..811e7c4
--- /dev/null
+++ b/data/Test198.hs
@@ -0,0 +1,11 @@
+instance MyClass Int where
+ myMethod
+ :: Int
+ -> Int
+ -> AReallyLongType
+ -> AReallyLongType
+ -> AReallyLongType
+ -> Int
+ myMethod x = x + 1
+ myMethod2 :: Int -> Int
+ myMethod2 x = x + 1
diff --git a/data/Test199.hs b/data/Test199.hs
new file mode 100644
index 0000000..9b9cf38
--- /dev/null
+++ b/data/Test199.hs
@@ -0,0 +1,4 @@
+-- | This instance should be commented on
+instance MyClass Int where
+ -- | This method is also comment-worthy
+ myMethod x = x + 1
diff --git a/data/Test2.hs b/data/Test2.hs
new file mode 100644
index 0000000..b0d734a
--- /dev/null
+++ b/data/Test2.hs
@@ -0,0 +1,3 @@
+func
+ :: lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
+ -> lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
diff --git a/data/Test20.hs b/data/Test20.hs
new file mode 100644
index 0000000..4ad54b6
--- /dev/null
+++ b/data/Test20.hs
@@ -0,0 +1,7 @@
+func
+ :: asd
+ -> ( Trither
+ lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
+ lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
+ lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
+ )
diff --git a/data/Test200.hs b/data/Test200.hs
new file mode 100644
index 0000000..c184597
--- /dev/null
+++ b/data/Test200.hs
@@ -0,0 +1,4 @@
+instance MyClass Int where
+ type MyType = Int
+ myMethod :: MyType -> Int
+ myMethod x = x + 1
diff --git a/data/Test201.hs b/data/Test201.hs
new file mode 100644
index 0000000..1dcbe3a
--- /dev/null
+++ b/data/Test201.hs
@@ -0,0 +1,5 @@
+instance MyClass Int where
+ type MyType = String
+ myMethod :: MyType -> Int
+ myMethod x = x + 1
+ type MyType = Int
diff --git a/data/Test202.hs b/data/Test202.hs
new file mode 100644
index 0000000..b2789c2
--- /dev/null
+++ b/data/Test202.hs
@@ -0,0 +1,8 @@
+instance MyClass Int where
+ -- | This data is very important
+ data MyData = IntData
+ { intData :: String
+ , intData2 :: Int
+ }
+ myMethod :: MyData -> Int
+ myMethod = intData2
diff --git a/data/Test203.hs b/data/Test203.hs
new file mode 100644
index 0000000..04353a6
--- /dev/null
+++ b/data/Test203.hs
@@ -0,0 +1,11 @@
+instance MyClass Int where
+ -- | This data is important
+ data MyData = Test Int Int
+ myMethod :: MyData -> Int
+ myMethod = intData2
+ -- | This data is also important
+ data MyData2 = IntData
+ { intData :: String
+ -- ^ Interesting field
+ , intData2 :: Int
+ }
diff --git a/data/Test204.hs b/data/Test204.hs
new file mode 100644
index 0000000..7ad4fc6
--- /dev/null
+++ b/data/Test204.hs
@@ -0,0 +1,6 @@
+{-# LANGUAGE TypeFamilies #-}
+module Lib where
+instance Foo () where
+ newtype Bar () = Baz ()
+ deriving (Eq, Ord, Show)
+ bar = Baz
diff --git a/data/Test205.hs b/data/Test205.hs
new file mode 100644
index 0000000..a224c18
--- /dev/null
+++ b/data/Test205.hs
@@ -0,0 +1,4 @@
+instance Foo Int where
+ newtype Bar Int = BarInt
+ { unBarInt :: Int
+ }
diff --git a/data/Test206.hs b/data/Test206.hs
new file mode 100644
index 0000000..7266b3e
--- /dev/null
+++ b/data/Test206.hs
@@ -0,0 +1,3 @@
+{-# language TypeFamilies #-}
+type family F a
+type instance F Int = IO Int
diff --git a/data/Test207.hs b/data/Test207.hs
new file mode 100644
index 0000000..9bb7ba2
--- /dev/null
+++ b/data/Test207.hs
@@ -0,0 +1,3 @@
+{-# language TypeFamilies #-}
+type family F a
+type instance F Int = IO Int -- x
diff --git a/data/Test208.hs b/data/Test208.hs
new file mode 100644
index 0000000..0e3c3f8
--- /dev/null
+++ b/data/Test208.hs
@@ -0,0 +1,4 @@
+{-# language TypeFamilies #-}
+module M where
+type family F a
+type instance F Int = IO Int
diff --git a/data/Test209.hs b/data/Test209.hs
new file mode 100644
index 0000000..f103480
--- /dev/null
+++ b/data/Test209.hs
@@ -0,0 +1,3 @@
+{-# language TypeFamilies #-}
+data family F a
+newtype instance F Int = N Int
diff --git a/data/Test21.hs b/data/Test21.hs
new file mode 100644
index 0000000..d27183e
--- /dev/null
+++ b/data/Test21.hs
@@ -0,0 +1,7 @@
+func
+ :: asd
+ -> ( Trither
+ lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
+ lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
+ )
+ lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
diff --git a/data/Test210.hs b/data/Test210.hs
new file mode 100644
index 0000000..659bd8a
--- /dev/null
+++ b/data/Test210.hs
@@ -0,0 +1,3 @@
+{-# language TypeFamilies #-}
+data family F a
+newtype instance F Int = N Int -- x
diff --git a/data/Test211.hs b/data/Test211.hs
new file mode 100644
index 0000000..9e71377
--- /dev/null
+++ b/data/Test211.hs
@@ -0,0 +1,4 @@
+{-# language TypeFamilies #-}
+module M where
+data family F a
+newtype instance F Int = N Int
diff --git a/data/Test212.hs b/data/Test212.hs
new file mode 100644
index 0000000..715990f
--- /dev/null
+++ b/data/Test212.hs
@@ -0,0 +1,3 @@
+{-# language TypeFamilies #-}
+data family F a
+data instance F Int = D Int
diff --git a/data/Test213.hs b/data/Test213.hs
new file mode 100644
index 0000000..0194c4c
--- /dev/null
+++ b/data/Test213.hs
@@ -0,0 +1,3 @@
+{-# language TypeFamilies #-}
+data family F a
+data instance F Int = D Int -- x
diff --git a/data/Test214.hs b/data/Test214.hs
new file mode 100644
index 0000000..81d27db
--- /dev/null
+++ b/data/Test214.hs
@@ -0,0 +1,4 @@
+{-# language TypeFamilies #-}
+module M where
+data family F a
+data instance F Int = D Int
diff --git a/data/Test215.hs b/data/Test215.hs
new file mode 100644
index 0000000..feaf541
--- /dev/null
+++ b/data/Test215.hs
@@ -0,0 +1,5 @@
+{-# language TypeFamilies #-}
+class C a where
+ type family F a
+instance C Int where
+ type F Int = IO Int
diff --git a/data/Test216.hs b/data/Test216.hs
new file mode 100644
index 0000000..13dcee5
--- /dev/null
+++ b/data/Test216.hs
@@ -0,0 +1,5 @@
+{-# language TypeFamilies #-}
+class C a where
+ type family F a
+instance C Int where
+ type F Int = IO Int -- x
diff --git a/data/Test217.hs b/data/Test217.hs
new file mode 100644
index 0000000..c14956e
--- /dev/null
+++ b/data/Test217.hs
@@ -0,0 +1,6 @@
+{-# language TypeFamilies #-}
+module M where
+class C a where
+ type family F a
+instance C Int where
+ type F Int = IO Int
diff --git a/data/Test218.hs b/data/Test218.hs
new file mode 100644
index 0000000..824b034
--- /dev/null
+++ b/data/Test218.hs
@@ -0,0 +1,5 @@
+{-# language TypeFamilies #-}
+class C a where
+ data family F a
+instance C Int where
+ newtype F Int = N Int
diff --git a/data/Test219.hs b/data/Test219.hs
new file mode 100644
index 0000000..1df22e4
--- /dev/null
+++ b/data/Test219.hs
@@ -0,0 +1,5 @@
+{-# language TypeFamilies #-}
+class C a where
+ data family F a
+instance C Int where
+ newtype F Int = N Int -- x
diff --git a/data/Test22.hs b/data/Test22.hs
new file mode 100644
index 0000000..35b8134
--- /dev/null
+++ b/data/Test22.hs
@@ -0,0 +1,7 @@
+func
+ :: ( Trither
+ lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
+ lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
+ )
+ lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
+ -> asd
diff --git a/data/Test220.hs b/data/Test220.hs
new file mode 100644
index 0000000..6f6dc67
--- /dev/null
+++ b/data/Test220.hs
@@ -0,0 +1,6 @@
+{-# language TypeFamilies #-}
+module M where
+class C a where
+ data family F a
+instance C Int where
+ newtype F Int = N Int
diff --git a/data/Test221.hs b/data/Test221.hs
new file mode 100644
index 0000000..1ec34f4
--- /dev/null
+++ b/data/Test221.hs
@@ -0,0 +1,5 @@
+{-# language TypeFamilies #-}
+class C a where
+ data family F a
+instance C Int where
+ data F Int = D Int
diff --git a/data/Test222.hs b/data/Test222.hs
new file mode 100644
index 0000000..84a1f5f
--- /dev/null
+++ b/data/Test222.hs
@@ -0,0 +1,5 @@
+{-# language TypeFamilies #-}
+class C a where
+ data family F a
+instance C Int where
+ data F Int = D Int -- x
diff --git a/data/Test223.hs b/data/Test223.hs
new file mode 100644
index 0000000..677369b
--- /dev/null
+++ b/data/Test223.hs
@@ -0,0 +1,6 @@
+{-# language TypeFamilies #-}
+module M where
+class C a where
+ data family F a
+instance C Int where
+ data F Int = D Int
diff --git a/data/Test224.hs b/data/Test224.hs
new file mode 100644
index 0000000..8798205
--- /dev/null
+++ b/data/Test224.hs
@@ -0,0 +1,3 @@
+module Main where
+import Prelude
+firstDecl = True
diff --git a/data/Test225.hs b/data/Test225.hs
new file mode 100644
index 0000000..e5861f4
--- /dev/null
+++ b/data/Test225.hs
@@ -0,0 +1,10 @@
+func = do
+ -- complex first step
+ aaa
+ -- complex second step
+ bbb
+ where
+ helper :: Helper
+ helper = helpful
+ other :: Other
+ other = True
diff --git a/data/Test226.hs b/data/Test226.hs
new file mode 100644
index 0000000..d999644
--- /dev/null
+++ b/data/Test226.hs
@@ -0,0 +1 @@
+type instance MyFam Bool = String
diff --git a/data/Test227.hs b/data/Test227.hs
new file mode 100644
index 0000000..a67980b
--- /dev/null
+++ b/data/Test227.hs
@@ -0,0 +1 @@
+type instance MyFam (Maybe a) = a -> Bool
diff --git a/data/Test228.hs b/data/Test228.hs
new file mode 100644
index 0000000..21a82dc
--- /dev/null
+++ b/data/Test228.hs
@@ -0,0 +1,4 @@
+type instance MyFam ALongishType
+ = AMuchLongerTypeThanThat
+ -> AnEvenLongerTypeThanTheLastOne
+ -> ShouldDefinitelyOverflow
diff --git a/data/Test229.hs b/data/Test229.hs
new file mode 100644
index 0000000..9299647
--- /dev/null
+++ b/data/Test229.hs
@@ -0,0 +1,3 @@
+-- | A happy family
+type instance MyFam Bool -- This is an odd one
+ = AnotherType -- Here's another
diff --git a/data/Test23.hs b/data/Test23.hs
new file mode 100644
index 0000000..45b6ecc
--- /dev/null
+++ b/data/Test23.hs
@@ -0,0 +1 @@
+func :: [a -> b]
diff --git a/data/Test230.hs b/data/Test230.hs
new file mode 100644
index 0000000..c7daa9c
--- /dev/null
+++ b/data/Test230.hs
@@ -0,0 +1,4 @@
+{-# LANGUAGE MultiWayIf #-}
+func = if
+ | cond1 -> loooooooooooooooooooooooooooooong expr1
+ | cond2 -> loooooooooooooooooooooooooooooong expr2
diff --git a/data/Test231.hs b/data/Test231.hs
new file mode 100644
index 0000000..4580c39
--- /dev/null
+++ b/data/Test231.hs
@@ -0,0 +1,6 @@
+{-# LANGUAGE MultiWayIf #-}
+func = do
+ foo
+ bar $ if
+ | cond1 -> loooooooooooooooooooooooooooooong expr1
+ | cond2 -> loooooooooooooooooooooooooooooong expr2
diff --git a/data/Test232.hs b/data/Test232.hs
new file mode 100644
index 0000000..a1e09b1
--- /dev/null
+++ b/data/Test232.hs
@@ -0,0 +1,4 @@
+{-# LANGUAGE LambdaCase #-}
+func = \case
+ FooBar -> x
+ Baz -> y
diff --git a/data/Test233.hs b/data/Test233.hs
new file mode 100644
index 0000000..c4b3a93
--- /dev/null
+++ b/data/Test233.hs
@@ -0,0 +1,2 @@
+{-# LANGUAGE ImplicitParams #-}
+func :: (?asd::Int) -> ()
diff --git a/data/Test234.hs b/data/Test234.hs
new file mode 100644
index 0000000..55305cf
--- /dev/null
+++ b/data/Test234.hs
@@ -0,0 +1,7 @@
+{-# LANGUAGE ImplicitParams #-}
+func
+ :: ( ?asd
+ :: lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
+ -> lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
+ )
+ -> ()
diff --git a/data/Test235.hs b/data/Test235.hs
new file mode 100644
index 0000000..41406a4
--- /dev/null
+++ b/data/Test235.hs
@@ -0,0 +1,5 @@
+{-# LANGUAGE RecursiveDo #-}
+foo = do
+ rec a <- f b
+ b <- g a
+ return (a, b)
diff --git a/data/Test236.hs b/data/Test236.hs
new file mode 100644
index 0000000..ebf2076
--- /dev/null
+++ b/data/Test236.hs
@@ -0,0 +1,6 @@
+{-# LANGUAGE RecursiveDo #-}
+foo = do
+ rec -- comment
+ a <- f b
+ b <- g a
+ return (a, b)
diff --git a/data/Test237.hs b/data/Test237.hs
new file mode 100644
index 0000000..78ecef2
--- /dev/null
+++ b/data/Test237.hs
@@ -0,0 +1,3 @@
+{-# LANGUAGE ExplicitNamespaces #-}
+{-# LANGUAGE PatternSynonyms #-}
+module Test (type (++), (++), pattern Foo) where
diff --git a/data/Test238.hs b/data/Test238.hs
new file mode 100644
index 0000000..61444fa
--- /dev/null
+++ b/data/Test238.hs
@@ -0,0 +1,7 @@
+{-# LANGUAGE ExplicitNamespaces #-}
+{-# LANGUAGE PatternSynonyms #-}
+import Test ( type (++)
+ , (++)
+ , pattern (:.)
+ , pattern Foo
+ )
diff --git a/data/Test239.hs b/data/Test239.hs
new file mode 100644
index 0000000..f535c48
--- /dev/null
+++ b/data/Test239.hs
@@ -0,0 +1,2 @@
+{-# LANGUAGE PatternSynonyms #-}
+pattern J x = Just x
diff --git a/data/Test24.hs b/data/Test24.hs
new file mode 100644
index 0000000..272c2b4
--- /dev/null
+++ b/data/Test24.hs
@@ -0,0 +1,4 @@
+func
+ :: [ lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
+ -> lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
+ ]
diff --git a/data/Test240.hs b/data/Test240.hs
new file mode 100644
index 0000000..82251e5
--- /dev/null
+++ b/data/Test240.hs
@@ -0,0 +1,2 @@
+{-# LANGUAGE PatternSynonyms #-}
+pattern F x <- (x, _)
diff --git a/data/Test241.hs b/data/Test241.hs
new file mode 100644
index 0000000..e00b3ca
--- /dev/null
+++ b/data/Test241.hs
@@ -0,0 +1,3 @@
+{-# LANGUAGE PatternSynonyms #-}
+pattern HeadC x <- x : xs where
+ HeadC x = [x]
diff --git a/data/Test242.hs b/data/Test242.hs
new file mode 100644
index 0000000..f6587d6
--- /dev/null
+++ b/data/Test242.hs
@@ -0,0 +1,3 @@
+{-# LANGUAGE PatternSynonyms #-}
+pattern Head2 x y <- x : y : xs where
+ Head2 x y = [x, y]
diff --git a/data/Test243.hs b/data/Test243.hs
new file mode 100644
index 0000000..4ffaf11
--- /dev/null
+++ b/data/Test243.hs
@@ -0,0 +1,2 @@
+{-# LANGUAGE PatternSynonyms #-}
+pattern x :> y = [x, y]
diff --git a/data/Test244.hs b/data/Test244.hs
new file mode 100644
index 0000000..d61801f
--- /dev/null
+++ b/data/Test244.hs
@@ -0,0 +1,2 @@
+{-# LANGUAGE PatternSynonyms #-}
+pattern MyData { a, b, c } = [a, b, c]
diff --git a/data/Test245.hs b/data/Test245.hs
new file mode 100644
index 0000000..78869f8
--- /dev/null
+++ b/data/Test245.hs
@@ -0,0 +1,3 @@
+{-# LANGUAGE PatternSynonyms #-}
+pattern myLongLeftVariableName `MyLongInfixPatternMatcher` myLongRightVariableName =
+ [myLongLeftVariableName, myLongRightVariableName]
diff --git a/data/Test246.hs b/data/Test246.hs
new file mode 100644
index 0000000..811bb22
--- /dev/null
+++ b/data/Test246.hs
@@ -0,0 +1,4 @@
+{-# LANGUAGE PatternSynonyms #-}
+pattern myLeftVariableName `MyInfixPatternMatcher` myRightVariableName <-
+ [myLongLeftVariableName, myLongRightVariableName] where
+ MyInfixPatternMatcher x y = [x, x, y]
diff --git a/data/Test247.hs b/data/Test247.hs
new file mode 100644
index 0000000..cd38165
--- /dev/null
+++ b/data/Test247.hs
@@ -0,0 +1,3 @@
+{-# LANGUAGE PatternSynonyms #-}
+pattern J :: a -> Maybe a
+pattern J x = Just x
diff --git a/data/Test248.hs b/data/Test248.hs
new file mode 100644
index 0000000..823e1f4
--- /dev/null
+++ b/data/Test248.hs
@@ -0,0 +1,6 @@
+{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE ViewPatterns #-}
+pattern Signed x <- (asSigned -> x) where
+ Signed (Neg x) = -x
+ Signed Zero = 0
+ Signed (Pos x) = x
diff --git a/data/Test249.hs b/data/Test249.hs
new file mode 100644
index 0000000..9b69561
--- /dev/null
+++ b/data/Test249.hs
@@ -0,0 +1,7 @@
+{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE ViewPatterns #-}
+pattern Signed xxxxxxxxxxxxxxxxxxxxxxxx <-
+ (asSigned -> xxxxxxxxxxxxxxxxxxxxxxxx) where
+ Signed (Neg x) = -x
+ Signed Zero = 0
+ Signed (Pos x) = x
diff --git a/data/Test25.hs b/data/Test25.hs
new file mode 100644
index 0000000..142958b
--- /dev/null
+++ b/data/Test25.hs
@@ -0,0 +1,5 @@
+func
+ :: [ ( lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
+ -> lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
+ )
+ ]
diff --git a/data/Test250.hs b/data/Test250.hs
new file mode 100644
index 0000000..8493743
--- /dev/null
+++ b/data/Test250.hs
@@ -0,0 +1,6 @@
+{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE ViewPatterns #-}
+pattern Signed x <- (asSigned -> x) where
+ Signed (Neg x) = -x -- negative comment
+ Signed Zero = 0 -- zero comment
+ Signed (Pos x) = x -- positive comment
diff --git a/data/Test251.hs b/data/Test251.hs
new file mode 100644
index 0000000..3ea9b99
--- /dev/null
+++ b/data/Test251.hs
@@ -0,0 +1,2 @@
+{-# LANGUAGE PatternSynonyms #-}
+pattern J, K :: a -> Maybe a
diff --git a/data/Test252.hs b/data/Test252.hs
new file mode 100644
index 0000000..54eb4c5
--- /dev/null
+++ b/data/Test252.hs
@@ -0,0 +1,7 @@
+{-# LANGUAGE PatternSynonyms #-}
+pattern LongMatcher
+ :: longlongtypevar
+ -> longlongtypevar
+ -> longlongtypevar
+ -> Maybe [longlongtypevar]
+pattern LongMatcher x y z = Just [x, y, z]
diff --git a/data/Test253.hs b/data/Test253.hs
new file mode 100644
index 0000000..25fc4ce
--- /dev/null
+++ b/data/Test253.hs
@@ -0,0 +1,4 @@
+{-# LANGUAGE UnboxedTuples #-}
+spanKey :: (# Int, Int #) -> (# Int, Int #)
+spanKey = case foo of
+ (# bar, baz #) -> (# baz, bar #)
diff --git a/data/Test254.hs b/data/Test254.hs
new file mode 100644
index 0000000..3ceb254
--- /dev/null
+++ b/data/Test254.hs
@@ -0,0 +1,4 @@
+{-# LANGUAGE MagicHash, UnboxedTuples #-}
+spanKey :: (# Int#, Int# #) -> (# Int#, Int# #)
+spanKey = case foo of
+ (# bar#, baz# #) -> (# baz# +# bar#, bar# #)
diff --git a/data/Test255.hs b/data/Test255.hs
new file mode 100644
index 0000000..a644156
--- /dev/null
+++ b/data/Test255.hs
@@ -0,0 +1,5 @@
+{-# LANGUAGE QuasiQuotes #-}
+func = [blub|
+ asd
+ qwe
+ |]
diff --git a/data/Test256.hs b/data/Test256.hs
new file mode 100644
index 0000000..1624200
--- /dev/null
+++ b/data/Test256.hs
@@ -0,0 +1,4 @@
+{-# LANGUAGE QuasiQuotes #-}
+func = [blub|
+ asd
+ qwe|]
diff --git a/data/Test257.hs b/data/Test257.hs
new file mode 100644
index 0000000..20f877f
--- /dev/null
+++ b/data/Test257.hs
@@ -0,0 +1,6 @@
+{-# LANGUAGE QuasiQuotes #-}
+func = do
+ let body = [json|
+ hello
+ |]
+ pure True
diff --git a/data/Test258.hs b/data/Test258.hs
new file mode 100644
index 0000000..29039ca
--- /dev/null
+++ b/data/Test258.hs
@@ -0,0 +1,9 @@
+-- brittany { lconfig_allowHangingQuasiQuotes: False }
+{-# LANGUAGE QuasiQuotes #-}
+func = do
+ let
+ body =
+ [json|
+ hello
+ |]
+ pure True
diff --git a/data/Test259.hs b/data/Test259.hs
new file mode 100644
index 0000000..2407ef8
--- /dev/null
+++ b/data/Test259.hs
@@ -0,0 +1,2 @@
+{-# LANGUAGE OverloadedLabels #-}
+foo = #bar
diff --git a/data/Test26.hs b/data/Test26.hs
new file mode 100644
index 0000000..cdc1e7e
--- /dev/null
+++ b/data/Test26.hs
@@ -0,0 +1 @@
+func :: (a, b, c)
diff --git a/data/Test260.hs b/data/Test260.hs
new file mode 100644
index 0000000..d7cc187
--- /dev/null
+++ b/data/Test260.hs
@@ -0,0 +1,2 @@
+{-# LANGUAGE OverloadedLabels #-}
+foo = #bar . #baz $ fmap #foo xs
diff --git a/data/Test261.hs b/data/Test261.hs
new file mode 100644
index 0000000..f56379d
--- /dev/null
+++ b/data/Test261.hs
@@ -0,0 +1,2 @@
+{-# LANGUAGE ImplicitParams #-}
+foo = ?bar
diff --git a/data/Test262.hs b/data/Test262.hs
new file mode 100644
index 0000000..0ed092e
--- /dev/null
+++ b/data/Test262.hs
@@ -0,0 +1,2 @@
+{-# LANGUAGE ImplicitParams #-}
+foo = let ?bar = Foo in value
diff --git a/data/Test263.hs b/data/Test263.hs
new file mode 100644
index 0000000..a85a777
--- /dev/null
+++ b/data/Test263.hs
@@ -0,0 +1,3 @@
+{-# LANGUAGE ImplicitParams #-}
+foo :: (?bar::Bool) => ()
+foo = ()
diff --git a/data/Test264.hs b/data/Test264.hs
new file mode 100644
index 0000000..d3ebee3
--- /dev/null
+++ b/data/Test264.hs
@@ -0,0 +1,4 @@
+func = do
+ abc <- foo
+--abc
+return ()
diff --git a/data/Test265.hs b/data/Test265.hs
new file mode 100644
index 0000000..c965c63
--- /dev/null
+++ b/data/Test265.hs
@@ -0,0 +1 @@
+func = (())
diff --git a/data/Test266.hs b/data/Test266.hs
new file mode 100644
index 0000000..b6a3539
--- /dev/null
+++ b/data/Test266.hs
@@ -0,0 +1,4 @@
+func = do
+ let foo True = True
+ foo _ = False
+ return ()
diff --git a/data/Test267.hs b/data/Test267.hs
new file mode 100644
index 0000000..65d2172
--- /dev/null
+++ b/data/Test267.hs
@@ -0,0 +1,3 @@
+func = do
+ s <- mGet
+ mSet $ s { _lstate_indent = _lstate_indent state }
diff --git a/data/Test268.hs b/data/Test268.hs
new file mode 100644
index 0000000..6d369d8
--- /dev/null
+++ b/data/Test268.hs
@@ -0,0 +1,5 @@
+func = do
+ s <- mGet
+ mSet $ s { _lstate_indent = _lstate_indent state
+ , _lstate_foo = _lstate_foo state
+ }
diff --git a/data/Test269.hs b/data/Test269.hs
new file mode 100644
index 0000000..4741485
--- /dev/null
+++ b/data/Test269.hs
@@ -0,0 +1,6 @@
+func = do
+ s <- mGet
+ mSet $ s
+ { _lstate_indent = _lstate_indent lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
+ , _lstate_foo = _lstate_foo lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
+ }
diff --git a/data/Test27.hs b/data/Test27.hs
new file mode 100644
index 0000000..774cc9d
--- /dev/null
+++ b/data/Test27.hs
@@ -0,0 +1 @@
+func :: ((a, b, c), (a, b, c), (a, b, c))
diff --git a/data/Test270.hs b/data/Test270.hs
new file mode 100644
index 0000000..cd17597
--- /dev/null
+++ b/data/Test270.hs
@@ -0,0 +1 @@
+func = Foo { _lstate_indent = _lstate_indent state }
diff --git a/data/Test271.hs b/data/Test271.hs
new file mode 100644
index 0000000..112af5e
--- /dev/null
+++ b/data/Test271.hs
@@ -0,0 +1,4 @@
+func = Foo
+ { _lstate_indent = _lstate_indent lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
+ , _lstate_fooo = _lstate_foo lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
+ }
diff --git a/data/Test272.hs b/data/Test272.hs
new file mode 100644
index 0000000..3d0a415
--- /dev/null
+++ b/data/Test272.hs
@@ -0,0 +1,4 @@
+func = do
+ Foo { _lstate_indent = _lstate_indent lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
+ , _lstate_foo = _lstate_foo lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
+ }
diff --git a/data/Test273.hs b/data/Test273.hs
new file mode 100644
index 0000000..172b344
--- /dev/null
+++ b/data/Test273.hs
@@ -0,0 +1,4 @@
+func = do
+-- abc
+ -- def
+ return ()
diff --git a/data/Test274.hs b/data/Test274.hs
new file mode 100644
index 0000000..13d9924
--- /dev/null
+++ b/data/Test274.hs
@@ -0,0 +1,6 @@
+func = do
+ do
+ return ()
+ -- abc
+ -- def
+ return ()
diff --git a/data/Test275.hs b/data/Test275.hs
new file mode 100644
index 0000000..45fbb05
--- /dev/null
+++ b/data/Test275.hs
@@ -0,0 +1,6 @@
+func
+ :: Int -- basic indentation amount
+ -> Int -- currently used width in current line (after indent)
+ -- used to accurately calc placing of the current-line
+ -> LayoutDesc
+ -> Int
diff --git a/data/Test276.hs b/data/Test276.hs
new file mode 100644
index 0000000..1a55b76
--- /dev/null
+++ b/data/Test276.hs
@@ -0,0 +1,7 @@
+func =
+ ( lkjadljasldjalskdjaldjalsdjkalsdjlaksdjlasjdlajsaldskj
+ $ abc
+ $ def
+ $ ghi
+ $ jkl
+ )
diff --git a/data/Test277.hs b/data/Test277.hs
new file mode 100644
index 0000000..954c81d
--- /dev/null
+++ b/data/Test277.hs
@@ -0,0 +1,2 @@
+buildG bounds0 edges0 = accumArray (flip (:)) [] bounds0 (map reassoc edges0)
+ where reassoc (v, e, w) = (v, (e, w))
diff --git a/data/Test278.hs b/data/Test278.hs
new file mode 100644
index 0000000..012222d
--- /dev/null
+++ b/data/Test278.hs
@@ -0,0 +1,4 @@
+downloadRepoPackage = case repo of
+ RepoLocal {..} -> return ()
+ RepoLocal { abc } -> return ()
+ RepoLocal{} -> return ()
diff --git a/data/Test279.hs b/data/Test279.hs
new file mode 100644
index 0000000..2a53d37
--- /dev/null
+++ b/data/Test279.hs
@@ -0,0 +1,6 @@
+func = do
+ let (primaryPkg, otherPkgs) = selectPrimaryLocalPackage pwd pkgs'
+ (bproblems, x) = resolveBuildTargets primaryPkg otherPkgs utargets''
+ -- default local dir target if there's no given target
+ utargets'' = "foo"
+ return ()
diff --git a/data/Test28.hs b/data/Test28.hs
new file mode 100644
index 0000000..06bd705
--- /dev/null
+++ b/data/Test28.hs
@@ -0,0 +1,5 @@
+func
+ :: ( lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
+ , lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
+ , lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
+ )
diff --git a/data/Test280.hs b/data/Test280.hs
new file mode 100644
index 0000000..0ea93d9
--- /dev/null
+++ b/data/Test280.hs
@@ -0,0 +1,5 @@
+func =
+ [ (thing, take 10 alts) --TODO: select best ones
+ | (thing, _got, alts@(_ : _)) <- nosuchFooThing
+ , gast <- award
+ ]
diff --git a/data/Test281.hs b/data/Test281.hs
new file mode 100644
index 0000000..6366436
--- /dev/null
+++ b/data/Test281.hs
@@ -0,0 +1,5 @@
+func = if x
+ then if y -- y is important
+ then foo
+ else bar
+ else Nothing
diff --git a/data/Test282.hs b/data/Test282.hs
new file mode 100644
index 0000000..c6cba2d
--- /dev/null
+++ b/data/Test282.hs
@@ -0,0 +1,7 @@
+wrapPatPrepend pat prepElem = do
+ patDocs <- layoutPat pat
+ case Seq.viewl patDocs of
+ Seq.EmptyL -> return $ Seq.empty
+ x1 Seq.:< xR -> do
+ x1' <- docSeq [prepElem, return x1]
+ return $ x1' Seq.<| xR
diff --git a/data/Test283.hs b/data/Test283.hs
new file mode 100644
index 0000000..21044e6
--- /dev/null
+++ b/data/Test283.hs
@@ -0,0 +1,6 @@
+layoutWriteNewlineBlock
+ :: ( MonadMultiWriter Text.Builder.Builder m
+ , MonadMultiState LayoutState m
+ , MonadMultiWriter (Seq String) m
+ )
+ => m ()
diff --git a/data/Test284.hs b/data/Test284.hs
new file mode 100644
index 0000000..f6a21c7
--- /dev/null
+++ b/data/Test284.hs
@@ -0,0 +1,24 @@
+{-# LANGUAGE MultiWayIf #-}
+readMergePersConfig path shouldCreate conf = do
+ exists <- liftIO $ System.Directory.doesFileExist path
+ if
+ | exists -> do
+ contents <- liftIO $ ByteString.readFile path -- no lazy IO, tyvm.
+ fileConf <- case Data.Yaml.decodeEither contents of
+ Left e -> do
+ liftIO
+ $ putStrErrLn
+ $ "error reading in brittany config from "
+ ++ path
+ ++ ":"
+ liftIO $ putStrErrLn e
+ mzero
+ Right x -> return x
+ return $ fileConf Semigroup.<> conf
+ | shouldCreate -> do
+ liftIO $ ByteString.writeFile path $ Data.Yaml.encode $ cMap
+ (Option . Just . runIdentity)
+ staticDefaultConfig
+ return $ conf
+ | otherwise -> do
+ return conf
diff --git a/data/Test285.hs b/data/Test285.hs
new file mode 100644
index 0000000..388281d
--- /dev/null
+++ b/data/Test285.hs
@@ -0,0 +1,12 @@
+func = BuildReport
+ where
+ convertInstallOutcome = case result of
+ Left BR.PlanningFailed -> PlanningFailed
+ Left (BR.DependentFailed p) -> DependencyFailed p
+ Left (BR.DownloadFailed _) -> DownloadFailed
+ Left (BR.UnpackFailed _) -> UnpackFailed
+ Left (BR.ConfigureFailed _) -> ConfigureFailed
+ Left (BR.BuildFailed _) -> BuildFailed
+ Left (BR.TestsFailed _) -> TestsFailed
+ Left (BR.InstallFailed _) -> InstallFailed
+ Right (BR.BuildOk _ _ _ ) -> InstallOk
diff --git a/data/Test286.hs b/data/Test286.hs
new file mode 100644
index 0000000..388281d
--- /dev/null
+++ b/data/Test286.hs
@@ -0,0 +1,12 @@
+func = BuildReport
+ where
+ convertInstallOutcome = case result of
+ Left BR.PlanningFailed -> PlanningFailed
+ Left (BR.DependentFailed p) -> DependencyFailed p
+ Left (BR.DownloadFailed _) -> DownloadFailed
+ Left (BR.UnpackFailed _) -> UnpackFailed
+ Left (BR.ConfigureFailed _) -> ConfigureFailed
+ Left (BR.BuildFailed _) -> BuildFailed
+ Left (BR.TestsFailed _) -> TestsFailed
+ Left (BR.InstallFailed _) -> InstallFailed
+ Right (BR.BuildOk _ _ _ ) -> InstallOk
diff --git a/data/Test287.hs b/data/Test287.hs
new file mode 100644
index 0000000..a50af8b
--- /dev/null
+++ b/data/Test287.hs
@@ -0,0 +1,35 @@
+showPackageDetailedInfo pkginfo =
+ renderStyle (style { lineLength = 80, ribbonsPerLine = 1 })
+ $ char '*'
+ $+$ something
+ [ entry "Synopsis" synopsis hideIfNull reflowParagraphs
+ , entry "Versions available"
+ sourceVersions
+ (altText null "[ Not available from server ]")
+ (dispTopVersions 9 (preferredVersions pkginfo))
+ , entry
+ "Versions installed"
+ installedVersions
+ (altText
+ null
+ (if hasLib pkginfo then "[ Not installed ]" else "[ Unknown ]")
+ )
+ (dispTopVersions 4 (preferredVersions pkginfo))
+ , entry "Homepage" homepage orNotSpecified text
+ , entry "Bug reports" bugReports orNotSpecified text
+ , entry "Description" description hideIfNull reflowParagraphs
+ , entry "Category" category hideIfNull text
+ , entry "License" license alwaysShow disp
+ , entry "Author" author hideIfNull reflowLines
+ , entry "Maintainer" maintainer hideIfNull reflowLines
+ , entry "Source repo" sourceRepo orNotSpecified text
+ , entry "Executables" executables hideIfNull (commaSep text)
+ , entry "Flags" flags hideIfNull (commaSep dispFlag)
+ , entry "Dependencies" dependencies hideIfNull (commaSep dispExtDep)
+ , entry "Documentation" haddockHtml showIfInstalled text
+ , entry "Cached" haveTarball alwaysShow dispYesNo
+ , if not (hasLib pkginfo)
+ then empty
+ else text "Modules:"
+ $+$ nest 4 (vcat (map disp . sort . modules $ pkginfo))
+ ]
diff --git a/data/Test288.hs b/data/Test288.hs
new file mode 100644
index 0000000..3289dd7
--- /dev/null
+++ b/data/Test288.hs
@@ -0,0 +1,2 @@
+isValidPosition position | validX && validY = Just position
+ | otherwise = Nothing
diff --git a/data/Test289.hs b/data/Test289.hs
new file mode 100644
index 0000000..023032c
--- /dev/null
+++ b/data/Test289.hs
@@ -0,0 +1,6 @@
+foo = Reflex.runSpiderHost $ ReflexHost.hostApp $ do
+ (inputEvent :: Reflex.Event Reflex.Spider String, inputFire :: String
+ -> IO Bool ) <-
+ ReflexHost.newExternalEvent
+ liftIO . forkIO . forever $ getLine >>= inputFire
+ ReflexHost.performEvent_ $ fmap (liftIO . putStrLn) inputEvent
diff --git a/data/Test29.hs b/data/Test29.hs
new file mode 100644
index 0000000..fc19ba1
--- /dev/null
+++ b/data/Test29.hs
@@ -0,0 +1,6 @@
+func
+ :: ( ( lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
+ , (lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd)
+ , lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
+ )
+ )
diff --git a/data/Test290.hs b/data/Test290.hs
new file mode 100644
index 0000000..689fa70
--- /dev/null
+++ b/data/Test290.hs
@@ -0,0 +1,2 @@
+foldrDesc f z = unSwitchQueue $ \q ->
+ switch (Min.foldrDesc (f unTaggedF) z q) (Min.foldrAsc (f unTaggedF) z q)
diff --git a/data/Test291.hs b/data/Test291.hs
new file mode 100644
index 0000000..68face0
--- /dev/null
+++ b/data/Test291.hs
@@ -0,0 +1,5 @@
+autocheckCases =
+ [ ("Never Deadlocks" , representative deadlocksNever)
+ , ("No Exceptions" , representative exceptionsNever)
+ , ("Consistent Result", alwaysSame) -- already representative
+ ]
diff --git a/data/Test292.hs b/data/Test292.hs
new file mode 100644
index 0000000..cc6ecb2
--- /dev/null
+++ b/data/Test292.hs
@@ -0,0 +1,7 @@
+autocheckCases =
+ [ ("Never Deadlocks", representative deadlocksNever)
+ , ("No Exceptions" , representative exceptionsNever)
+ , ( "Consistent Result"
+ , alwaysSame -- already representative
+ )
+ ]
diff --git a/data/Test293.hs b/data/Test293.hs
new file mode 100644
index 0000000..596f9ea
--- /dev/null
+++ b/data/Test293.hs
@@ -0,0 +1,5 @@
+func =
+ [ (abc, (1111, 1111))
+ , (def, (2, 2))
+ , foo -- comment
+ ]
diff --git a/data/Test294.hs b/data/Test294.hs
new file mode 100644
index 0000000..927da51
--- /dev/null
+++ b/data/Test294.hs
@@ -0,0 +1,2 @@
+foo a b = g a b -- fooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo
+ where g a b = b + b * a
diff --git a/data/Test295.hs b/data/Test295.hs
new file mode 100644
index 0000000..2b6fc80
--- /dev/null
+++ b/data/Test295.hs
@@ -0,0 +1 @@
+foo a b = g a b where g a b = b + b * a -- fooooooooooooooooooooooooooooooooooo
diff --git a/data/Test296.hs b/data/Test296.hs
new file mode 100644
index 0000000..1954213
--- /dev/null
+++ b/data/Test296.hs
@@ -0,0 +1,5 @@
+func = do
+ abc <- expr
+ abcccccccccccccccccc <- expr
+ abcccccccccccccccccccccccccccccccccccccccccc <- expr
+ abccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc <- expr
diff --git a/data/Test297.hs b/data/Test297.hs
new file mode 100644
index 0000000..198bd69
--- /dev/null
+++ b/data/Test297.hs
@@ -0,0 +1,3 @@
+func (MyLongFoo abc def) = 1
+func (Bar a d ) = 2
+func _ = 3
diff --git a/data/Test298.hs b/data/Test298.hs
new file mode 100644
index 0000000..17013e2
--- /dev/null
+++ b/data/Test298.hs
@@ -0,0 +1,14 @@
+parserCompactLocation =
+ [ try
+ $ [ ParseRelAbs (Text.Read.read digits) _ _
+ | digits <- many1 digit
+ , rel1 :: Maybe (Either Int (Ratio Int)) <- optionMaybe
+ [ case divPart of
+ Nothing -> Left $ Text.Read.read digits
+ Just ddigits ->
+ Right $ Text.Read.read digits % Text.Read.read ddigits
+ | digits <- many1 digit
+ , divPart <- optionMaybe (string "/" *> many1 digit)
+ ]
+ ]
+ ]
diff --git a/data/Test299.hs b/data/Test299.hs
new file mode 100644
index 0000000..26927f9
--- /dev/null
+++ b/data/Test299.hs
@@ -0,0 +1,3 @@
+func = fooooooooooooooooooooooooooooooooo $ foooooooooooooooooooooooooooooooo
+ foooooooooooooooooooooooooooooooo
+ foooooooooooooooooooooooooooooooo
diff --git a/data/Test3.hs b/data/Test3.hs
new file mode 100644
index 0000000..98d8196
--- /dev/null
+++ b/data/Test3.hs
@@ -0,0 +1,4 @@
+func
+ :: lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
+ -> lakjsdlkjasldkj
+ -> lakjsdlkjasldkj
diff --git a/data/Test30.hs b/data/Test30.hs
new file mode 100644
index 0000000..2ed144e
--- /dev/null
+++ b/data/Test30.hs
@@ -0,0 +1,6 @@
+func
+ :: [ ( lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
+ , lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
+ , lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
+ )
+ ]
diff --git a/data/Test300.hs b/data/Test300.hs
new file mode 100644
index 0000000..0338df4
--- /dev/null
+++ b/data/Test300.hs
@@ -0,0 +1,4 @@
+func =
+ fooooooooooooooooooooooooooooooooo
+ + foooooooooooooooooooooooooooooooo foooooooooooooooooooooooooooooooo
+ foooooooooooooooooooooooooooooooo
diff --git a/data/Test301.hs b/data/Test301.hs
new file mode 100644
index 0000000..bd8d21c
--- /dev/null
+++ b/data/Test301.hs
@@ -0,0 +1,5 @@
+func = fooooooooooooooooooooooooooooooooo + foooooooooooooooooooooooooooooooo
+ [ foooooooooooooooooooooooooooooooo
+ , foooooooooooooooooooooooooooooooo
+ , foooooooooooooooooooooooooooooooo
+ ]
diff --git a/data/Test302.hs b/data/Test302.hs
new file mode 100644
index 0000000..946346c
--- /dev/null
+++ b/data/Test302.hs
@@ -0,0 +1,18 @@
+parserPrim =
+ [ r
+ | r <-
+ [ SGPPrimFloat $ bool id (0 -) minus $ readGnok "parserPrim"
+ (d1 ++ d2 ++ d3 ++ d4)
+ | d2 <- string "."
+ , d3 <- many1 (oneOf "0123456789")
+ , _ <- string "f"
+ ]
+ <|> [ SGPPrimFloat $ bool id (0 -) minus $ fromIntegral
+ (readGnok "parserPrim" d1 :: Integer)
+ | _ <- string "f"
+ ]
+ <|> [ SGPPrimInt $ bool id (0 -) minus $ fromIntegral
+ (readGnok "parserPrim" d1 :: Integer)
+ | _ <- string "i"
+ ]
+ ]
diff --git a/data/Test303.hs b/data/Test303.hs
new file mode 100644
index 0000000..d3f4d9e
--- /dev/null
+++ b/data/Test303.hs
@@ -0,0 +1,2 @@
+samples = (SV.unpackaaaaadat) <&> \f ->
+ aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
diff --git a/data/Test304.hs b/data/Test304.hs
new file mode 100644
index 0000000..c62bfc0
--- /dev/null
+++ b/data/Test304.hs
@@ -0,0 +1,9 @@
+runBrittany tabSize text = do
+ let config' = staticDefaultConfig
+ config = config'
+ { _conf_layout = (_conf_layout config')
+ { _lconfig_indentAmount = coerce tabSize
+ }
+ , _conf_forward = forwardOptionsSyntaxExtsEnabled
+ }
+ parsePrintModule config text
diff --git a/data/Test305.hs b/data/Test305.hs
new file mode 100644
index 0000000..a288c39
--- /dev/null
+++ b/data/Test305.hs
@@ -0,0 +1,11 @@
+-- brittany { lconfig_indentPolicy: IndentPolicyLeft }
+runBrittany tabSize text = do
+ let
+ config' = staticDefaultConfig
+ config = config'
+ { _conf_layout = (_conf_layout config')
+ { _lconfig_indentAmount = coerce tabSize
+ }
+ , _conf_forward = forwardOptionsSyntaxExtsEnabled
+ }
+ parsePrintModule config text
diff --git a/data/Test306.hs b/data/Test306.hs
new file mode 100644
index 0000000..822d18a
--- /dev/null
+++ b/data/Test306.hs
@@ -0,0 +1,7 @@
+foo =
+ ( a
+ , -- comment1
+ b
+ -- comment2
+ , c
+ )
diff --git a/data/Test307.hs b/data/Test307.hs
new file mode 100644
index 0000000..0d54fb5
--- /dev/null
+++ b/data/Test307.hs
@@ -0,0 +1,2 @@
+{-# LANGUAGE TypeApplications #-}
+foo = bar @Baz
diff --git a/data/Test308.hs b/data/Test308.hs
new file mode 100644
index 0000000..ca3fd97
--- /dev/null
+++ b/data/Test308.hs
@@ -0,0 +1,50 @@
+{-# LANGUAGE TypeApplications #-}
+layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs = do
+ docAlt
+ $ -- one-line solution
+ [ docCols
+ (ColBindingLine alignmentToken)
+ [ docSeq (patPartInline ++ [guardPart])
+ , docSeq
+ [ appSep $ return binderDoc
+ , docForceSingleline $ return body
+ , wherePart
+ ]
+ ]
+ | not hasComments
+ , [(guards, body, _bodyRaw)] <- [clauseDocs]
+ , let guardPart = singleLineGuardsDoc guards
+ , wherePart <- case mWhereDocs of
+ Nothing -> return @[] $ docEmpty
+ Just [w] -> return @[] $ docSeq
+ [ docSeparator
+ , appSep $ docLit $ Text.pack "where"
+ , docSetIndentLevel $ docForceSingleline $ return w
+ ]
+ _ -> []
+ ]
+ ++ -- one-line solution + where in next line(s)
+ [ docLines
+ $ [ docCols
+ (ColBindingLine alignmentToken)
+ [ docSeq (patPartInline ++ [guardPart])
+ , docSeq
+ [appSep $ return binderDoc, docForceParSpacing $ return body]
+ ]
+ ]
+ ++ wherePartMultiLine
+ | [(guards, body, _bodyRaw)] <- [clauseDocs]
+ , let guardPart = singleLineGuardsDoc guards
+ , Data.Maybe.isJust mWhereDocs
+ ]
+ ++ -- two-line solution + where in next line(s)
+ [ docLines
+ $ [ docForceSingleline
+ $ docSeq (patPartInline ++ [guardPart, return binderDoc])
+ , docEnsureIndent BrIndentRegular $ docForceSingleline $ return
+ body
+ ]
+ ++ wherePartMultiLine
+ | [(guards, body, _bodyRaw)] <- [clauseDocs]
+ , let guardPart = singleLineGuardsDoc guards
+ ]
diff --git a/data/Test309.hs b/data/Test309.hs
new file mode 100644
index 0000000..d02a8c6
--- /dev/null
+++ b/data/Test309.hs
@@ -0,0 +1,9 @@
+{-# LANGUAGE MultiWayIf #-}
+func = do
+ let foo = if
+ | Constuctoooooooooooooooooooooooooooooooooooor `elem` artics -- TODO
+ -> max
+ (defLen - 0.2) -- TODO
+ (defLen * 0.8)
+ | otherwise -> max (defLen - 0.05) (defLen * 0.95) -- TODO
+ return True
diff --git a/data/Test31.hs b/data/Test31.hs
new file mode 100644
index 0000000..7e217d5
--- /dev/null
+++ b/data/Test31.hs
@@ -0,0 +1,2 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+func :: forall (a :: *) b . a -> b
diff --git a/data/Test310.hs b/data/Test310.hs
new file mode 100644
index 0000000..a6f54fa
--- /dev/null
+++ b/data/Test310.hs
@@ -0,0 +1,5 @@
+foo n = case n of
+ 1 -> True
+ -1 -> False
+bar n = case n of
+ (-2, -2) -> (-2, -2)
diff --git a/data/Test311.hs b/data/Test311.hs
new file mode 100644
index 0000000..99e92c5
--- /dev/null
+++ b/data/Test311.hs
@@ -0,0 +1,5 @@
+{-# LANGUAGE TypeApplications #-}
+foo =
+ let a = b @1
+ cccc = ()
+ in foo
diff --git a/data/Test312.hs b/data/Test312.hs
new file mode 100644
index 0000000..615e416
--- /dev/null
+++ b/data/Test312.hs
@@ -0,0 +1,2 @@
+{-# LANGUAGE RecordWildCards #-}
+v = A { a = 1, .. } where b = 2
diff --git a/data/Test313.hs b/data/Test313.hs
new file mode 100644
index 0000000..1f5f34f
--- /dev/null
+++ b/data/Test313.hs
@@ -0,0 +1,2 @@
+{-# LANGUAGE RecordWildCards #-}
+v = A { .. } where b = 2
diff --git a/data/Test314.hs b/data/Test314.hs
new file mode 100644
index 0000000..e0cc55d
--- /dev/null
+++ b/data/Test314.hs
@@ -0,0 +1,2 @@
+{-# LANGUAGE RecordWildCards #-}
+v = A { a = 1, b = 2, c = 3 }
diff --git a/data/Test315.hs b/data/Test315.hs
new file mode 100644
index 0000000..8bd72ce
--- /dev/null
+++ b/data/Test315.hs
@@ -0,0 +1 @@
+test :: Proxy 'Int
diff --git a/data/Test316.hs b/data/Test316.hs
new file mode 100644
index 0000000..e5a8eef
--- /dev/null
+++ b/data/Test316.hs
@@ -0,0 +1 @@
+test :: Proxy '[ 'True]
diff --git a/data/Test317.hs b/data/Test317.hs
new file mode 100644
index 0000000..79d5442
--- /dev/null
+++ b/data/Test317.hs
@@ -0,0 +1 @@
+test :: Proxy '[Bool]
diff --git a/data/Test318.hs b/data/Test318.hs
new file mode 100644
index 0000000..f2c5673
--- /dev/null
+++ b/data/Test318.hs
@@ -0,0 +1,7 @@
+{-# LANGUAGE RankNTypes, KindSignatures #-}
+func
+ :: forall m str
+ . (Str str, Monad m)
+ => Int
+ -> Proxy (str :: [*])
+ -> m (Tagged str String)
diff --git a/data/Test319.hs b/data/Test319.hs
new file mode 100644
index 0000000..1c6ce85
--- /dev/null
+++ b/data/Test319.hs
@@ -0,0 +1,13 @@
+widgetsDyn =
+ [ [ vBox
+ [ padTop Max outputLinesWidget
+ , padRight Max wid1 <+> flowWidget -- alignment here is strange/buggy
+ , padBottom (Pad 5) help
+ ]
+ ]
+ | wid1 <- promptDyn
+ , (flowWidget, _) <- flowResultD
+ , outputLinesWidget <- outputLinesWidgetD
+ , help <- suggestionHelpBox
+ , parser <- cmdParserD
+ ]
diff --git a/data/Test32.hs b/data/Test32.hs
new file mode 100644
index 0000000..19e72f4
--- /dev/null
+++ b/data/Test32.hs
@@ -0,0 +1,10 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+func
+ :: forall m
+ . Foo
+ => ColMap2
+ -> ColInfo
+ -> ColInfo
+ -> ColInfo
+ -> ColInfo
+ -> m ()
diff --git a/data/Test320.hs b/data/Test320.hs
new file mode 100644
index 0000000..c7e9eae
--- /dev/null
+++ b/data/Test320.hs
@@ -0,0 +1,2 @@
+fmapuv :: U.Unbox a => (a -> b) -> U.Vector a -> V.Vector b
+fmapuv f xs = G.generate (G.length xs) (f . (xs G.!))
diff --git a/data/Test321.hs b/data/Test321.hs
new file mode 100644
index 0000000..5cee20d
--- /dev/null
+++ b/data/Test321.hs
@@ -0,0 +1 @@
+cs0 = 0 : [ c / Interval n | c <- cs | n <- [1..] ]
diff --git a/data/Test322.hs b/data/Test322.hs
new file mode 100644
index 0000000..f515f6d
--- /dev/null
+++ b/data/Test322.hs
@@ -0,0 +1,2 @@
+{-# LANGUAGE TemplateHaskell #-}
+deriveFromJSON (unPrefix "assignPost") ''AssignmentPost
diff --git a/data/Test323.hs b/data/Test323.hs
new file mode 100644
index 0000000..ae0ee2e
--- /dev/null
+++ b/data/Test323.hs
@@ -0,0 +1,7 @@
+main = -- a
+ let --b
+ x = 1 -- x
+ y = 2 -- y
+ in do
+ print x
+ print y
diff --git a/data/Test324.hs b/data/Test324.hs
new file mode 100644
index 0000000..fcbe491
--- /dev/null
+++ b/data/Test324.hs
@@ -0,0 +1,9 @@
+alternatives :: Parser (Maybe Text)
+alternatives =
+ alternativeOne -- first try this one
+ <|> alterantiveTwo -- then this one
+ <|> alternativeThree -- then this one
+ where
+ alternativeOne = purer "one"
+ alternativeTwo = purer "two"
+ alterantiveThree = purer "three"
diff --git a/data/Test325.hs b/data/Test325.hs
new file mode 100644
index 0000000..b8d67d0
--- /dev/null
+++ b/data/Test325.hs
@@ -0,0 +1,4 @@
+{-# LANGUAGE BangPatterns #-}
+func = do
+ let !forced = some
+ pure ()
diff --git a/data/Test326.hs b/data/Test326.hs
new file mode 100644
index 0000000..0435d04
--- /dev/null
+++ b/data/Test326.hs
@@ -0,0 +1,4 @@
+spanKey p q = case minViewWithKey q of
+ Just ((k, _), q') | p k ->
+ let (kas, q'') = spanKey p q' in ((k, a) : kas, q'')
+ _ -> ([], q)
diff --git a/data/Test327.hs b/data/Test327.hs
new file mode 100644
index 0000000..b7efa94
--- /dev/null
+++ b/data/Test327.hs
@@ -0,0 +1 @@
+a :: () ':- ()
diff --git a/data/Test328.hs b/data/Test328.hs
new file mode 100644
index 0000000..c2ace2f
--- /dev/null
+++ b/data/Test328.hs
@@ -0,0 +1,3 @@
+func = do
+ createDirectoryIfMissing True path
+ openFile fileName AppendMode
diff --git a/data/Test329.hs b/data/Test329.hs
new file mode 100644
index 0000000..449cf88
--- /dev/null
+++ b/data/Test329.hs
@@ -0,0 +1,7 @@
+alternatives :: Parser (Maybe Text)
+alternatives = -- a
+ ( -- b
+ alternativeOne -- c
+ <|> alterantiveTwo -- d
+ <|> alternativeThree -- e
+ ) -- f
diff --git a/data/Test33.hs b/data/Test33.hs
new file mode 100644
index 0000000..335c68e
--- /dev/null
+++ b/data/Test33.hs
@@ -0,0 +1,10 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+func
+ :: forall m
+ . ColMap2
+ -> ColInfo
+ -> ColInfo
+ -> ColInfo
+ -> ColInfo
+ -> ColInfo
+ -> m ()
diff --git a/data/Test330.hs b/data/Test330.hs
new file mode 100644
index 0000000..0485ac6
--- /dev/null
+++ b/data/Test330.hs
@@ -0,0 +1,10 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+func
+ :: forall a
+ . ()
+ => aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
+ -> aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
+func
+ :: ()
+ => aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
+ -> aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
diff --git a/data/Test331.hs b/data/Test331.hs
new file mode 100644
index 0000000..9737285
--- /dev/null
+++ b/data/Test331.hs
@@ -0,0 +1,5 @@
+go l [] = Right l
+go l ((IRType, _a) : eqr) = go l eqr
+go l ((_, IRType) : eqr) = go l eqr
+go _ ((IRTypeError ps t1 t2, _) : _) = Left $ makeError ps t1 t2
+go _ ((_, IRTypeError ps t1 t2) : _) = Left $ makeError ps t1 t2
diff --git a/data/Test332.hs b/data/Test332.hs
new file mode 100644
index 0000000..1785320
--- /dev/null
+++ b/data/Test332.hs
@@ -0,0 +1,2 @@
+type instance XPure StageParse = ()
+type Pair a = (a, a)
diff --git a/data/Test333.hs b/data/Test333.hs
new file mode 100644
index 0000000..0b87f50
--- /dev/null
+++ b/data/Test333.hs
@@ -0,0 +1,18 @@
+-- brittany { lconfig_indentAmount: 4, lconfig_indentPolicy: IndentPolicyMultiple }
+dsfnjKeekbwwbosbOfakxqRsiyix cnehokzozwbVaguvu migbnaRwutbz =
+ let
+ eyuAfrarIso'
+ :: (RveoexdxunuAafalm -> Axlau (Axlau (a, OinejrdCplle)))
+ -> Gbodoy
+ -> Axlau (Axlau OinejrdCplle, Gbodoy)
+ eyuAfrarIso' = ulcPaaekBst cnehokzozwbVaguvu
+ amkgoxEhalazJjxunecCuIfaw
+ :: Axlau (Axlau OinejrdCplle, Gbodoy) -> Axlau RqlnrluYqednbCiggxi
+ amkgoxEhalazJjxunecCuIfaw uKqviuBisjtn = do
+ (sEmo, quc) <- uKqviuBisjtn
+ pure (xoheccewfWoeyiagOkfodiq sEmo quc)
+ xoheccewfWoeyiagOkfodiq
+ :: Axlau OinejrdCplle -> Gbodoy -> RqlnrluYqednbCiggxi
+ xoheccewfWoeyiagOkfodiq sEmo quc = case migbnaRwutbz of
+ Afogmf -> xgeqe (OfBkkuih quc) (Ciitog quc) sEmo
+ in QabqyilexuiNizzhsQuxxac migbnaRwutbz (hwaTihhjt lhowvscIiozgqe)
diff --git a/data/Test334.hs b/data/Test334.hs
new file mode 100644
index 0000000..f97dfd6
--- /dev/null
+++ b/data/Test334.hs
@@ -0,0 +1,5 @@
+spec = do
+ it "creates a snapshot at the given level" . withGraph runDB $ do
+ lift $ do
+ studentDiagnosticReadingLevel updatedStudent `shouldBe` Just 10 -- x
+ elaSnapshotReadingLevel snapshot `shouldBe` 12
diff --git a/data/Test335.hs b/data/Test335.hs
new file mode 100644
index 0000000..0a2a760
--- /dev/null
+++ b/data/Test335.hs
@@ -0,0 +1,12 @@
+jaicyhHumzo btrKpeyiFej mava = do
+ m :: VtohxeRgpmgsu <- qloxIfiq mava
+ case m of
+ ZumnaoFujayerIswadabo kkecm chlixxag -> do
+ imomue <- ozisduRaqiseSBAob btrKpeyiFej $ \s ->
+ case MizA.pigevo kkecm (_tc_gulawulu s) of
+ Ebocaba ->
+ ( s { _tc_gulawulu = MizA.jxariu kkecm rwuRqxzhjo (_tc_gulawulu s) }
+ , Gtzvonm
+ )
+ Xcde{} -> (s, Pioemav)
+ pure imomue
diff --git a/data/Test336.hs b/data/Test336.hs
new file mode 100644
index 0000000..5876f85
--- /dev/null
+++ b/data/Test336.hs
@@ -0,0 +1,8 @@
+-- brittany { lconfig_indentPolicy: IndentPolicyMultiple }
+foo = bar
+ arg1 -- this is the first argument
+ arg2 -- this is the second argument
+ arg3 -- this is the third argument, now I'll skip one comment
+ arg4
+ arg5 -- this is the fifth argument
+ arg6 -- this is the sixth argument
diff --git a/data/Test337.hs b/data/Test337.hs
new file mode 100644
index 0000000..917af95
--- /dev/null
+++ b/data/Test337.hs
@@ -0,0 +1,4 @@
+True `nand` True = False
+nand _ _ = True
+nor False False = True
+_ `nor` _ = False
diff --git a/data/Test338.hs b/data/Test338.hs
new file mode 100644
index 0000000..e6df6c6
--- /dev/null
+++ b/data/Test338.hs
@@ -0,0 +1 @@
+f ((:) a as) = undefined
diff --git a/data/Test339.hs b/data/Test339.hs
new file mode 100644
index 0000000..cfa949d
--- /dev/null
+++ b/data/Test339.hs
@@ -0,0 +1,5 @@
+{-# LANGUAGE BangPatterns #-}
+a = \x -> x
+b = \ ~x -> x
+c = \ !x -> x
+d = \(~x) -> x
diff --git a/data/Test34.hs b/data/Test34.hs
new file mode 100644
index 0000000..24f6b28
--- /dev/null
+++ b/data/Test34.hs
@@ -0,0 +1,9 @@
+{-# LANGUAGE RankNTypes #-}
+addFlagStringParam
+ :: forall f out
+ . (Applicative f)
+ => String -- ^ short flag chars, i.e. "v" for -v
+ -> [String] -- ^ list of long names, i.e. ["verbose"]
+ -> String -- ^ param name
+ -> Flag String -- ^ properties
+ -> CmdParser f out String
diff --git a/data/Test340.hs b/data/Test340.hs
new file mode 100644
index 0000000..fb61bc1
--- /dev/null
+++ b/data/Test340.hs
@@ -0,0 +1,2 @@
+{-# LANGUAGE RankNTypes #-}
+func :: forall b . Show b => b -> String
diff --git a/data/Test341.hs b/data/Test341.hs
new file mode 100644
index 0000000..cea68da
--- /dev/null
+++ b/data/Test341.hs
@@ -0,0 +1,3 @@
+{-# LANGUAGE TypeFamilies #-}
+f :: ((~) a b) => a -> b
+f = id
diff --git a/data/Test342.hs b/data/Test342.hs
new file mode 100644
index 0000000..c522948
--- /dev/null
+++ b/data/Test342.hs
@@ -0,0 +1,50 @@
+-- brittany { lconfig_indentPolicy: IndentPolicyLeft }
+vakjkeSulxudbFokvir = Duotpo
+ { _ekku_gcrpbze = xgonae (1 :: Int)
+ , _oola_louwu = FoqsiYcuidx
+ { _xxagu_umea_iaztoj = xgonae False
+ , _tuktg_tizo_kfikacygsqf = xgonae False
+ , _ahzbo_xpow_otq_nzeyufq = xgonae False
+ , _uagpi_lzps_luy_xcjn = xgonae False
+ , _dxono_qjef_aqtafq_bes = xgonae False
+ , _yzuaf_nviy_vuhwxe_ihnbo_uhw = xgonae False
+ , _iwcit_fzjs_yerakt_dicox_mtryitko = xgonae False
+ , _ehjim_ucfe_dewarp_newrt_gso = xgonae False
+ , _ogtxb_ivoj_amqgai_rttui_xuwhetb = xgonae False
+ , _bhycb_iexz_megaug_qunoa_ohaked = xgonae False
+ , _nnmbe_uqgt_ewsuga_vaiis = xgonae False
+ , _otzil_ucvugaiyj_aosoiatunx_asir = xgonae False
+ }
+ , _iwsc_lalojz = XqspaiDainqw
+ { _uajznac_ugah = xgonae (80 :: Int)
+ , _qayziku_gazibzDejipj = xgonae DewizeCxwgyiKjig
+ , _auhebll_fiqjxyArfxia = xgonae (2 :: Int)
+ , _zubfuhq_dupiwnIoophXameeet = xgonae True
+ , _oavnuqg_opkreyOufuIkifiin = xgonae True
+ , _ufojfwy_fhuzcePeqwfu = xgonae (50 :: Int)
+ , _mlosikq_zajdxxSeRoelpf = xgonae (50 :: Int)
+ , _heemavf_fjgOfoaikh = xgonae (FyoVfvdygaZuzuvbeWarwuq 3)
+ , _ohxmeoq_ogtbfoPtqezVseu = xgonae (EdjotoLcbapUdiuMmytwoig 0.7)
+ , _omupuiu_ituamexjuLccwu = xgonae (30 :: Int)
+ , _xoseksf_atvwwdwaoHanofMyUvujjopoz = xgonae True
+ , _umuuuat_nuamezwWeqfUqzrnaxwp = xgonae False
+ , _uuriguz_wixhutbuKecigaFiwosret = xgonae True
+ , _betohxp_scixaLsvcesErtwItxrnaJmuz = xgonae False
+ , _lchxgee_olaetGcqzuqxVujenCzexub = xgonae True
+ , _egeibao_imamkuigqikhZdcbpidokVcixiqew = xgonae False
+ }
+ , _nloo_cfmrgZcisiugk = YuwodSavxwnicBekuel
+ { _oebew_rrtpvthUzlizjAqIwesly = xgonae False
+ , _blkff_Acxoid = xgonae False
+ , _datei_YewolAowoqOpunvpgu = xgonae BeekgUzojaPnixxaruJehyPmnnfu
+ , _ejfrj_eheb_justvh_pumcp_ismya = xgonae False
+ }
+ , _kena_uzeddovosoki = NyoRvshullezUpauud
+ { _mtfuwi_TUVEmoi = xgonae RZXKoytUtogx
+ , _larqam_adaxPehaylZafeqgpc = xgonae False
+ }
+ , _spob_qipaarx = KaxavsmOtoyeaq { _rusrirw_okx = Tajemkix [] }
+ , _vmah_uivucnfka_ikaquebxay_gzcm = xgonae False
+ , _qaqb_eykzuyuwi = xgonae False
+ -- test comment
+ }
diff --git a/data/Test343.hs b/data/Test343.hs
new file mode 100644
index 0000000..bb5d7d2
--- /dev/null
+++ b/data/Test343.hs
@@ -0,0 +1,10 @@
+-- brittany { lconfig_indentPolicy: IndentPolicyLeft }
+vakjkeSulxudbFokvir = Duotpo
+ { _ekku_gcrpbze = xgonae (1 :: Int)
+ , _spob_qipaarx = KaxavsmOtoyeaq { _rusrirw_okx = Tajemkix [] }
+ , _vmah_uivucnfka_ikaquebxay_gzcm = xgonae False
+ , _qaqb_eykzuyuwi = xgonae False
+ -- test comment
+ , -- N.B.
+ .. -- x
+ }
diff --git a/data/Test344.hs b/data/Test344.hs
new file mode 100644
index 0000000..53649fc
--- /dev/null
+++ b/data/Test344.hs
@@ -0,0 +1,7 @@
+func = abc + def
+ -- a
+ -- b
+ -- comment
+ where
+ abc = 13
+ def = 1
diff --git a/data/Test345.hs b/data/Test345.hs
new file mode 100644
index 0000000..613a398
--- /dev/null
+++ b/data/Test345.hs
@@ -0,0 +1,13 @@
+zItazySunefp twgq nlyo lwojjoBiecao =
+ let mhIarjyai =
+ ukwAausnfcn
+ $ XojlsTOSR.vuwOvuvdAZUOJaa
+ $ XojlsTOSR.vkesForanLiufjeDI
+ $ XojlsTOSR.vkesForanLiufjeDI
+ $ XojlsTOSR.popjAyijoWarueeP
+ $ XojlsTOSR.jpwuPmafuDqlbkt nlyo
+ $ XojlsTOSR.jpwuPmafuDqlbkt xxneswWhxwng
+ $ XojlsTOSR.jpwuPmafuDqlbkt oloCuxeDdow
+ $ XojlsTOSR.jpwuPmafuDqlbkt (uwurrvoNnukzefuDjeh lwojjoBiecao nlyo)
+ $ etOslnoz lwojjoBiecao
+ in kucotg $ (bbbr, Yoxe.Dwzbuzi.zrLokoTnuy piv)
diff --git a/data/Test346.hs b/data/Test346.hs
new file mode 100644
index 0000000..83ba0bc
--- /dev/null
+++ b/data/Test346.hs
@@ -0,0 +1,2 @@
+-- test
+module MyModule where
diff --git a/data/Test347.hs b/data/Test347.hs
new file mode 100644
index 0000000..d01c656
--- /dev/null
+++ b/data/Test347.hs
@@ -0,0 +1,8 @@
+foo =
+ [ ("xxx", "xx")
+ , --
+ ("xx" , "xx")
+ --
+ , ("xx" , "xxxxx")
+ , ("xx" , "xx")
+ ]
diff --git a/data/Test348.hs b/data/Test348.hs
new file mode 100644
index 0000000..d0b4eb5
--- /dev/null
+++ b/data/Test348.hs
@@ -0,0 +1,8 @@
+foo =
+ [ ("xx", "xx")
+ , ( "xx" --
+ , "xx"
+ )
+ , ("xx", "xxxxx")
+ , ("xx", "xx")
+ ]
diff --git a/data/Test349.hs b/data/Test349.hs
new file mode 100644
index 0000000..0d374de
--- /dev/null
+++ b/data/Test349.hs
@@ -0,0 +1,6 @@
+module Main
+ ( DataTypeI
+ , DataTypeII(DataConstructor)
+ -- * Haddock heading
+ , name
+ ) where
diff --git a/data/Test35.hs b/data/Test35.hs
new file mode 100644
index 0000000..7e217d5
--- /dev/null
+++ b/data/Test35.hs
@@ -0,0 +1,2 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+func :: forall (a :: *) b . a -> b
diff --git a/data/Test350.hs b/data/Test350.hs
new file mode 100644
index 0000000..0f5b4e9
--- /dev/null
+++ b/data/Test350.hs
@@ -0,0 +1,23 @@
+xeoeqibIaib
+ :: ( KqujhIsaus m
+ , XivuvIpoboi Droqifim m
+ , IgorvOtowtf m
+ , RyagaYaqac m
+ , QouruDU m
+ )
+ => MaptAdfuxgu
+ -> Zcnxg NsxayqmvIjsezea -- ^ if Lvqucoo, opsip jl reyoyhk lfil qaculxgd
+ -> QNOZqwuzg
+ -> Eoattuq
+ '[ XkatytdWdquraosu -- test comment
+ , KyezKijim -- another test comment
+ , DjmioeePuoeg
+ , NinrxoiOwezc
+ , QATAlrijacpk
+ , TrutvotwIwifiqOjdtu
+ , CoMmuatjwr
+ , BoZckzqyodseZole
+ , VagfwoXaeChfqe
+ ]
+ m
+ ()
diff --git a/data/Test351.hs b/data/Test351.hs
new file mode 100644
index 0000000..fe25514
--- /dev/null
+++ b/data/Test351.hs
@@ -0,0 +1,7 @@
+createRedirectedProcess processConfig = do
+ let redirectedProc = (_processConfig_inner processConfig)
+ { std_in = CreatePipe
+ , std_out = CreatePipe
+ , std_err = CreatePipe
+ }
+ foo
diff --git a/data/Test352.hs b/data/Test352.hs
new file mode 100644
index 0000000..3e5d558
--- /dev/null
+++ b/data/Test352.hs
@@ -0,0 +1,5 @@
+instance HasDependencies SomeDataModel where
+ -- N.B. Here is a bunch of explanatory context about the relationship
+ -- between these data models or whatever.
+ type Dependencies SomeDataModel
+ = (SomeOtherDataModelId, SomeOtherOtherDataModelId)
diff --git a/data/Test353.hs b/data/Test353.hs
new file mode 100644
index 0000000..cedb99d
--- /dev/null
+++ b/data/Test353.hs
@@ -0,0 +1,4 @@
+func =
+ do
+ y
+ >>= x
diff --git a/data/Test354.hs b/data/Test354.hs
new file mode 100644
index 0000000..e082c6d
--- /dev/null
+++ b/data/Test354.hs
@@ -0,0 +1,4 @@
+-- brittany { lconfig_indentAmount: 4, lconfig_indentPolicy: IndentPolicyMultiple }
+func =
+ mweroiuxlskdfjlksjdflkjsdfljksldkjflkjsdflkj
+ + mweroiuxlskdfjlksjdflkjsdfljksldkjflkjsdflkj
diff --git a/data/Test355.hs b/data/Test355.hs
new file mode 100644
index 0000000..56cf385
--- /dev/null
+++ b/data/Test355.hs
@@ -0,0 +1,5 @@
+-- brittany { lconfig_indentAmount: 4, lconfig_indentPolicy: IndentPolicyMultiple }
+foo = do
+ let aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa =
+ aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa + aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
+ foo
diff --git a/data/Test356.hs b/data/Test356.hs
new file mode 100644
index 0000000..94a19a4
--- /dev/null
+++ b/data/Test356.hs
@@ -0,0 +1,11 @@
+-- brittany { lconfig_indentAmount: 8, lconfig_indentPolicy: IndentPolicyMultiple }
+foo = do
+ let aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa =
+ aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa + aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
+ foo
+foo = do
+ let aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa =
+ aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
+ + aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
+ + aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
+ foo
diff --git a/data/Test357.hs b/data/Test357.hs
new file mode 100644
index 0000000..9fd454a
--- /dev/null
+++ b/data/Test357.hs
@@ -0,0 +1,7 @@
+-- brittany { lconfig_indentAmount: 4, lconfig_indentPolicy: IndentPolicyMultiple }
+foo = asdyf8asdf
+ "ajsdfas"
+ [ asjdf asyhf $ do
+ aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
+ aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
+ ]
diff --git a/data/Test358.hs b/data/Test358.hs
new file mode 100644
index 0000000..7a121e7
--- /dev/null
+++ b/data/Test358.hs
@@ -0,0 +1,2 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+func :: a -> a
diff --git a/data/Test359.hs b/data/Test359.hs
new file mode 100644
index 0000000..6991c53
--- /dev/null
+++ b/data/Test359.hs
@@ -0,0 +1,4 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+func
+ :: lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
+ -> lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
diff --git a/data/Test36.hs b/data/Test36.hs
new file mode 100644
index 0000000..7fc70e4
--- /dev/null
+++ b/data/Test36.hs
@@ -0,0 +1 @@
+func :: a -> b -- comment
diff --git a/data/Test360.hs b/data/Test360.hs
new file mode 100644
index 0000000..b7c0128
--- /dev/null
+++ b/data/Test360.hs
@@ -0,0 +1,5 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+func
+ :: lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
+ -> lakjsdlkjasldkj
+ -> lakjsdlkjasldkj
diff --git a/data/Test361.hs b/data/Test361.hs
new file mode 100644
index 0000000..ffd3ff9
--- /dev/null
+++ b/data/Test361.hs
@@ -0,0 +1,2 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+func :: ((a))
diff --git a/data/Test362.hs b/data/Test362.hs
new file mode 100644
index 0000000..df79511
--- /dev/null
+++ b/data/Test362.hs
@@ -0,0 +1,2 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+func :: (a -> a) -> a
diff --git a/data/Test363.hs b/data/Test363.hs
new file mode 100644
index 0000000..921d92d
--- /dev/null
+++ b/data/Test363.hs
@@ -0,0 +1,2 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+func :: a -> (a -> a)
diff --git a/data/Test364.hs b/data/Test364.hs
new file mode 100644
index 0000000..ed845fb
--- /dev/null
+++ b/data/Test364.hs
@@ -0,0 +1,3 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+func :: (((((((((())))))))))
+-- current output is.. funny. wonder if that can/needs to be improved..
diff --git a/data/Test365.hs b/data/Test365.hs
new file mode 100644
index 0000000..bf8f673
--- /dev/null
+++ b/data/Test365.hs
@@ -0,0 +1,2 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+func :: ()
diff --git a/data/Test366.hs b/data/Test366.hs
new file mode 100644
index 0000000..a478841
--- /dev/null
+++ b/data/Test366.hs
@@ -0,0 +1,6 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+func
+ :: ( lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
+ -> lakjsdlkjasldkj
+ -> lakjsdlkjasldkj
+ )
diff --git a/data/Test367.hs b/data/Test367.hs
new file mode 100644
index 0000000..165c111
--- /dev/null
+++ b/data/Test367.hs
@@ -0,0 +1,4 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+func
+ :: lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
+ -> (lakjsdlkjasldkj -> lakjsdlkjasldkj)
diff --git a/data/Test368.hs b/data/Test368.hs
new file mode 100644
index 0000000..4a1e980
--- /dev/null
+++ b/data/Test368.hs
@@ -0,0 +1,4 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+func
+ :: (lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd -> lakjsdlkjasldkj)
+ -> lakjsdlkjasldkj
diff --git a/data/Test369.hs b/data/Test369.hs
new file mode 100644
index 0000000..ed4d90c
--- /dev/null
+++ b/data/Test369.hs
@@ -0,0 +1,6 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+func
+ :: ( lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
+ -> lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
+ )
+ -> lakjsdlkjasldkj
diff --git a/data/Test37.hs b/data/Test37.hs
new file mode 100644
index 0000000..70aa3c6
--- /dev/null
+++ b/data/Test37.hs
@@ -0,0 +1,2 @@
+funcA :: a -> b -- comment A
+funcB :: a -> b -- comment B
diff --git a/data/Test370.hs b/data/Test370.hs
new file mode 100644
index 0000000..4621ea3
--- /dev/null
+++ b/data/Test370.hs
@@ -0,0 +1,6 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+func
+ :: ( ( lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
+ -> lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
+ )
+ )
diff --git a/data/Test371.hs b/data/Test371.hs
new file mode 100644
index 0000000..0ec2ac4
--- /dev/null
+++ b/data/Test371.hs
@@ -0,0 +1,2 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+func :: asd -> Either a b
diff --git a/data/Test372.hs b/data/Test372.hs
new file mode 100644
index 0000000..2adc98c
--- /dev/null
+++ b/data/Test372.hs
@@ -0,0 +1,6 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+func
+ :: asd
+ -> Either
+ lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
+ lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
diff --git a/data/Test373.hs b/data/Test373.hs
new file mode 100644
index 0000000..faee723
--- /dev/null
+++ b/data/Test373.hs
@@ -0,0 +1,7 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+func
+ :: asd
+ -> Trither
+ lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
+ lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
+ lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
diff --git a/data/Test374.hs b/data/Test374.hs
new file mode 100644
index 0000000..be2766e
--- /dev/null
+++ b/data/Test374.hs
@@ -0,0 +1,7 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+func
+ :: Trither
+ lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
+ lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
+ lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
+ -> asd
diff --git a/data/Test375.hs b/data/Test375.hs
new file mode 100644
index 0000000..6efe43f
--- /dev/null
+++ b/data/Test375.hs
@@ -0,0 +1,6 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+func
+ :: Trither
+ lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
+ lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
+ (lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd -> asd)
diff --git a/data/Test376.hs b/data/Test376.hs
new file mode 100644
index 0000000..8d7a7ae
--- /dev/null
+++ b/data/Test376.hs
@@ -0,0 +1,8 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+func
+ :: Trither
+ asd
+ lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
+ ( lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
+ -> lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
+ )
diff --git a/data/Test377.hs b/data/Test377.hs
new file mode 100644
index 0000000..16d6ee7
--- /dev/null
+++ b/data/Test377.hs
@@ -0,0 +1,8 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+func
+ :: asd
+ -> ( Trither
+ lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
+ lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
+ lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
+ )
diff --git a/data/Test378.hs b/data/Test378.hs
new file mode 100644
index 0000000..b7a24ca
--- /dev/null
+++ b/data/Test378.hs
@@ -0,0 +1,8 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+func
+ :: asd
+ -> ( Trither
+ lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
+ lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
+ )
+ lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
diff --git a/data/Test379.hs b/data/Test379.hs
new file mode 100644
index 0000000..50f95b2
--- /dev/null
+++ b/data/Test379.hs
@@ -0,0 +1,8 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+func
+ :: ( Trither
+ lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
+ lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
+ )
+ lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
+ -> asd
diff --git a/data/Test38.hs b/data/Test38.hs
new file mode 100644
index 0000000..6978eb6
--- /dev/null
+++ b/data/Test38.hs
@@ -0,0 +1,11 @@
+-- a
+func -- b
+ :: -- c
+ a -- d
+ -> -- e
+ ( -- f
+ c -- g
+ , -- h
+ d -- i
+ ) -- j
+-- k
diff --git a/data/Test380.hs b/data/Test380.hs
new file mode 100644
index 0000000..4453786
--- /dev/null
+++ b/data/Test380.hs
@@ -0,0 +1,2 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+func :: [a -> b]
diff --git a/data/Test381.hs b/data/Test381.hs
new file mode 100644
index 0000000..faf63f1
--- /dev/null
+++ b/data/Test381.hs
@@ -0,0 +1,5 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+func
+ :: [ lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
+ -> lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
+ ]
diff --git a/data/Test382.hs b/data/Test382.hs
new file mode 100644
index 0000000..fbcaa1c
--- /dev/null
+++ b/data/Test382.hs
@@ -0,0 +1,6 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+func
+ :: [ ( lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
+ -> lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
+ )
+ ]
diff --git a/data/Test383.hs b/data/Test383.hs
new file mode 100644
index 0000000..edfefd8
--- /dev/null
+++ b/data/Test383.hs
@@ -0,0 +1,2 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+func :: (a, b, c)
diff --git a/data/Test384.hs b/data/Test384.hs
new file mode 100644
index 0000000..cb8e4cd
--- /dev/null
+++ b/data/Test384.hs
@@ -0,0 +1,2 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+func :: ((a, b, c), (a, b, c), (a, b, c))
diff --git a/data/Test385.hs b/data/Test385.hs
new file mode 100644
index 0000000..8177c7f
--- /dev/null
+++ b/data/Test385.hs
@@ -0,0 +1,6 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+func
+ :: ( lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
+ , lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
+ , lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
+ )
diff --git a/data/Test386.hs b/data/Test386.hs
new file mode 100644
index 0000000..e3efa79
--- /dev/null
+++ b/data/Test386.hs
@@ -0,0 +1,7 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+func
+ :: ( ( lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
+ , (lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd)
+ , lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
+ )
+ )
diff --git a/data/Test387.hs b/data/Test387.hs
new file mode 100644
index 0000000..3a64ee9
--- /dev/null
+++ b/data/Test387.hs
@@ -0,0 +1,7 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+func
+ :: [ ( lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
+ , lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
+ , lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
+ )
+ ]
diff --git a/data/Test388.hs b/data/Test388.hs
new file mode 100644
index 0000000..15b0b06
--- /dev/null
+++ b/data/Test388.hs
@@ -0,0 +1,3 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+{-# LANGUAGE ScopedTypeVariables #-}
+func :: forall (a :: *) b . a -> b
diff --git a/data/Test389.hs b/data/Test389.hs
new file mode 100644
index 0000000..5acb0b6
--- /dev/null
+++ b/data/Test389.hs
@@ -0,0 +1,11 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+{-# LANGUAGE ScopedTypeVariables #-}
+func
+ :: forall m
+ . Foo
+ => ColMap2
+ -> ColInfo
+ -> ColInfo
+ -> ColInfo
+ -> ColInfo
+ -> m ()
diff --git a/data/Test39.hs b/data/Test39.hs
new file mode 100644
index 0000000..9c9b324
--- /dev/null
+++ b/data/Test39.hs
@@ -0,0 +1,4 @@
+func = f
+ where
+ {-# INLINE f #-}
+ f = id
diff --git a/data/Test390.hs b/data/Test390.hs
new file mode 100644
index 0000000..72f2d0a
--- /dev/null
+++ b/data/Test390.hs
@@ -0,0 +1,11 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+{-# LANGUAGE ScopedTypeVariables #-}
+func
+ :: forall m
+ . ColMap2
+ -> ColInfo
+ -> ColInfo
+ -> ColInfo
+ -> ColInfo
+ -> ColInfo
+ -> m ()
diff --git a/data/Test391.hs b/data/Test391.hs
new file mode 100644
index 0000000..15b0b06
--- /dev/null
+++ b/data/Test391.hs
@@ -0,0 +1,3 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+{-# LANGUAGE ScopedTypeVariables #-}
+func :: forall (a :: *) b . a -> b
diff --git a/data/Test392.hs b/data/Test392.hs
new file mode 100644
index 0000000..de8ad75
--- /dev/null
+++ b/data/Test392.hs
@@ -0,0 +1,2 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+func :: a -> b -- comment
diff --git a/data/Test393.hs b/data/Test393.hs
new file mode 100644
index 0000000..1a15a53
--- /dev/null
+++ b/data/Test393.hs
@@ -0,0 +1,3 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+funcA :: a -> b -- comment A
+funcB :: a -> b -- comment B
diff --git a/data/Test394.hs b/data/Test394.hs
new file mode 100644
index 0000000..44eb854
--- /dev/null
+++ b/data/Test394.hs
@@ -0,0 +1,11 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+-- a
+func -- b
+ :: -- c
+ a -- d
+ -> -- e
+ ( -- f
+ c -- g
+ , -- h
+ d -- i
+ ) -- j-- k
diff --git a/data/Test395.hs b/data/Test395.hs
new file mode 100644
index 0000000..729290d
--- /dev/null
+++ b/data/Test395.hs
@@ -0,0 +1,3 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+{-# LANGUAGE ImplicitParams #-}
+func :: (?asd::Int) -> ()
diff --git a/data/Test396.hs b/data/Test396.hs
new file mode 100644
index 0000000..f706d17
--- /dev/null
+++ b/data/Test396.hs
@@ -0,0 +1,8 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+{-# LANGUAGE ImplicitParams #-}
+func
+ :: ( ?asd
+ :: lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
+ -> lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
+ )
+ -> ()
diff --git a/data/Test397.hs b/data/Test397.hs
new file mode 100644
index 0000000..750f3f9
--- /dev/null
+++ b/data/Test397.hs
@@ -0,0 +1,5 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+func = f
+ where
+ {-# INLINE f #-}
+ f = id
diff --git a/data/Test398.hs b/data/Test398.hs
new file mode 100644
index 0000000..8770767
--- /dev/null
+++ b/data/Test398.hs
@@ -0,0 +1,5 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+func = ($)
+ where
+ {-# INLINE ($) #-}
+ ($) = id
diff --git a/data/Test399.hs b/data/Test399.hs
new file mode 100644
index 0000000..996e831
--- /dev/null
+++ b/data/Test399.hs
@@ -0,0 +1,5 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+func = f
+ where
+ {-# INLINE CONLIKE [1] f #-}
+ f = id
diff --git a/data/Test4.hs b/data/Test4.hs
new file mode 100644
index 0000000..e517aa0
--- /dev/null
+++ b/data/Test4.hs
@@ -0,0 +1 @@
+func :: ((a))
diff --git a/data/Test40.hs b/data/Test40.hs
new file mode 100644
index 0000000..c182430
--- /dev/null
+++ b/data/Test40.hs
@@ -0,0 +1,4 @@
+func = ($)
+ where
+ {-# INLINE ($) #-}
+ ($) = id
diff --git a/data/Test400.hs b/data/Test400.hs
new file mode 100644
index 0000000..8b00a95
--- /dev/null
+++ b/data/Test400.hs
@@ -0,0 +1,5 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+func = f
+ where
+ {-# INLINE [~1] f #-}
+ f = id
diff --git a/data/Test401.hs b/data/Test401.hs
new file mode 100644
index 0000000..7d334ba
--- /dev/null
+++ b/data/Test401.hs
@@ -0,0 +1,4 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+data Foo = Bar
+ { foo :: Baz
+ }
diff --git a/data/Test402.hs b/data/Test402.hs
new file mode 100644
index 0000000..f94f463
--- /dev/null
+++ b/data/Test402.hs
@@ -0,0 +1,4 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+data Foo = Bar
+ { foo, bar :: Baz
+ }
diff --git a/data/Test403.hs b/data/Test403.hs
new file mode 100644
index 0000000..3b2e688
--- /dev/null
+++ b/data/Test403.hs
@@ -0,0 +1,5 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+data Foo = Bar
+ { foo :: Baz
+ , bar :: Bizzz
+ }
diff --git a/data/Test404.hs b/data/Test404.hs
new file mode 100644
index 0000000..9144cc0
--- /dev/null
+++ b/data/Test404.hs
@@ -0,0 +1,5 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+data Foo = Bar
+ { foo, biz :: Baz
+ , bar :: Bizzz
+ }
diff --git a/data/Test405.hs b/data/Test405.hs
new file mode 100644
index 0000000..7d20e0d
--- /dev/null
+++ b/data/Test405.hs
@@ -0,0 +1,6 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+data Foo = Bar
+ { foo :: Baz
+ , bar :: Bizzz
+ }
+ deriving Show
diff --git a/data/Test406.hs b/data/Test406.hs
new file mode 100644
index 0000000..cfe7ae2
--- /dev/null
+++ b/data/Test406.hs
@@ -0,0 +1,6 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+data Foo = Bar
+ { foo :: Baz
+ , bar :: Bizzz
+ }
+ deriving (Show, Eq, Monad, Functor, Traversable, Foldable)
diff --git a/data/Test407.hs b/data/Test407.hs
new file mode 100644
index 0000000..b889d43
--- /dev/null
+++ b/data/Test407.hs
@@ -0,0 +1,2 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+func x = x
diff --git a/data/Test408.hs b/data/Test408.hs
new file mode 100644
index 0000000..2764fb5
--- /dev/null
+++ b/data/Test408.hs
@@ -0,0 +1,2 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+x *** y = x
diff --git a/data/Test409.hs b/data/Test409.hs
new file mode 100644
index 0000000..a9a0917
--- /dev/null
+++ b/data/Test409.hs
@@ -0,0 +1,2 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+(***) x y = x
diff --git a/data/Test41.hs b/data/Test41.hs
new file mode 100644
index 0000000..205a728
--- /dev/null
+++ b/data/Test41.hs
@@ -0,0 +1,4 @@
+func = f
+ where
+ {-# INLINE CONLIKE [1] f #-}
+ f = id
diff --git a/data/Test410.hs b/data/Test410.hs
new file mode 100644
index 0000000..155d06d
--- /dev/null
+++ b/data/Test410.hs
@@ -0,0 +1,2 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+func _ = x
diff --git a/data/Test411.hs b/data/Test411.hs
new file mode 100644
index 0000000..73dc40a
--- /dev/null
+++ b/data/Test411.hs
@@ -0,0 +1,3 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+func reallyreallyreallyreallyreallyreallyreallyreallyreallyreallylongvariable =
+ x
diff --git a/data/Test412.hs b/data/Test412.hs
new file mode 100644
index 0000000..92a61f3
--- /dev/null
+++ b/data/Test412.hs
@@ -0,0 +1,3 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+func reallyreallyreallyreallyreallyreallyreallyreallyreallyreallylongvariable reallyreallyreallyreallyreallyreallyreallyreallyreallyreallylongvariable
+ = x
diff --git a/data/Test413.hs b/data/Test413.hs
new file mode 100644
index 0000000..a5f08d9
--- /dev/null
+++ b/data/Test413.hs
@@ -0,0 +1,3 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+func reallyreallyreallyreallyreallyreallyreallyreallyreallyreallylongvariable a b
+ = x
diff --git a/data/Test414.hs b/data/Test414.hs
new file mode 100644
index 0000000..c0690eb
--- /dev/null
+++ b/data/Test414.hs
@@ -0,0 +1,2 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+func (A a) = a
diff --git a/data/Test415.hs b/data/Test415.hs
new file mode 100644
index 0000000..fb95ff8
--- /dev/null
+++ b/data/Test415.hs
@@ -0,0 +1,2 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+func (x : xr) = x
diff --git a/data/Test416.hs b/data/Test416.hs
new file mode 100644
index 0000000..490720c
--- /dev/null
+++ b/data/Test416.hs
@@ -0,0 +1,2 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+func (x :+: xr) = x
diff --git a/data/Test417.hs b/data/Test417.hs
new file mode 100644
index 0000000..8ee6b8b
--- /dev/null
+++ b/data/Test417.hs
@@ -0,0 +1,2 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+func | True = x
diff --git a/data/Test418.hs b/data/Test418.hs
new file mode 100644
index 0000000..506b4d1
--- /dev/null
+++ b/data/Test418.hs
@@ -0,0 +1,4 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+func x
+ | x = simple expression
+ | otherwise = 0
diff --git a/data/Test419.hs b/data/Test419.hs
new file mode 100644
index 0000000..ee128f1
--- /dev/null
+++ b/data/Test419.hs
@@ -0,0 +1,4 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+func x
+ | a somewhat longer guard x = "and a somewhat longer expession that does not"
+ | otherwise = "fit without putting the guards in new lines"
diff --git a/data/Test42.hs b/data/Test42.hs
new file mode 100644
index 0000000..cfd38bb
--- /dev/null
+++ b/data/Test42.hs
@@ -0,0 +1,2 @@
+{-# NOINLINE func #-}
+func :: Int
diff --git a/data/Test420.hs b/data/Test420.hs
new file mode 100644
index 0000000..a8f1881
--- /dev/null
+++ b/data/Test420.hs
@@ -0,0 +1,8 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+func x
+ | very long guard, another rather long guard that refers to x = nontrivial
+ expression
+ foo
+ bar
+ alsdkjlasdjlasj
+ | otherwise = 0
diff --git a/data/Test421.hs b/data/Test421.hs
new file mode 100644
index 0000000..5dd669d
--- /dev/null
+++ b/data/Test421.hs
@@ -0,0 +1,6 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+func x
+ | very long guard, another rather long guard that refers to x
+ = nontrivialexpression foo bar alsdkjlasdjlasj
+ | otherwise
+ = 0
diff --git a/data/Test422.hs b/data/Test422.hs
new file mode 100644
index 0000000..830e3ee
--- /dev/null
+++ b/data/Test422.hs
@@ -0,0 +1,7 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+func x
+ | very loooooooooooooooooooooooooooooong guard
+ , another rather long guard that refers to x
+ = nontrivial expression foo bar alsdkjlasdjlasj
+ | otherwise
+ = 0
diff --git a/data/Test423.hs b/data/Test423.hs
new file mode 100644
index 0000000..88d75b3
--- /dev/null
+++ b/data/Test423.hs
@@ -0,0 +1,3 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+func = x
+describe "infix op" $ do
diff --git a/data/Test424.hs b/data/Test424.hs
new file mode 100644
index 0000000..1258fc6
--- /dev/null
+++ b/data/Test424.hs
@@ -0,0 +1,2 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+func = x + x
diff --git a/data/Test425.hs b/data/Test425.hs
new file mode 100644
index 0000000..1ed0c86
--- /dev/null
+++ b/data/Test425.hs
@@ -0,0 +1,4 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+func =
+ mweroiuxlskdfjlksjdflkjsdfljksldkjflkjsdflkj
+ + mweroiuxlskdfjlksjdflkjsdfljksldkjflkjsdflkj
diff --git a/data/Test426.hs b/data/Test426.hs
new file mode 100644
index 0000000..e70a294
--- /dev/null
+++ b/data/Test426.hs
@@ -0,0 +1,5 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+func =
+ mweroiuxlskdfjlksjdflkjsdfljksldkjflkjsdflkj
+ + mweroiuxlskdfjlksj
+ + mweroiuxlskdfjlksj
diff --git a/data/Test427.hs b/data/Test427.hs
new file mode 100644
index 0000000..38b5fd2
--- /dev/null
+++ b/data/Test427.hs
@@ -0,0 +1,5 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+func =
+ mweroiuxlskdfjlksj
+ + mweroiuxlskdfjlksj
+ + mweroiuxlskdfjlksjdflkjsdfljksldkjflkjsdflkj
diff --git a/data/Test428.hs b/data/Test428.hs
new file mode 100644
index 0000000..ab8bc90
--- /dev/null
+++ b/data/Test428.hs
@@ -0,0 +1,6 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+func = 1
+func = "abc"
+func = 1.1e5
+func = 'x'
+func = 981409823458910394810928414192837123987123987123
diff --git a/data/Test429.hs b/data/Test429.hs
new file mode 100644
index 0000000..6fcf5ea
--- /dev/null
+++ b/data/Test429.hs
@@ -0,0 +1,5 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+{-# LANGUAGE LambdaCase #-}
+func = \case
+ FooBar -> x
+ Baz -> y
diff --git a/data/Test43.hs b/data/Test43.hs
new file mode 100644
index 0000000..83572d8
--- /dev/null
+++ b/data/Test43.hs
@@ -0,0 +1,4 @@
+func = f
+ where
+ {-# INLINE [~1] f #-}
+ f = id
diff --git a/data/Test430.hs b/data/Test430.hs
new file mode 100644
index 0000000..3efc267
--- /dev/null
+++ b/data/Test430.hs
@@ -0,0 +1,3 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+func = \x -> abc
+describe "app" $ do
diff --git a/data/Test431.hs b/data/Test431.hs
new file mode 100644
index 0000000..c1c1c58
--- /dev/null
+++ b/data/Test431.hs
@@ -0,0 +1,2 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+func = klajsdas klajsdas klajsdas
diff --git a/data/Test432.hs b/data/Test432.hs
new file mode 100644
index 0000000..aa2b380
--- /dev/null
+++ b/data/Test432.hs
@@ -0,0 +1,4 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+func = lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd
+ lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd
+ lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd
diff --git a/data/Test433.hs b/data/Test433.hs
new file mode 100644
index 0000000..851e5cb
--- /dev/null
+++ b/data/Test433.hs
@@ -0,0 +1,5 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+func = lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd
+ lakjsdlajsdljas
+ lakjsdlajsdljas
+ lakjsdlajsdljas
diff --git a/data/Test434.hs b/data/Test434.hs
new file mode 100644
index 0000000..f52edc1
--- /dev/null
+++ b/data/Test434.hs
@@ -0,0 +1,2 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+func = (1 +)
diff --git a/data/Test435.hs b/data/Test435.hs
new file mode 100644
index 0000000..09d341e
--- /dev/null
+++ b/data/Test435.hs
@@ -0,0 +1,2 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+func = (+ 1)
diff --git a/data/Test436.hs b/data/Test436.hs
new file mode 100644
index 0000000..25a7bda
--- /dev/null
+++ b/data/Test436.hs
@@ -0,0 +1,2 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+func = (1 `abc`)
diff --git a/data/Test437.hs b/data/Test437.hs
new file mode 100644
index 0000000..3c56cf8
--- /dev/null
+++ b/data/Test437.hs
@@ -0,0 +1,2 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+func = (`abc` 1)
diff --git a/data/Test438.hs b/data/Test438.hs
new file mode 100644
index 0000000..a9c30d5
--- /dev/null
+++ b/data/Test438.hs
@@ -0,0 +1,2 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+func = (abc, def)
diff --git a/data/Test439.hs b/data/Test439.hs
new file mode 100644
index 0000000..90cb29d
--- /dev/null
+++ b/data/Test439.hs
@@ -0,0 +1,5 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+func =
+ ( lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd
+ , lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd
+ )
diff --git a/data/Test44.hs b/data/Test44.hs
new file mode 100644
index 0000000..7dd43f0
--- /dev/null
+++ b/data/Test44.hs
@@ -0,0 +1,2 @@
+data Foo = Bar {}
+data Biz = Baz
diff --git a/data/Test440.hs b/data/Test440.hs
new file mode 100644
index 0000000..0d46933
--- /dev/null
+++ b/data/Test440.hs
@@ -0,0 +1,4 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+foo =
+ let longIdentifierForShortValue = 1
+ in longIdentifierForShortValue + longIdentifierForShortValue
diff --git a/data/Test441.hs b/data/Test441.hs
new file mode 100644
index 0000000..6a77a85
--- /dev/null
+++ b/data/Test441.hs
@@ -0,0 +1,4 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+func = do
+ stmt
+ stmt
diff --git a/data/Test442.hs b/data/Test442.hs
new file mode 100644
index 0000000..3ab95e7
--- /dev/null
+++ b/data/Test442.hs
@@ -0,0 +1,4 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+func = do
+ x <- stmt
+ stmt x
diff --git a/data/Test443.hs b/data/Test443.hs
new file mode 100644
index 0000000..c832f21
--- /dev/null
+++ b/data/Test443.hs
@@ -0,0 +1,4 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+func = do
+ let x = 13
+ stmt x
diff --git a/data/Test444.hs b/data/Test444.hs
new file mode 100644
index 0000000..31b1cc7
--- /dev/null
+++ b/data/Test444.hs
@@ -0,0 +1,8 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+func =
+ foooooo
+ $ [ case
+ foooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo
+ of
+ _ -> True
+ ]
diff --git a/data/Test445.hs b/data/Test445.hs
new file mode 100644
index 0000000..c3f325f
--- /dev/null
+++ b/data/Test445.hs
@@ -0,0 +1,5 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+{-# LANGUAGE MultiWayIf #-}
+func = if
+ | cond1 -> loooooooooooooooooooooooooooooong expr1
+ | cond2 -> loooooooooooooooooooooooooooooong expr2
diff --git a/data/Test446.hs b/data/Test446.hs
new file mode 100644
index 0000000..4d8efd2
--- /dev/null
+++ b/data/Test446.hs
@@ -0,0 +1,7 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+{-# LANGUAGE MultiWayIf #-}
+func = do
+ foo
+ bar $ if
+ | cond1 -> loooooooooooooooooooooooooooooong expr1
+ | cond2 -> loooooooooooooooooooooooooooooong expr2
diff --git a/data/Test447.hs b/data/Test447.hs
new file mode 100644
index 0000000..6e718f0
--- /dev/null
+++ b/data/Test447.hs
@@ -0,0 +1,7 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+func =
+ foo
+ $ [ aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
+ , bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb
+ ]
+ ++ [ccccccccccccccccccccccccccccccccccccccccccccccccccccccccc]
diff --git a/data/Test448.hs b/data/Test448.hs
new file mode 100644
index 0000000..3884989
--- /dev/null
+++ b/data/Test448.hs
@@ -0,0 +1,2 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+module Main where
diff --git a/data/Test449.hs b/data/Test449.hs
new file mode 100644
index 0000000..7a6295f
--- /dev/null
+++ b/data/Test449.hs
@@ -0,0 +1,2 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+module Main () where
diff --git a/data/Test45.hs b/data/Test45.hs
new file mode 100644
index 0000000..d1c8c85
--- /dev/null
+++ b/data/Test45.hs
@@ -0,0 +1,3 @@
+data Foo = Bar
+ { foo :: Baz
+ }
diff --git a/data/Test450.hs b/data/Test450.hs
new file mode 100644
index 0000000..89316b0
--- /dev/null
+++ b/data/Test450.hs
@@ -0,0 +1,2 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+module Main (main) where
diff --git a/data/Test451.hs b/data/Test451.hs
new file mode 100644
index 0000000..a55d851
--- /dev/null
+++ b/data/Test451.hs
@@ -0,0 +1,2 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+module Main (main, test1, test2) where
diff --git a/data/Test452.hs b/data/Test452.hs
new file mode 100644
index 0000000..4fe8cbf
--- /dev/null
+++ b/data/Test452.hs
@@ -0,0 +1,13 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+module Main
+ ( main
+ , test1
+ , test2
+ , test3
+ , test4
+ , test5
+ , test6
+ , test7
+ , test8
+ , test9
+ ) where
diff --git a/data/Test453.hs b/data/Test453.hs
new file mode 100644
index 0000000..eaeb665
--- /dev/null
+++ b/data/Test453.hs
@@ -0,0 +1,13 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+module Main
+ ( main
+ -- main
+ , test1
+ , test2
+ -- Test 3
+ , test3
+ , test4
+ -- Test 5
+ , test5
+ -- Test 6
+ ) where
diff --git a/data/Test454.hs b/data/Test454.hs
new file mode 100644
index 0000000..c2e7a8e
--- /dev/null
+++ b/data/Test454.hs
@@ -0,0 +1,2 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+module Main (Test(..)) where
diff --git a/data/Test455.hs b/data/Test455.hs
new file mode 100644
index 0000000..6191afd
--- /dev/null
+++ b/data/Test455.hs
@@ -0,0 +1,2 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+module Main (module Main) where
diff --git a/data/Test456.hs b/data/Test456.hs
new file mode 100644
index 0000000..3d9694b
--- /dev/null
+++ b/data/Test456.hs
@@ -0,0 +1,2 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+module Main (Test(Test, a, b)) where
diff --git a/data/Test457.hs b/data/Test457.hs
new file mode 100644
index 0000000..82a8e14
--- /dev/null
+++ b/data/Test457.hs
@@ -0,0 +1,2 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+module Main (Test()) where
diff --git a/data/Test458.hs b/data/Test458.hs
new file mode 100644
index 0000000..df50e76
--- /dev/null
+++ b/data/Test458.hs
@@ -0,0 +1,2 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+-- Intentionally left empty
diff --git a/data/Test459.hs b/data/Test459.hs
new file mode 100644
index 0000000..0dea4be
--- /dev/null
+++ b/data/Test459.hs
@@ -0,0 +1,2 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+import Data.List
diff --git a/data/Test46.hs b/data/Test46.hs
new file mode 100644
index 0000000..2472782
--- /dev/null
+++ b/data/Test46.hs
@@ -0,0 +1,3 @@
+data Foo = Bar
+ { foo, bar :: Baz
+ }
diff --git a/data/Test460.hs b/data/Test460.hs
new file mode 100644
index 0000000..50b8621
--- /dev/null
+++ b/data/Test460.hs
@@ -0,0 +1,2 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+import Data.List as L
diff --git a/data/Test461.hs b/data/Test461.hs
new file mode 100644
index 0000000..835646b
--- /dev/null
+++ b/data/Test461.hs
@@ -0,0 +1,2 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+import qualified Data.List
diff --git a/data/Test462.hs b/data/Test462.hs
new file mode 100644
index 0000000..7e772a5
--- /dev/null
+++ b/data/Test462.hs
@@ -0,0 +1,2 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+import qualified Data.List as L
diff --git a/data/Test463.hs b/data/Test463.hs
new file mode 100644
index 0000000..1bfa264
--- /dev/null
+++ b/data/Test463.hs
@@ -0,0 +1,2 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+import safe Data.List as L
diff --git a/data/Test464.hs b/data/Test464.hs
new file mode 100644
index 0000000..53fad4c
--- /dev/null
+++ b/data/Test464.hs
@@ -0,0 +1,2 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+import {-# SOURCE #-} Data.List ()
diff --git a/data/Test465.hs b/data/Test465.hs
new file mode 100644
index 0000000..8e5b381
--- /dev/null
+++ b/data/Test465.hs
@@ -0,0 +1,2 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+import safe qualified Data.List hiding (nub)
diff --git a/data/Test466.hs b/data/Test466.hs
new file mode 100644
index 0000000..73046d6
--- /dev/null
+++ b/data/Test466.hs
@@ -0,0 +1,2 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+import {-# SOURCE #-} safe qualified Data.List
diff --git a/data/Test467.hs b/data/Test467.hs
new file mode 100644
index 0000000..7745833
--- /dev/null
+++ b/data/Test467.hs
@@ -0,0 +1,2 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+import qualified "base" Data.List
diff --git a/data/Test468.hs b/data/Test468.hs
new file mode 100644
index 0000000..2c704b4
--- /dev/null
+++ b/data/Test468.hs
@@ -0,0 +1,4 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+import {-# SOURCE #-} safe qualified "base" Data.List as L
+import {-# SOURCE #-} safe qualified "base" Data.List ()
+import {-# SOURCE #-} safe qualified Data.List hiding ()
diff --git a/data/Test469.hs b/data/Test469.hs
new file mode 100644
index 0000000..fa53576
--- /dev/null
+++ b/data/Test469.hs
@@ -0,0 +1,2 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+import qualified Data.List ()
diff --git a/data/Test47.hs b/data/Test47.hs
new file mode 100644
index 0000000..2dbac94
--- /dev/null
+++ b/data/Test47.hs
@@ -0,0 +1,4 @@
+data Foo = Bar
+ { foo :: Baz
+ , bars :: Bizzz
+ }
diff --git a/data/Test470.hs b/data/Test470.hs
new file mode 100644
index 0000000..97ce770
--- /dev/null
+++ b/data/Test470.hs
@@ -0,0 +1,2 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+import Data.List (nub)
diff --git a/data/Test471.hs b/data/Test471.hs
new file mode 100644
index 0000000..fb499b1
--- /dev/null
+++ b/data/Test471.hs
@@ -0,0 +1,2 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+import Data.List (foldl', indexElem, nub)
diff --git a/data/Test472.hs b/data/Test472.hs
new file mode 100644
index 0000000..39cfd67
--- /dev/null
+++ b/data/Test472.hs
@@ -0,0 +1,16 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+import Test
+ ( Long
+ , anymore
+ , fit
+ , items
+ , line
+ , list
+ , not
+ , onA
+ , quite
+ , single
+ , that
+ , will
+ , with
+ )
diff --git a/data/Test473.hs b/data/Test473.hs
new file mode 100644
index 0000000..016a6b7
--- /dev/null
+++ b/data/Test473.hs
@@ -0,0 +1,2 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+import Test ((+), T, T2(), T3(..), T4(T4), T5(T5, t5), T6((<|>)))
diff --git a/data/Test474.hs b/data/Test474.hs
new file mode 100644
index 0000000..1716691
--- /dev/null
+++ b/data/Test474.hs
@@ -0,0 +1,3 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+import Test hiding ()
+import Test as T hiding ()
diff --git a/data/Test475.hs b/data/Test475.hs
new file mode 100644
index 0000000..adbfb6e
--- /dev/null
+++ b/data/Test475.hs
@@ -0,0 +1,15 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+import Prelude as X
+ hiding
+ ( head
+ , init
+ , last
+ , maximum
+ , minimum
+ , pred
+ , read
+ , readFile
+ , succ
+ , tail
+ , undefined
+ )
diff --git a/data/Test476.hs b/data/Test476.hs
new file mode 100644
index 0000000..900fb1f
--- /dev/null
+++ b/data/Test476.hs
@@ -0,0 +1,5 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+import MoreThanSufficientlyLongModuleNameWithSome
+ (compact, fit, inA, items, layout, not, that, will)
+import TestJustAbitToLongModuleNameLikeThisOneIs ()
+import TestJustShortEnoughModuleNameLikeThisOne ()
diff --git a/data/Test477.hs b/data/Test477.hs
new file mode 100644
index 0000000..0f32c77
--- /dev/null
+++ b/data/Test477.hs
@@ -0,0 +1,3 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+import TestJustAbitToLongModuleNameLikeThisOneI as T
+import TestJustShortEnoughModuleNameLikeThisOn as T
diff --git a/data/Test478.hs b/data/Test478.hs
new file mode 100644
index 0000000..3c047b9
--- /dev/null
+++ b/data/Test478.hs
@@ -0,0 +1,3 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+import TestJustAbitToLongModuleNameLikeTh hiding ()
+import TestJustShortEnoughModuleNameLike hiding ()
diff --git a/data/Test479.hs b/data/Test479.hs
new file mode 100644
index 0000000..3e8adc0
--- /dev/null
+++ b/data/Test479.hs
@@ -0,0 +1,3 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+import MoreThanSufficientlyLongModuleNameWithSome
+ (compact, fit, inA, items, layout, not, that, will)
diff --git a/data/Test48.hs b/data/Test48.hs
new file mode 100644
index 0000000..56c5cba
--- /dev/null
+++ b/data/Test48.hs
@@ -0,0 +1,4 @@
+data Foo = Bar
+ { foo, biz :: Baz
+ , bar :: Bizzz
+ }
diff --git a/data/Test480.hs b/data/Test480.hs
new file mode 100644
index 0000000..4bc1c0c
--- /dev/null
+++ b/data/Test480.hs
@@ -0,0 +1,2 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+import TestJustShortEnoughModuleNameLike hiding (abc, def, ghci, jklm)
diff --git a/data/Test481.hs b/data/Test481.hs
new file mode 100644
index 0000000..b6f7509
--- /dev/null
+++ b/data/Test481.hs
@@ -0,0 +1,5 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+-- Test
+import Data.List (nub) -- Test
+{- Test -}
+import qualified Data.List as L (foldl') {- Test -}
diff --git a/data/Test482.hs b/data/Test482.hs
new file mode 100644
index 0000000..4fd065e
--- /dev/null
+++ b/data/Test482.hs
@@ -0,0 +1,6 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+import Test
+ ( abc
+ , def
+ -- comment
+ )
diff --git a/data/Test483.hs b/data/Test483.hs
new file mode 100644
index 0000000..5a03da5
--- /dev/null
+++ b/data/Test483.hs
@@ -0,0 +1,5 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+import Test
+ ( abc
+ -- comment
+ )
diff --git a/data/Test484.hs b/data/Test484.hs
new file mode 100644
index 0000000..7749c61
--- /dev/null
+++ b/data/Test484.hs
@@ -0,0 +1,12 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+import Test
+ ( abc
+ -- comment
+ , def
+ , ghi
+ {- comment -}
+ , jkl
+ -- comment
+ )
+-- Test
+import Test (test)
diff --git a/data/Test485.hs b/data/Test485.hs
new file mode 100644
index 0000000..a1879a2
--- /dev/null
+++ b/data/Test485.hs
@@ -0,0 +1,4 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+import Test
+ ( -- comment
+ )
diff --git a/data/Test486.hs b/data/Test486.hs
new file mode 100644
index 0000000..e66d47a
--- /dev/null
+++ b/data/Test486.hs
@@ -0,0 +1,3 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+import Test (longbindingNameThatoverflowsColum)
+import Test (Long(List, Of, Things))
diff --git a/data/Test487.hs b/data/Test487.hs
new file mode 100644
index 0000000..4fa860d
--- /dev/null
+++ b/data/Test487.hs
@@ -0,0 +1,27 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+import Test
+ ( Thing
+ ( With
+ -- Comments
+ , and
+ -- also
+ , items
+ -- !
+ )
+ )
+import Test
+ ( Thing
+ ( Item
+ -- and Comment
+ )
+ )
+import Test
+ ( Thing
+ ( With
+ -- Comments
+ , and
+ -- also
+ , items
+ -- !
+ )
+ )
diff --git a/data/Test488.hs b/data/Test488.hs
new file mode 100644
index 0000000..f65f0d6
--- /dev/null
+++ b/data/Test488.hs
@@ -0,0 +1,3 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+import VeryLongModuleNameThatCouldEvenCauseAnEmptyBindingListToExpandIntoMultipleLine
+ ()
diff --git a/data/Test489.hs b/data/Test489.hs
new file mode 100644
index 0000000..f16fa76
--- /dev/null
+++ b/data/Test489.hs
@@ -0,0 +1,25 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+{-# LANGUAGE BangPatterns #-}
+{-
+ - Test module
+ -}
+module Test
+ ( test1
+ -- ^ test
+ , test2
+ -- | test
+ , test3
+ , test4
+ , test5
+ , test6
+ , test7
+ , test8
+ , test9
+ , test10
+ ) where
+-- Test
+import Data.List (nub) -- Test
+{- Test -}
+import qualified Data.List as L (foldl') {- Test -}
+-- Test
+import Test (test)
diff --git a/data/Test49.hs b/data/Test49.hs
new file mode 100644
index 0000000..3b236c6
--- /dev/null
+++ b/data/Test49.hs
@@ -0,0 +1,5 @@
+data Foo = Bar
+ { fooz :: Baz
+ , bar :: Bizzz
+ }
+ deriving Show
diff --git a/data/Test490.hs b/data/Test490.hs
new file mode 100644
index 0000000..0cf1f73
--- /dev/null
+++ b/data/Test490.hs
@@ -0,0 +1,5 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+func = do
+ abc <- foo
+--abc
+return ()
diff --git a/data/Test491.hs b/data/Test491.hs
new file mode 100644
index 0000000..b625fed
--- /dev/null
+++ b/data/Test491.hs
@@ -0,0 +1,2 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+func = (())
diff --git a/data/Test492.hs b/data/Test492.hs
new file mode 100644
index 0000000..2585e2d
--- /dev/null
+++ b/data/Test492.hs
@@ -0,0 +1,6 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+func = do
+ let
+ foo True = True
+ foo _ = False
+ return ()
diff --git a/data/Test493.hs b/data/Test493.hs
new file mode 100644
index 0000000..2585e2d
--- /dev/null
+++ b/data/Test493.hs
@@ -0,0 +1,6 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+func = do
+ let
+ foo True = True
+ foo _ = False
+ return ()
diff --git a/data/Test494.hs b/data/Test494.hs
new file mode 100644
index 0000000..872a368
--- /dev/null
+++ b/data/Test494.hs
@@ -0,0 +1,6 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+func = do
+ let
+ foo = True
+ b = False
+ return ()
diff --git a/data/Test495.hs b/data/Test495.hs
new file mode 100644
index 0000000..43d52fe
--- /dev/null
+++ b/data/Test495.hs
@@ -0,0 +1,6 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+func =
+ let
+ foo = True
+ b = False
+ in return ()
diff --git a/data/Test496.hs b/data/Test496.hs
new file mode 100644
index 0000000..d06ea75
--- /dev/null
+++ b/data/Test496.hs
@@ -0,0 +1,4 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+func = do
+ s <- mGet
+ mSet $ s { _lstate_indent = _lstate_indent state }
diff --git a/data/Test497.hs b/data/Test497.hs
new file mode 100644
index 0000000..f862333
--- /dev/null
+++ b/data/Test497.hs
@@ -0,0 +1,7 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+func = do
+ s <- mGet
+ mSet $ s
+ { _lstate_indent = _lstate_indent state
+ , _lstate_foo = _lstate_foo state
+ }
diff --git a/data/Test498.hs b/data/Test498.hs
new file mode 100644
index 0000000..52505be
--- /dev/null
+++ b/data/Test498.hs
@@ -0,0 +1,7 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+func = do
+ s <- mGet
+ mSet $ s
+ { _lstate_indent = _lstate_indent lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
+ , _lstate_foo = _lstate_foo kasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
+ }
diff --git a/data/Test499.hs b/data/Test499.hs
new file mode 100644
index 0000000..7362219
--- /dev/null
+++ b/data/Test499.hs
@@ -0,0 +1,2 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+func = Foo { _lstate_indent = _lstate_indent state }
diff --git a/data/Test5.hs b/data/Test5.hs
new file mode 100644
index 0000000..71a352d
--- /dev/null
+++ b/data/Test5.hs
@@ -0,0 +1 @@
+func :: (a -> a) -> a
diff --git a/data/Test50.hs b/data/Test50.hs
new file mode 100644
index 0000000..f249e56
--- /dev/null
+++ b/data/Test50.hs
@@ -0,0 +1,8 @@
+data MyRecord = MyConstructor
+ { bar1, bar2
+ :: Loooooooooooooooooooooooooooooooong
+ -> Loooooooooooooooooooooooooooooooong
+ , foo1, foo2
+ :: Loooooooooooooooooooooooooooooooonger
+ -> Loooooooooooooooooooooooooooooooonger
+ }
diff --git a/data/Test500.hs b/data/Test500.hs
new file mode 100644
index 0000000..9b188e5
--- /dev/null
+++ b/data/Test500.hs
@@ -0,0 +1,5 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+func = Foo
+ { _lstate_indent = _lstate_indent lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
+ , _lstate_foo = _lstate_foo lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
+ }
diff --git a/data/Test501.hs b/data/Test501.hs
new file mode 100644
index 0000000..1cac41f
--- /dev/null
+++ b/data/Test501.hs
@@ -0,0 +1,6 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+func = do
+ Foo
+ { _lstate_indent = _lstate_indent lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
+ , _lstate_foo = _lstate_foo lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
+ }
diff --git a/data/Test502.hs b/data/Test502.hs
new file mode 100644
index 0000000..2482992
--- /dev/null
+++ b/data/Test502.hs
@@ -0,0 +1,5 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+func = do
+-- abc
+ -- def
+ return ()
diff --git a/data/Test503.hs b/data/Test503.hs
new file mode 100644
index 0000000..36aa1f1
--- /dev/null
+++ b/data/Test503.hs
@@ -0,0 +1,7 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+func = do
+ do
+ return ()
+ -- abc
+ -- def
+ return ()
diff --git a/data/Test504.hs b/data/Test504.hs
new file mode 100644
index 0000000..3c3d575
--- /dev/null
+++ b/data/Test504.hs
@@ -0,0 +1,7 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+func
+ :: Int -- basic indentation amount
+ -> Int -- currently used width in current line (after indent)
+ -- used to accurately calc placing of the current-line
+ -> LayoutDesc
+ -> Int
diff --git a/data/Test505.hs b/data/Test505.hs
new file mode 100644
index 0000000..0157f35
--- /dev/null
+++ b/data/Test505.hs
@@ -0,0 +1,8 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+func =
+ (lkjadljasldjalskdjaldjalsdjkalsdjlaksdjlasjdlajsaldskj
+ $ abc
+ $ def
+ $ ghi
+ $ jkl
+ )
diff --git a/data/Test506.hs b/data/Test506.hs
new file mode 100644
index 0000000..ed27504
--- /dev/null
+++ b/data/Test506.hs
@@ -0,0 +1,3 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+buildG bounds0 edges0 = accumArray (flip (:)) [] bounds0 (map reassoc edges0)
+ where reassoc (v, e, w) = (v, (e, w))
diff --git a/data/Test507.hs b/data/Test507.hs
new file mode 100644
index 0000000..1795543
--- /dev/null
+++ b/data/Test507.hs
@@ -0,0 +1,5 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+downloadRepoPackage = case repo of
+ RepoLocal {..} -> return ()
+ RepoLocal { abc } -> return ()
+ RepoLocal{} -> return ()
diff --git a/data/Test508.hs b/data/Test508.hs
new file mode 100644
index 0000000..5ecfcc9
--- /dev/null
+++ b/data/Test508.hs
@@ -0,0 +1,8 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+func = do
+ let
+ (primaryPkg, otherPkgs) = selectPrimaryLocalPackage pwd pkgs'
+ (bproblems, x) = resolveBuildTargets primaryPkg otherPkgs utargets''
+ -- default local dir target if there's no given target
+ utargets'' = "foo"
+ return ()
diff --git a/data/Test509.hs b/data/Test509.hs
new file mode 100644
index 0000000..f66ac30
--- /dev/null
+++ b/data/Test509.hs
@@ -0,0 +1,6 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+func =
+ [ (thing, take 10 alts) --TODO: select best ones
+ | (thing, _got, alts@(_ : _)) <- nosuchFooThing
+ , gast <- award
+ ]
diff --git a/data/Test51.hs b/data/Test51.hs
new file mode 100644
index 0000000..ba064e1
--- /dev/null
+++ b/data/Test51.hs
@@ -0,0 +1,13 @@
+{-# LANGUAGE DatatypeContexts #-}
+data
+ ( LooooooooooooooooooooongConstraint a
+ , LooooooooooooooooooooongConstraint b
+ ) =>
+ MyRecord a b
+ = MyConstructor
+ { foo1, foo2
+ :: loooooooooooooooooooooooooooooooong
+ -> loooooooooooooooooooooooooooooooong
+ , bar :: a
+ , bazz :: b
+ }
diff --git a/data/Test510.hs b/data/Test510.hs
new file mode 100644
index 0000000..e939f8f
--- /dev/null
+++ b/data/Test510.hs
@@ -0,0 +1,6 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+func = if x
+ then if y -- y is important
+ then foo
+ else bar
+ else Nothing
diff --git a/data/Test511.hs b/data/Test511.hs
new file mode 100644
index 0000000..fcc4b7c
--- /dev/null
+++ b/data/Test511.hs
@@ -0,0 +1,8 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+wrapPatPrepend pat prepElem = do
+ patDocs <- layoutPat pat
+ case Seq.viewl patDocs of
+ Seq.EmptyL -> return $ Seq.empty
+ x1 Seq.:< xR -> do
+ x1' <- docSeq [prepElem, return x1]
+ return $ x1' Seq.<| xR
diff --git a/data/Test512.hs b/data/Test512.hs
new file mode 100644
index 0000000..721607a
--- /dev/null
+++ b/data/Test512.hs
@@ -0,0 +1,7 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+layoutWriteNewlineBlock
+ :: ( MonadMultiWriter Text.Builder.Builder m
+ , MonadMultiState LayoutState m
+ , MonadMultiWriter (Seq String) m
+ )
+ => m ()
diff --git a/data/Test513.hs b/data/Test513.hs
new file mode 100644
index 0000000..19308aa
--- /dev/null
+++ b/data/Test513.hs
@@ -0,0 +1,25 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+{-# LANGUAGE MultiWayIf #-}
+readMergePersConfig path shouldCreate conf = do
+ exists <- liftIO $ System.Directory.doesFileExist path
+ if
+ | exists -> do
+ contents <- liftIO $ ByteString.readFile path -- no lazy IO, tyvm.
+ fileConf <- case Data.Yaml.decodeEither contents of
+ Left e -> do
+ liftIO
+ $ putStrErrLn
+ $ "error reading in brittany config from "
+ ++ path
+ ++ ":"
+ liftIO $ putStrErrLn e
+ mzero
+ Right x -> return x
+ return $ fileConf Semigroup.<> conf
+ | shouldCreate -> do
+ liftIO $ ByteString.writeFile path $ Data.Yaml.encode $ cMap
+ (Option . Just . runIdentity)
+ staticDefaultConfig
+ return $ conf
+ | otherwise -> do
+ return conf
diff --git a/data/Test514.hs b/data/Test514.hs
new file mode 100644
index 0000000..8dcc5a1
--- /dev/null
+++ b/data/Test514.hs
@@ -0,0 +1,13 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+func = BuildReport
+ where
+ convertInstallOutcome = case result of
+ Left BR.PlanningFailed -> PlanningFailed
+ Left (BR.DependentFailed p) -> DependencyFailed p
+ Left (BR.DownloadFailed _) -> DownloadFailed
+ Left (BR.UnpackFailed _) -> UnpackFailed
+ Left (BR.ConfigureFailed _) -> ConfigureFailed
+ Left (BR.BuildFailed _) -> BuildFailed
+ Left (BR.TestsFailed _) -> TestsFailed
+ Left (BR.InstallFailed _) -> InstallFailed
+ Right (BR.BuildOk _ _ _) -> InstallOk
diff --git a/data/Test515.hs b/data/Test515.hs
new file mode 100644
index 0000000..8dcc5a1
--- /dev/null
+++ b/data/Test515.hs
@@ -0,0 +1,13 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+func = BuildReport
+ where
+ convertInstallOutcome = case result of
+ Left BR.PlanningFailed -> PlanningFailed
+ Left (BR.DependentFailed p) -> DependencyFailed p
+ Left (BR.DownloadFailed _) -> DownloadFailed
+ Left (BR.UnpackFailed _) -> UnpackFailed
+ Left (BR.ConfigureFailed _) -> ConfigureFailed
+ Left (BR.BuildFailed _) -> BuildFailed
+ Left (BR.TestsFailed _) -> TestsFailed
+ Left (BR.InstallFailed _) -> InstallFailed
+ Right (BR.BuildOk _ _ _) -> InstallOk
diff --git a/data/Test516.hs b/data/Test516.hs
new file mode 100644
index 0000000..ccf86e7
--- /dev/null
+++ b/data/Test516.hs
@@ -0,0 +1,37 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+showPackageDetailedInfo pkginfo =
+ renderStyle (style { lineLength = 80, ribbonsPerLine = 1 })
+ $ char '*'
+ $+$ something
+ [ entry "Synopsis" synopsis hideIfNull reflowParagraphs
+ , entry
+ "Versions available"
+ sourceVersions
+ (altText null "[ Not available from server ]")
+ (dispTopVersions 9 (preferredVersions pkginfo))
+ , entry
+ "Versions installed"
+ installedVersions
+ (altText
+ null
+ (if hasLib pkginfo then "[ Not installed ]" else "[ Unknown ]")
+ )
+ (dispTopVersions 4 (preferredVersions pkginfo))
+ , entry "Homepage" homepage orNotSpecified text
+ , entry "Bug reports" bugReports orNotSpecified text
+ , entry "Description" description hideIfNull reflowParagraphs
+ , entry "Category" category hideIfNull text
+ , entry "License" license alwaysShow disp
+ , entry "Author" author hideIfNull reflowLines
+ , entry "Maintainer" maintainer hideIfNull reflowLines
+ , entry "Source repo" sourceRepo orNotSpecified text
+ , entry "Executables" executables hideIfNull (commaSep text)
+ , entry "Flags" flags hideIfNull (commaSep dispFlag)
+ , entry "Dependencies" dependencies hideIfNull (commaSep dispExtDep)
+ , entry "Documentation" haddockHtml showIfInstalled text
+ , entry "Cached" haveTarball alwaysShow dispYesNo
+ , if not (hasLib pkginfo)
+ then empty
+ else text "Modules:"
+ $+$ nest 4 (vcat (map disp . sort . modules $ pkginfo))
+ ]
diff --git a/data/Test517.hs b/data/Test517.hs
new file mode 100644
index 0000000..5b5926c
--- /dev/null
+++ b/data/Test517.hs
@@ -0,0 +1,4 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+isValidPosition position
+ | validX && validY = Just position
+ | otherwise = Nothing
diff --git a/data/Test518.hs b/data/Test518.hs
new file mode 100644
index 0000000..5583847
--- /dev/null
+++ b/data/Test518.hs
@@ -0,0 +1,7 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+foo = Reflex.runSpiderHost $ ReflexHost.hostApp $ do
+ (inputEvent :: Reflex.Event Reflex.Spider String, inputFire :: String
+ -> IO Bool) <-
+ ReflexHost.newExternalEvent
+ liftIO . forkIO . forever $ getLine >>= inputFire
+ ReflexHost.performEvent_ $ fmap (liftIO . putStrLn) inputEvent
diff --git a/data/Test519.hs b/data/Test519.hs
new file mode 100644
index 0000000..88cd872
--- /dev/null
+++ b/data/Test519.hs
@@ -0,0 +1,4 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+-- Test.hs
+module Test where
+data X = X
diff --git a/data/Test52.hs b/data/Test52.hs
new file mode 100644
index 0000000..a8b49da
--- /dev/null
+++ b/data/Test52.hs
@@ -0,0 +1,5 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+-- brittany { lconfig_allowSinglelineRecord: true }
+data MyRecord = forall a . Show a => Bar
+ { foo :: abittoolongbutnotvery -> abittoolongbutnotvery
+ }
diff --git a/data/Test520.hs b/data/Test520.hs
new file mode 100644
index 0000000..d9dac4b
--- /dev/null
+++ b/data/Test520.hs
@@ -0,0 +1,3 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+foldrDesc f z = unSwitchQueue $ \q ->
+ switch (Min.foldrDesc (f unTaggedF) z q) (Min.foldrAsc (f unTaggedF) z q)
diff --git a/data/Test521.hs b/data/Test521.hs
new file mode 100644
index 0000000..ff6208b
--- /dev/null
+++ b/data/Test521.hs
@@ -0,0 +1,6 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+autocheckCases =
+ [ ("Never Deadlocks", representative deadlocksNever)
+ , ("No Exceptions", representative exceptionsNever)
+ , ("Consistent Result", alwaysSame) -- already representative
+ ]
diff --git a/data/Test522.hs b/data/Test522.hs
new file mode 100644
index 0000000..d3c2fb0
--- /dev/null
+++ b/data/Test522.hs
@@ -0,0 +1,8 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+autocheckCases =
+ [ ("Never Deadlocks", representative deadlocksNever)
+ , ("No Exceptions", representative exceptionsNever)
+ , ( "Consistent Result"
+ , alwaysSame -- already representative
+ )
+ ]
diff --git a/data/Test523.hs b/data/Test523.hs
new file mode 100644
index 0000000..78897cd
--- /dev/null
+++ b/data/Test523.hs
@@ -0,0 +1,6 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+func =
+ [ (abc, (1111, 1111))
+ , (def, (2, 2))
+ , foo -- comment
+ ]
diff --git a/data/Test524.hs b/data/Test524.hs
new file mode 100644
index 0000000..0aeb4a8
--- /dev/null
+++ b/data/Test524.hs
@@ -0,0 +1,3 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+foo a b = g a b -- fooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo
+ where g a b = b + b * a
diff --git a/data/Test525.hs b/data/Test525.hs
new file mode 100644
index 0000000..74d9df7
--- /dev/null
+++ b/data/Test525.hs
@@ -0,0 +1,2 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+foo a b = g a b where g a b = b + b * a -- fooooooooooooooooooooooooooooooooooo
diff --git a/data/Test526.hs b/data/Test526.hs
new file mode 100644
index 0000000..ae6bb6a
--- /dev/null
+++ b/data/Test526.hs
@@ -0,0 +1,6 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+func = do
+ abc <- expr
+ abcccccccccccccccccc <- expr
+ abcccccccccccccccccccccccccccccccccccccccccc <- expr
+ abccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc <- expr
diff --git a/data/Test527.hs b/data/Test527.hs
new file mode 100644
index 0000000..f3664cd
--- /dev/null
+++ b/data/Test527.hs
@@ -0,0 +1,4 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+func (MyLongFoo abc def) = 1
+func (Bar a d) = 2
+func _ = 3
diff --git a/data/Test528.hs b/data/Test528.hs
new file mode 100644
index 0000000..2867ab4
--- /dev/null
+++ b/data/Test528.hs
@@ -0,0 +1,15 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+parserCompactLocation =
+ [ try
+ $ [ ParseRelAbs (Text.Read.read digits) _ _
+ | digits <- many1 digit
+ , rel1 :: Maybe (Either Int (Ratio Int)) <- optionMaybe
+ [ case divPart of
+ Nothing -> Left $ Text.Read.read digits
+ Just ddigits ->
+ Right $ Text.Read.read digits % Text.Read.read ddigits
+ | digits <- many1 digit
+ , divPart <- optionMaybe (string "/" *> many1 digit)
+ ]
+ ]
+ ]
diff --git a/data/Test529.hs b/data/Test529.hs
new file mode 100644
index 0000000..f2b42a8
--- /dev/null
+++ b/data/Test529.hs
@@ -0,0 +1,4 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+func = fooooooooooooooooooooooooooooooooo $ foooooooooooooooooooooooooooooooo
+ foooooooooooooooooooooooooooooooo
+ foooooooooooooooooooooooooooooooo
diff --git a/data/Test53.hs b/data/Test53.hs
new file mode 100644
index 0000000..82be3f3
--- /dev/null
+++ b/data/Test53.hs
@@ -0,0 +1,7 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+data MyRecord
+ = forall a
+ . LooooooooooooooooooooongConstraint a =>
+ LoooooooooooongConstructor
+ { foo :: abittoolongbutnotvery -> abittoolongbutnotvery
+ }
diff --git a/data/Test530.hs b/data/Test530.hs
new file mode 100644
index 0000000..ae12740
--- /dev/null
+++ b/data/Test530.hs
@@ -0,0 +1,6 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+func =
+ fooooooooooooooooooooooooooooooooo
+ + foooooooooooooooooooooooooooooooo
+ foooooooooooooooooooooooooooooooo
+ foooooooooooooooooooooooooooooooo
diff --git a/data/Test531.hs b/data/Test531.hs
new file mode 100644
index 0000000..fc1335c
--- /dev/null
+++ b/data/Test531.hs
@@ -0,0 +1,6 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+func = fooooooooooooooooooooooooooooooooo + foooooooooooooooooooooooooooooooo
+ [ foooooooooooooooooooooooooooooooo
+ , foooooooooooooooooooooooooooooooo
+ , foooooooooooooooooooooooooooooooo
+ ]
diff --git a/data/Test532.hs b/data/Test532.hs
new file mode 100644
index 0000000..fcda0ed
--- /dev/null
+++ b/data/Test532.hs
@@ -0,0 +1,20 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+parserPrim =
+ [ r
+ | r <-
+ [ SGPPrimFloat $ bool id (0 -) minus $ readGnok
+ "parserPrim"
+ (d1 ++ d2 ++ d3 ++ d4)
+ | d2 <- string "."
+ , d3 <- many1 (oneOf "0123456789")
+ , _ <- string "f"
+ ]
+ <|> [ SGPPrimFloat $ bool id (0 -) minus $ fromIntegral
+ (readGnok "parserPrim" d1 :: Integer)
+ | _ <- string "f"
+ ]
+ <|> [ SGPPrimInt $ bool id (0 -) minus $ fromIntegral
+ (readGnok "parserPrim" d1 :: Integer)
+ | _ <- string "i"
+ ]
+ ]
diff --git a/data/Test533.hs b/data/Test533.hs
new file mode 100644
index 0000000..3f54efe
--- /dev/null
+++ b/data/Test533.hs
@@ -0,0 +1,3 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+samples = (SV.unpackaaaaadat) <&> \f ->
+ aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
diff --git a/data/Test534.hs b/data/Test534.hs
new file mode 100644
index 0000000..33c5182
--- /dev/null
+++ b/data/Test534.hs
@@ -0,0 +1,11 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+runBrittany tabSize text = do
+ let
+ config' = staticDefaultConfig
+ config = config'
+ { _conf_layout = (_conf_layout config')
+ { _lconfig_indentAmount = coerce tabSize
+ }
+ , _conf_forward = forwardOptionsSyntaxExtsEnabled
+ }
+ parsePrintModule config text
diff --git a/data/Test535.hs b/data/Test535.hs
new file mode 100644
index 0000000..cb2da37
--- /dev/null
+++ b/data/Test535.hs
@@ -0,0 +1,3 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+{-# LANGUAGE TypeApplications #-}
+foo = bar @Baz
diff --git a/data/Test536.hs b/data/Test536.hs
new file mode 100644
index 0000000..8674ebf
--- /dev/null
+++ b/data/Test536.hs
@@ -0,0 +1,51 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+{-# LANGUAGE TypeApplications #-}
+layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs = do
+ docAlt
+ $ -- one-line solution
+ [ docCols
+ (ColBindingLine alignmentToken)
+ [ docSeq (patPartInline ++ [guardPart])
+ , docSeq
+ [ appSep $ return binderDoc
+ , docForceSingleline $ return body
+ , wherePart
+ ]
+ ]
+ | not hasComments
+ , [(guards, body, _bodyRaw)] <- [clauseDocs]
+ , let guardPart = singleLineGuardsDoc guards
+ , wherePart <- case mWhereDocs of
+ Nothing -> return @[] $ docEmpty
+ Just [w] -> return @[] $ docSeq
+ [ docSeparator
+ , appSep $ docLit $ Text.pack "where"
+ , docSetIndentLevel $ docForceSingleline $ return w
+ ]
+ _ -> []
+ ]
+ ++ -- one-line solution + where in next line(s)
+ [ docLines
+ $ [ docCols
+ (ColBindingLine alignmentToken)
+ [ docSeq (patPartInline ++ [guardPart])
+ , docSeq
+ [appSep $ return binderDoc, docForceParSpacing $ return body]
+ ]
+ ]
+ ++ wherePartMultiLine
+ | [(guards, body, _bodyRaw)] <- [clauseDocs]
+ , let guardPart = singleLineGuardsDoc guards
+ , Data.Maybe.isJust mWhereDocs
+ ]
+ ++ -- two-line solution + where in next line(s)
+ [ docLines
+ $ [ docForceSingleline
+ $ docSeq (patPartInline ++ [guardPart, return binderDoc])
+ , docEnsureIndent BrIndentRegular $ docForceSingleline $ return
+ body
+ ]
+ ++ wherePartMultiLine
+ | [(guards, body, _bodyRaw)] <- [clauseDocs]
+ , let guardPart = singleLineGuardsDoc guards
+ ]
diff --git a/data/Test537.hs b/data/Test537.hs
new file mode 100644
index 0000000..12526a2
--- /dev/null
+++ b/data/Test537.hs
@@ -0,0 +1,11 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+{-# LANGUAGE MultiWayIf #-}
+func = do
+ let
+ foo = if
+ | Constuctoooooooooooooooooooooooooooooooooooor `elem` artics -- TODO
+ -> max
+ (defLen - 0.2) -- TODO
+ (defLen * 0.8)
+ | otherwise -> max (defLen - 0.05) (defLen * 0.95) -- TODO
+ return True
diff --git a/data/Test538.hs b/data/Test538.hs
new file mode 100644
index 0000000..a527909
--- /dev/null
+++ b/data/Test538.hs
@@ -0,0 +1,6 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+foo n = case n of
+ 1 -> True
+ -1 -> False
+bar n = case n of
+ (-2, -2) -> (-2, -2)
diff --git a/data/Test539.hs b/data/Test539.hs
new file mode 100644
index 0000000..7da39e1
--- /dev/null
+++ b/data/Test539.hs
@@ -0,0 +1,7 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+{-# LANGUAGE TypeApplications #-}
+foo =
+ let
+ a = b @1
+ cccc = ()
+ in foo
diff --git a/data/Test54.hs b/data/Test54.hs
new file mode 100644
index 0000000..7d2cb1b
--- /dev/null
+++ b/data/Test54.hs
@@ -0,0 +1,10 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+data MyRecord
+ = forall a b
+ . ( Loooooooooooooooooooooooooooooooong a
+ , Loooooooooooooooooooooooooooooooong b
+ ) =>
+ MyConstructor
+ { a :: a
+ , b :: b
+ }
diff --git a/data/Test540.hs b/data/Test540.hs
new file mode 100644
index 0000000..936c1cd
--- /dev/null
+++ b/data/Test540.hs
@@ -0,0 +1,14 @@
+-- brittany { lconfig_columnAlignMode: { tag: ColumnAlignModeDisabled }, lconfig_indentPolicy: IndentPolicyLeft }
+record :: Record
+record = Record
+ { rProperties =
+ [ "foo" .= "bar"
+ , "foo" .= "bar"
+ , "foo" .= "bar"
+ , "foo" .= "bar"
+ , "foo" .= "bar"
+ , "foo" .= "bar"
+ , "foo" .= "bar"
+ , "foo" .= "bar"
+ ]
+ }
diff --git a/data/Test55.hs b/data/Test55.hs
new file mode 100644
index 0000000..e49c0da
--- /dev/null
+++ b/data/Test55.hs
@@ -0,0 +1,9 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+data MyStruct
+ = forall a b
+ . ( Loooooooooooooooooooooooooooooooong a
+ , Loooooooooooooooooooooooooooooooong b
+ ) =>
+ MyConstructor (ToBriDocM BriDocNumbered)
+ (ToBriDocM BriDocNumbered)
+ (ToBriDocM BriDocNumbered)
diff --git a/data/Test56.hs b/data/Test56.hs
new file mode 100644
index 0000000..941107b
--- /dev/null
+++ b/data/Test56.hs
@@ -0,0 +1,14 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+data MyRecord
+ = forall a b
+ . ( Loooooooooooooooooooooooooooooooong a
+ , Loooooooooooooooooooooooooooooooong b
+ ) =>
+ MyConstructor
+ { foo, foo2
+ :: loooooooooooooooooooooooooooooooong
+ -> loooooooooooooooooooooooooooooooong
+ , bar :: a
+ , bazz :: b
+ }
+ deriving Show
diff --git a/data/Test57.hs b/data/Test57.hs
new file mode 100644
index 0000000..6bcfc1b
--- /dev/null
+++ b/data/Test57.hs
@@ -0,0 +1,5 @@
+data Foo = Bar
+ { foo :: Baz
+ , bars :: Bizzz
+ }
+ deriving (Show, Eq, Monad, Functor, Traversable, Foldable)
diff --git a/data/Test58.hs b/data/Test58.hs
new file mode 100644
index 0000000..6b228a2
--- /dev/null
+++ b/data/Test58.hs
@@ -0,0 +1,12 @@
+data Foo = Bar
+ { foo :: Baz
+ , bars :: Bizzz
+ }
+ deriving Show
+ deriving (Eq, Ord)
+ deriving stock Show
+ deriving stock (Eq, Ord)
+ deriving anyclass Show
+ deriving anyclass (Show, Eq, Monad, Functor)
+ deriving newtype Show
+ deriving newtype (Traversable, Foldable)
diff --git a/data/Test59.hs b/data/Test59.hs
new file mode 100644
index 0000000..5721ef0
--- /dev/null
+++ b/data/Test59.hs
@@ -0,0 +1,6 @@
+data Foo = Bar
+ { foo :: Baz
+ , bars :: Bizzz
+ }
+ deriving ToJSON via (SomeType)
+ deriving (ToJSON, FromJSON) via (SomeType)
diff --git a/data/Test6.hs b/data/Test6.hs
new file mode 100644
index 0000000..9bf7bb6
--- /dev/null
+++ b/data/Test6.hs
@@ -0,0 +1 @@
+func :: a -> (a -> a)
diff --git a/data/Test60.hs b/data/Test60.hs
new file mode 100644
index 0000000..79ccc7a
--- /dev/null
+++ b/data/Test60.hs
@@ -0,0 +1,4 @@
+{-# LANGUAGE ExistentialQuantification #-}
+data Foo = forall a . Show a => Bar
+ { foo :: a
+ }
diff --git a/data/Test61.hs b/data/Test61.hs
new file mode 100644
index 0000000..81d41bf
--- /dev/null
+++ b/data/Test61.hs
@@ -0,0 +1,5 @@
+{-# LANGUAGE ExistentialQuantification #-}
+data Foo = forall a b . (Show a, Eq b) => Bar
+ { foo :: a
+ , bars :: b
+ }
diff --git a/data/Test62.hs b/data/Test62.hs
new file mode 100644
index 0000000..8762559
--- /dev/null
+++ b/data/Test62.hs
@@ -0,0 +1,3 @@
+-- before
+data MyData = MyData Int
+-- after
diff --git a/data/Test63.hs b/data/Test63.hs
new file mode 100644
index 0000000..5532f33
--- /dev/null
+++ b/data/Test63.hs
@@ -0,0 +1,5 @@
+data MyRecord = MyRecord
+ { a :: Int
+ -- comment
+ , b :: Int
+ }
diff --git a/data/Test64.hs b/data/Test64.hs
new file mode 100644
index 0000000..0d37152
--- /dev/null
+++ b/data/Test64.hs
@@ -0,0 +1,5 @@
+data Foo = Bar -- a
+ { foo :: Baz -- b
+ , bars :: Bizzz -- c
+ } -- d
+ deriving (Show, Eq, Monad, Functor, Traversable, Foldable) -- e
diff --git a/data/Test65.hs b/data/Test65.hs
new file mode 100644
index 0000000..dd2506f
--- /dev/null
+++ b/data/Test65.hs
@@ -0,0 +1,9 @@
+data Foo = Bar
+ { -- a
+ foo -- b
+ :: -- c
+ Baz -- d
+ , -- e
+ bars :: Bizzz
+ }
+ deriving (Show, Eq, Monad, Functor, Traversable, Foldable)
diff --git a/data/Test66.hs b/data/Test66.hs
new file mode 100644
index 0000000..3c7aeaa
--- /dev/null
+++ b/data/Test66.hs
@@ -0,0 +1,11 @@
+data Foo = Bar
+ { foo :: Baz
+ , bars :: Bizzz
+ }
+ -- a
+ deriving --b
+ ( -- c
+ ToJSON -- d
+ , -- e
+ FromJSON --f
+ ) -- g
diff --git a/data/Test67.hs b/data/Test67.hs
new file mode 100644
index 0000000..a3a915b
--- /dev/null
+++ b/data/Test67.hs
@@ -0,0 +1,13 @@
+data Foo = Bar
+ { foo :: Baz
+ , bars :: Bizzz
+ }
+ -- a
+ deriving --a
+ ToJSON --b
+ via -- c
+ ( -- d
+ SomeType --e
+ , -- f
+ ABC --g
+ )
diff --git a/data/Test68.hs b/data/Test68.hs
new file mode 100644
index 0000000..0375bbb
--- /dev/null
+++ b/data/Test68.hs
@@ -0,0 +1,8 @@
+{-# LANGUAGE ExistentialQuantification #-}
+data MyRecord
+ -- test comment
+ = forall a b
+ . ( Loooooooooooooooooooooooooooooooong a
+ , Loooooooooooooooooooooooooooooooong b
+ ) =>
+ MyConstructor a b
diff --git a/data/Test69.hs b/data/Test69.hs
new file mode 100644
index 0000000..a1759f1
--- /dev/null
+++ b/data/Test69.hs
@@ -0,0 +1,4 @@
+-- brittany {lconfig_indentPolicy: IndentPolicyLeft }
+data EnterpriseGrantsForCompanyResponse = EnterpriseGrantsForCompanyResponse
+ Types.Company
+ [EnterpriseGrantResponse]
diff --git a/data/Test7.hs b/data/Test7.hs
new file mode 100644
index 0000000..6fd2b47
--- /dev/null
+++ b/data/Test7.hs
@@ -0,0 +1,2 @@
+func :: (((((((((())))))))))
+-- current output is.. funny. wonder if that can/needs to be improved..
diff --git a/data/Test70.hs b/data/Test70.hs
new file mode 100644
index 0000000..a2147f6
--- /dev/null
+++ b/data/Test70.hs
@@ -0,0 +1,3 @@
+-- brittany {lconfig_indentPolicy: IndentPolicyFree }
+data GrantsForCompanyResp = GrantsForCompanyResp Types.Company
+ [EnterpriseGrantResponse]
diff --git a/data/Test71.hs b/data/Test71.hs
new file mode 100644
index 0000000..5de2318
--- /dev/null
+++ b/data/Test71.hs
@@ -0,0 +1,4 @@
+-- brittany {lconfig_indentPolicy: IndentPolicyFree }
+data EnterpriseGrantsForCompanyResponse = EnterpriseGrantsForCompanyResponse
+ Types.Company
+ [EnterpriseGrantResponse]
diff --git a/data/Test72.hs b/data/Test72.hs
new file mode 100644
index 0000000..af66351
--- /dev/null
+++ b/data/Test72.hs
@@ -0,0 +1,3 @@
+-- brittany {lconfig_indentPolicy: IndentPolicyMultiple }
+data GrantsForCompanyResp = GrantsForCompanyResp Types.Company
+ [EnterpriseGrantResponse]
diff --git a/data/Test73.hs b/data/Test73.hs
new file mode 100644
index 0000000..260d671
--- /dev/null
+++ b/data/Test73.hs
@@ -0,0 +1,22 @@
+data XIILqcacwiuNiu = XIILqcacwiuNiu
+ { oyyFtvbepgbOge_pebzVmuftEijwuj :: Jgtoyuh HessJvNlo
+ , wloQsiskdoxJop_xatiKrwedOxtu :: Jgtoyuh [Inotg]
+ , mmmJjcqtemyIyo_ovosDoreKeeoyamvove :: Jgtoyuh Eujo
+ , mbiIatelofxOzr_uluxNngiiMjah :: Jgtoyuh HessJvNlo
+ , obxIskfcxpkIkb_uuviTuevcSkrgo :: Jgtoyuh Int
+ , wqrAtuvuecoHwr_ilotNxbuPleo :: Jgtoyuh Ufaxdeq
+ , lofAfuebdhpLuv_cnekPoyFxmg :: Jgtoyuh Ufaxdeq
+ , ouoFugtawzvUpk_oupiLzptugy :: Jgtoyuh Eujo
+ , iqiXjtziwogNsa_uiyvSunaTtgUsf3 :: Jgtoyuh Oaivn
+ , odbIriaqnojUlz_onotoWuunehIpuy :: Jgtoyuh Eujo
+ , opjUxtkxzkiKse_luqjuZazt
+ :: Jgtoyuh [(Eujo, Int, Int, Int, Int, Int, NELUxro)]
+ -- , jcqRaqznxfhIpa_ywevMezmoYkutuwa :: Jgtoyuh ()
+ , vayOmuasyphOfd_bcsVljmvt :: Jgtoyuh Eujo
+ , rifArahilooRax_ufikecqdImsv :: Jgtoyuh Oaivn
+ , raqKtopcpszDwb_oqocubasZuqjcryoDojGkw :: Jgtoyuh Oaivn
+ , mluJiilpcijUtt_gaisklifVekfeyagRmfbyzz :: Jgtoyuh Oaivn
+ , oqhPaahjupaSmi_gamwwoovKyxznecvEayluc :: Jgtoyuh Oaivn
+ , mazFubimwebZpa_itidehDodiDlboz :: Jgtoyuh Vrep
+ , jeyOcuesexaYoy_vpqn :: Jgtoyuh ()
+ }
diff --git a/data/Test74.hs b/data/Test74.hs
new file mode 100644
index 0000000..e9e6d4f
--- /dev/null
+++ b/data/Test74.hs
@@ -0,0 +1 @@
+func x = x
diff --git a/data/Test75.hs b/data/Test75.hs
new file mode 100644
index 0000000..2e7361d
--- /dev/null
+++ b/data/Test75.hs
@@ -0,0 +1 @@
+x *** y = x
diff --git a/data/Test76.hs b/data/Test76.hs
new file mode 100644
index 0000000..877399e
--- /dev/null
+++ b/data/Test76.hs
@@ -0,0 +1 @@
+(***) x y = x
diff --git a/data/Test77.hs b/data/Test77.hs
new file mode 100644
index 0000000..b0795a1
--- /dev/null
+++ b/data/Test77.hs
@@ -0,0 +1 @@
+(f >=> g) k = f k >>= g
diff --git a/data/Test78.hs b/data/Test78.hs
new file mode 100644
index 0000000..1f3d4e7
--- /dev/null
+++ b/data/Test78.hs
@@ -0,0 +1,4 @@
+(Left a <$$> Left dd) e f = True
+(Left a <$$> Right d ) e f = True
+(Right a <$$> Left d ) e f = False
+(Right a <$$> Right dd) e f = True
diff --git a/data/Test79.hs b/data/Test79.hs
new file mode 100644
index 0000000..bc6cbe5
--- /dev/null
+++ b/data/Test79.hs
@@ -0,0 +1 @@
+func _ = x
diff --git a/data/Test8.hs b/data/Test8.hs
new file mode 100644
index 0000000..9b1b57b
--- /dev/null
+++ b/data/Test8.hs
@@ -0,0 +1 @@
+func :: ()
diff --git a/data/Test80.hs b/data/Test80.hs
new file mode 100644
index 0000000..5c29c83
--- /dev/null
+++ b/data/Test80.hs
@@ -0,0 +1,2 @@
+func reallyreallyreallyreallyreallyreallyreallyreallyreallyreallylongvariable =
+ x
diff --git a/data/Test81.hs b/data/Test81.hs
new file mode 100644
index 0000000..7649b18
--- /dev/null
+++ b/data/Test81.hs
@@ -0,0 +1,2 @@
+func reallyreallyreallyreallyreallyreallyreallyreallyreallyreallylongvariable reallyreallyreallyreallyreallyreallyreallyreallyreallyreallylongvariable
+ = x
diff --git a/data/Test82.hs b/data/Test82.hs
new file mode 100644
index 0000000..dcb58cf
--- /dev/null
+++ b/data/Test82.hs
@@ -0,0 +1,2 @@
+func reallyreallyreallyreallyreallyreallyreallyreallyreallyreallylongvariable a b
+ = x
diff --git a/data/Test83.hs b/data/Test83.hs
new file mode 100644
index 0000000..2e709c1
--- /dev/null
+++ b/data/Test83.hs
@@ -0,0 +1 @@
+func (A a) = a
diff --git a/data/Test84.hs b/data/Test84.hs
new file mode 100644
index 0000000..58f9aca
--- /dev/null
+++ b/data/Test84.hs
@@ -0,0 +1 @@
+func (x : xr) = x
diff --git a/data/Test85.hs b/data/Test85.hs
new file mode 100644
index 0000000..f097653
--- /dev/null
+++ b/data/Test85.hs
@@ -0,0 +1 @@
+func (x :+: xr) = x
diff --git a/data/Test86.hs b/data/Test86.hs
new file mode 100644
index 0000000..f5eccc0
--- /dev/null
+++ b/data/Test86.hs
@@ -0,0 +1 @@
+func (x `Foo` xr) = x
diff --git a/data/Test87.hs b/data/Test87.hs
new file mode 100644
index 0000000..5a64709
--- /dev/null
+++ b/data/Test87.hs
@@ -0,0 +1 @@
+func | True = x
diff --git a/data/Test88.hs b/data/Test88.hs
new file mode 100644
index 0000000..ca71136
--- /dev/null
+++ b/data/Test88.hs
@@ -0,0 +1,2 @@
+func x | x = simple expression
+ | otherwise = 0
diff --git a/data/Test89.hs b/data/Test89.hs
new file mode 100644
index 0000000..c18a534
--- /dev/null
+++ b/data/Test89.hs
@@ -0,0 +1,3 @@
+func x
+ | a somewhat longer guard x = "and a somewhat longer expession that does not"
+ | otherwise = "fit without putting the guards in new lines"
diff --git a/data/Test9.hs b/data/Test9.hs
new file mode 100644
index 0000000..1b64914
--- /dev/null
+++ b/data/Test9.hs
@@ -0,0 +1,5 @@
+func
+ :: ( lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
+ -> lakjsdlkjasldkj
+ -> lakjsdlkjasldkj
+ )
diff --git a/data/Test90.hs b/data/Test90.hs
new file mode 100644
index 0000000..6f9ef8f
--- /dev/null
+++ b/data/Test90.hs
@@ -0,0 +1,7 @@
+func x
+ | very long guard, another rather long guard that refers to x = nontrivial
+ expression
+ foo
+ bar
+ alsdkjlasdjlasj
+ | otherwise = 0
diff --git a/data/Test91.hs b/data/Test91.hs
new file mode 100644
index 0000000..9256c3f
--- /dev/null
+++ b/data/Test91.hs
@@ -0,0 +1,5 @@
+func x
+ | very long guard, another rather long guard that refers to x
+ = nontrivialexpression foo bar alsdkjlasdjlasj
+ | otherwise
+ = 0
diff --git a/data/Test92.hs b/data/Test92.hs
new file mode 100644
index 0000000..289aa8b
--- /dev/null
+++ b/data/Test92.hs
@@ -0,0 +1,6 @@
+func x
+ | very loooooooooooooooooooooooooooooong guard
+ , another rather long guard that refers to x
+ = nontrivial expression foo bar alsdkjlasdjlasj
+ | otherwise
+ = 0
diff --git a/data/Test93.hs b/data/Test93.hs
new file mode 100644
index 0000000..48053a4
--- /dev/null
+++ b/data/Test93.hs
@@ -0,0 +1,2 @@
+func = x
+describe "infix op" $ do
diff --git a/data/Test94.hs b/data/Test94.hs
new file mode 100644
index 0000000..aa1fd8f
--- /dev/null
+++ b/data/Test94.hs
@@ -0,0 +1 @@
+func = x + x
diff --git a/data/Test95.hs b/data/Test95.hs
new file mode 100644
index 0000000..2d99eaf
--- /dev/null
+++ b/data/Test95.hs
@@ -0,0 +1,3 @@
+func =
+ mweroiuxlskdfjlksjdflkjsdfljksldkjflkjsdflkj
+ + mweroiuxlskdfjlksjdflkjsdfljksldkjflkjsdflkj
diff --git a/data/Test96.hs b/data/Test96.hs
new file mode 100644
index 0000000..d9a2015
--- /dev/null
+++ b/data/Test96.hs
@@ -0,0 +1,4 @@
+func =
+ mweroiuxlskdfjlksjdflkjsdfljksldkjflkjsdflkj
+ + mweroiuxlskdfjlksj
+ + mweroiuxlskdfjlksj
diff --git a/data/Test97.hs b/data/Test97.hs
new file mode 100644
index 0000000..094383e
--- /dev/null
+++ b/data/Test97.hs
@@ -0,0 +1,4 @@
+func =
+ mweroiuxlskdfjlksj
+ + mweroiuxlskdfjlksj
+ + mweroiuxlskdfjlksjdflkjsdfljksldkjflkjsdflkj
diff --git a/data/Test98.hs b/data/Test98.hs
new file mode 100644
index 0000000..cc29546
--- /dev/null
+++ b/data/Test98.hs
@@ -0,0 +1,5 @@
+func = 1
+func = "abc"
+func = 1.1e5
+func = 'x'
+func = 981409823458910394810928414192837123987123987123
diff --git a/data/Test99.hs b/data/Test99.hs
new file mode 100644
index 0000000..efcec60
--- /dev/null
+++ b/data/Test99.hs
@@ -0,0 +1,2 @@
+func = \x -> abc
+describe "app" $ do
diff --git a/data/brittany.yaml b/data/brittany.yaml
new file mode 100644
index 0000000..b9b9aab
--- /dev/null
+++ b/data/brittany.yaml
@@ -0,0 +1,4 @@
+conf_layout:
+ lconfig_allowSingleLineExportList: true
+ lconfig_importAsColumn: 60
+ lconfig_importColumn: 60
diff --git a/default.nix b/default.nix
deleted file mode 100644
index ed3dcca..0000000
--- a/default.nix
+++ /dev/null
@@ -1,18 +0,0 @@
-{ nixpkgsSrc ? builtins.fetchTarball {
- url =
- "https://github.com/nixos/nixpkgs/archive/069f183f16c3ea5d4b6e7625433b92eba77534f7.tar.gz"; # nixos-unstable
- sha256 = "1by9rqvr2k6iz2yipf89yaj254yicpwq384ijgyy8p71lfxbbww2";
-}, pkgs ? import nixpkgsSrc { }, compiler ? null, forShell ? pkgs.lib.inNixShell
-}:
-
-let
- haskellPackages = if compiler == null then
- pkgs.haskellPackages
- else
- pkgs.haskell.packages.${compiler};
-
-in haskellPackages.developPackage {
- name = "brittany";
- root = pkgs.nix-gitignore.gitignoreSource [ ] ./.;
- returnShellEnv = forShell;
-}
diff --git a/src-brittany/Main.hs b/source/executable/Main.hs
similarity index 84%
rename from src-brittany/Main.hs
rename to source/executable/Main.hs
index 0312f6b..7a5ae94 100644
--- a/src-brittany/Main.hs
+++ b/source/executable/Main.hs
@@ -1,5 +1,3 @@
-module Main where
-
import qualified Language.Haskell.Brittany.Main as BrittanyMain
main :: IO ()
diff --git a/src/Language/Haskell/Brittany.hs b/source/library/Language/Haskell/Brittany.hs
similarity index 55%
rename from src/Language/Haskell/Brittany.hs
rename to source/library/Language/Haskell/Brittany.hs
index 9d45dde..a2726c8 100644
--- a/src/Language/Haskell/Brittany.hs
+++ b/source/library/Language/Haskell/Brittany.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE NoImplicitPrelude #-}
module Language.Haskell.Brittany
( parsePrintModule
@@ -16,15 +16,9 @@ module Language.Haskell.Brittany
, CForwardOptions(..)
, CPreProcessorConfig(..)
, BrittanyError(..)
- )
-where
-
-
-
-#include "prelude.inc"
-
-import Language.Haskell.Brittany.Internal
-import Language.Haskell.Brittany.Internal.Types
-import Language.Haskell.Brittany.Internal.Config.Types
-import Language.Haskell.Brittany.Internal.Config
+ ) where
+import Language.Haskell.Brittany.Internal
+import Language.Haskell.Brittany.Internal.Config
+import Language.Haskell.Brittany.Internal.Config.Types
+import Language.Haskell.Brittany.Internal.Types
diff --git a/src/Language/Haskell/Brittany/Internal.hs b/source/library/Language/Haskell/Brittany/Internal.hs
similarity index 84%
rename from src/Language/Haskell/Brittany/Internal.hs
rename to source/library/Language/Haskell/Brittany/Internal.hs
index 8489136..456ef4a 100644
--- a/src/Language/Haskell/Brittany/Internal.hs
+++ b/source/library/Language/Haskell/Brittany/Internal.hs
@@ -1,4 +1,6 @@
-{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE ScopedTypeVariables #-}
module Language.Haskell.Brittany.Internal
( parsePrintModule
@@ -10,67 +12,50 @@ module Language.Haskell.Brittany.Internal
, parseModuleFromString
, extractCommentConfigs
, getTopLevelDeclNameMap
- )
-where
+ ) where
-
-
-#include "prelude.inc"
-
--- brittany { lconfig_importAsColumn: 60, lconfig_importColumn: 60 }
-import qualified Language.Haskell.GHC.ExactPrint as ExactPrint
-import qualified Language.Haskell.GHC.ExactPrint.Types as ExactPrint
-import qualified Language.Haskell.GHC.ExactPrint.Parsers as ExactPrint.Parsers
-
-import Data.Data
-import Control.Monad.Trans.Except
-import Data.HList.HList
-import qualified Data.Yaml
+import Control.Monad.Trans.Except
+import qualified Control.Monad.Trans.MultiRWS.Strict as MultiRWSS
import qualified Data.ByteString.Char8
-import Data.CZipWith
-import qualified UI.Butcher.Monadic as Butcher
-
-import qualified Data.Text.Lazy.Builder as Text.Builder
-
-import Language.Haskell.Brittany.Internal.Types
-import Language.Haskell.Brittany.Internal.Config.Types
-import Language.Haskell.Brittany.Internal.Config
-import Language.Haskell.Brittany.Internal.LayouterBasics
-
-import Language.Haskell.Brittany.Internal.Layouters.Type
-import Language.Haskell.Brittany.Internal.Layouters.Decl
-import Language.Haskell.Brittany.Internal.Layouters.Module
-import Language.Haskell.Brittany.Internal.Utils
-import Language.Haskell.Brittany.Internal.Backend
-import Language.Haskell.Brittany.Internal.BackendUtils
-import Language.Haskell.Brittany.Internal.ExactPrintUtils
-
-import Language.Haskell.Brittany.Internal.Transformations.Alt
-import Language.Haskell.Brittany.Internal.Transformations.Floating
-import Language.Haskell.Brittany.Internal.Transformations.Par
-import Language.Haskell.Brittany.Internal.Transformations.Columns
-import Language.Haskell.Brittany.Internal.Transformations.Indent
-
-import qualified GHC as GHC
- hiding ( parseModule )
-import ApiAnnotation ( AnnKeywordId(..) )
-import GHC ( Located
- , runGhc
- , GenLocated(L)
- , moduleNameString
- )
-import RdrName ( RdrName(..) )
-import SrcLoc ( SrcSpan )
-#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
-import GHC.Hs
-import Bag
-#else
-import HsSyn
-#endif
-import qualified DynFlags as GHC
-import qualified GHC.LanguageExtensions.Type as GHC
-
-import Data.Char ( isSpace )
+import Data.CZipWith
+import Data.Char (isSpace)
+import Data.HList.HList
+import qualified Data.Map as Map
+import qualified Data.Maybe
+import qualified Data.Semigroup as Semigroup
+import qualified Data.Sequence as Seq
+import qualified Data.Text as Text
+import qualified Data.Text.Lazy as TextL
+import qualified Data.Text.Lazy.Builder as Text.Builder
+import qualified Data.Yaml
+import qualified GHC hiding (parseModule)
+import GHC (GenLocated(L))
+import qualified GHC.Driver.Session as GHC
+import GHC.Hs
+import qualified GHC.LanguageExtensions.Type as GHC
+import qualified GHC.OldList as List
+import GHC.Parser.Annotation (AnnKeywordId(..))
+import GHC.Types.SrcLoc (SrcSpan)
+import Language.Haskell.Brittany.Internal.Backend
+import Language.Haskell.Brittany.Internal.BackendUtils
+import Language.Haskell.Brittany.Internal.Config
+import Language.Haskell.Brittany.Internal.Config.Types
+import Language.Haskell.Brittany.Internal.ExactPrintUtils
+import Language.Haskell.Brittany.Internal.LayouterBasics
+import Language.Haskell.Brittany.Internal.Layouters.Decl
+import Language.Haskell.Brittany.Internal.Layouters.Module
+import Language.Haskell.Brittany.Internal.Prelude
+import Language.Haskell.Brittany.Internal.PreludeUtils
+import Language.Haskell.Brittany.Internal.Transformations.Alt
+import Language.Haskell.Brittany.Internal.Transformations.Columns
+import Language.Haskell.Brittany.Internal.Transformations.Floating
+import Language.Haskell.Brittany.Internal.Transformations.Indent
+import Language.Haskell.Brittany.Internal.Transformations.Par
+import Language.Haskell.Brittany.Internal.Types
+import Language.Haskell.Brittany.Internal.Utils
+import qualified Language.Haskell.GHC.ExactPrint as ExactPrint
+import qualified Language.Haskell.GHC.ExactPrint.Types as ExactPrint
+import qualified UI.Butcher.Monadic as Butcher
@@ -83,7 +68,7 @@ data InlineConfigTarget
extractCommentConfigs
:: ExactPrint.Anns
-> TopLevelDeclNameMap
- -> Either (String, String) (CConfig Option, PerItemConfig)
+ -> Either (String, String) (CConfig Maybe, PerItemConfig)
extractCommentConfigs anns (TopLevelDeclNameMap declNameMap) = do
let
commentLiness =
@@ -129,7 +114,7 @@ extractCommentConfigs anns (TopLevelDeclNameMap declNameMap) = do
, \s -> "{" `isPrefixOf` dropWhile (== ' ') s
, Butcher.addCmdPart (Butcher.varPartDesc "yaml-config-document")
$ fmap (\lconf -> (mempty { _conf_layout = lconf }, ""))
- . either (\_ -> Nothing) Just
+ . either (const Nothing) Just
. Data.Yaml.decodeEither'
. Data.ByteString.Char8.pack
-- TODO: use some proper utf8 encoder instead?
@@ -226,7 +211,7 @@ extractCommentConfigs anns (TopLevelDeclNameMap declNameMap) = do
getTopLevelDeclNameMap :: GHC.ParsedSource -> TopLevelDeclNameMap
-getTopLevelDeclNameMap (L _ (HsModule _name _exports _ decls _ _)) =
+getTopLevelDeclNameMap (L _ (HsModule _ _name _exports _ decls _ _)) =
TopLevelDeclNameMap $ Map.fromList
[ (ExactPrint.mkAnnKey decl, name)
| decl <- decls
@@ -298,7 +283,7 @@ parsePrintModule configWithDebugs inputText = runExceptT $ do
pure $ if hackAroundIncludes
then
( ews
- , TextL.intercalate (TextL.pack "\n") $ fmap hackF $ TextL.splitOn
+ , TextL.intercalate (TextL.pack "\n") $ hackF <$> TextL.splitOn
(TextL.pack "\n")
outRaw
)
@@ -310,11 +295,9 @@ parsePrintModule configWithDebugs inputText = runExceptT $ do
customErrOrder ErrorUnknownNode{} = 3
customErrOrder ErrorMacroConfig{} = 5
let hasErrors =
- case
- moduleConfig & _conf_errorHandling & _econf_Werror & confUnpack
- of
- False -> 0 < maximum (-1 : fmap customErrOrder errsWarns)
- True -> not $ null errsWarns
+ if moduleConfig & _conf_errorHandling & _econf_Werror & confUnpack
+ then not $ null errsWarns
+ else 0 < maximum (-1 : fmap customErrOrder errsWarns)
if hasErrors
then throwE $ errsWarns
else pure $ TextL.toStrict outputTextL
@@ -383,14 +366,14 @@ pPrintModuleAndCheck conf inlineConf anns parsedModule = do
parsePrintModuleTests :: Config -> String -> Text -> IO (Either String Text)
parsePrintModuleTests conf filename input = do
let inputStr = Text.unpack input
- parseResult <- ExactPrint.Parsers.parseModuleFromString filename inputStr
+ parseResult <- parseModuleFromString
+ (conf & _conf_forward & _options_ghc & runIdentity)
+ filename
+ (const . pure $ Right ())
+ inputStr
case parseResult of
-#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
- Left err -> return $ Left $ "parsing error: " ++ show (bagToList (show <$> err))
-#else
- Left (_ , s ) -> return $ Left $ "parsing error: " ++ s
-#endif
- Right (anns, parsedModule) -> runExceptT $ do
+ Left err -> return $ Left err
+ Right (anns, parsedModule, _) -> runExceptT $ do
(inlineConf, perItemConf) <-
case extractCommentConfigs anns (getTopLevelDeclNameMap parsedModule) of
Left err -> throwE $ "error in inline config: " ++ show err
@@ -418,7 +401,6 @@ parsePrintModuleTests conf filename input = do
ErrorOutputCheck -> "Output is not syntactically valid."
in throwE $ "pretty printing error(s):\n" ++ List.unlines errStrs
-
-- this approach would for if there was a pure GHC.parseDynamicFilePragma.
-- Unfortunately that does not exist yet, so we cannot provide a nominally
-- pure interface.
@@ -460,8 +442,16 @@ toLocal conf anns m = do
MultiRWSS.mGetRawW >>= \w -> MultiRWSS.mPutRawW (w `mappend` write)
pure x
-ppModule :: GenLocated SrcSpan (HsModule GhcPs) -> PPM ()
-ppModule lmod@(L _loc _m@(HsModule _name _exports _ decls _ _)) = do
+ppModule :: GenLocated SrcSpan HsModule -> PPM ()
+ppModule lmod@(L _loc _m@(HsModule _ _name _exports _ decls _ _)) = do
+ defaultAnns <- do
+ anns <- mAsk
+ let annKey = ExactPrint.mkAnnKey lmod
+ let annMap = Map.findWithDefault Map.empty annKey anns
+ let isEof = (== ExactPrint.AnnEofPos)
+ let overAnnsDP f a = a { ExactPrint.annsDP = f $ ExactPrint.annsDP a }
+ pure $ fmap (overAnnsDP . filter $ isEof . fst) annMap
+
post <- ppPreamble lmod
decls `forM_` \decl -> do
let declAnnKey = ExactPrint.mkAnnKey decl
@@ -471,7 +461,9 @@ ppModule lmod@(L _loc _m@(HsModule _name _exports _ decls _ _)) = do
let mBindingConfs =
declBindingNames <&> \n -> Map.lookup n $ _icd_perBinding inlineConf
filteredAnns <- mAsk
- <&> \annMap -> Map.findWithDefault Map.empty declAnnKey annMap
+ <&> \annMap ->
+ Map.union defaultAnns $
+ Map.findWithDefault Map.empty declAnnKey annMap
traceIfDumpConf "bridoc annotations filtered/transformed"
_dconf_dump_annotations
@@ -505,10 +497,10 @@ ppModule lmod@(L _loc _m@(HsModule _name _exports _ decls _ _)) = do
(ExactPrint.AnnComment (ExactPrint.Comment cmStr _ _), l) -> do
ppmMoveToExactLoc l
mTell $ Text.Builder.fromString cmStr
- (ExactPrint.G AnnEofPos, (ExactPrint.DP (eofZ, eofX))) ->
+ (ExactPrint.AnnEofPos, (ExactPrint.DP (eofZ, eofX))) ->
let folder (acc, _) (kw, ExactPrint.DP (y, x)) = case kw of
ExactPrint.AnnComment cm
- | GHC.RealSrcSpan span <- ExactPrint.commentIdentifier cm
+ | span <- ExactPrint.commentIdentifier cm
-> ( acc + y + GHC.srcSpanEndLine span - GHC.srcSpanStartLine span
, x + GHC.srcSpanEndCol span - GHC.srcSpanStartCol span
)
@@ -520,16 +512,16 @@ ppModule lmod@(L _loc _m@(HsModule _name _exports _ decls _ _)) = do
getDeclBindingNames :: LHsDecl GhcPs -> [String]
getDeclBindingNames (L _ decl) = case decl of
SigD _ (TypeSig _ ns _) -> ns <&> \(L _ n) -> Text.unpack (rdrNameToText n)
- ValD _ (FunBind _ (L _ n) _ _ _) -> [Text.unpack $ rdrNameToText n]
+ ValD _ (FunBind _ (L _ n) _ _) -> [Text.unpack $ rdrNameToText n]
_ -> []
-- Prints the information associated with the module annotation
-- This includes the imports
ppPreamble
- :: GenLocated SrcSpan (HsModule GhcPs)
+ :: GenLocated SrcSpan HsModule
-> PPM [(ExactPrint.KeywordId, ExactPrint.DeltaPos)]
-ppPreamble lmod@(L loc m@(HsModule _ _ _ _ _ _)) = do
+ppPreamble lmod@(L loc m@HsModule{}) = do
filteredAnns <- mAsk <&> \annMap ->
Map.findWithDefault Map.empty (ExactPrint.mkAnnKey lmod) annMap
-- Since ghc-exactprint adds annotations following (implicit)
@@ -550,7 +542,7 @@ ppPreamble lmod@(L loc m@(HsModule _ _ _ _ _ _)) = do
modAnnsDp = ExactPrint.annsDP mAnn
isWhere (ExactPrint.G AnnWhere) = True
isWhere _ = False
- isEof (ExactPrint.G AnnEofPos) = True
+ isEof (ExactPrint.AnnEofPos) = True
isEof _ = False
whereInd = List.findIndex (isWhere . fst) modAnnsDp
eofInd = List.findIndex (isEof . fst) modAnnsDp
@@ -585,7 +577,7 @@ _sigHead = \case
_bindHead :: HsBind GhcPs -> String
_bindHead = \case
- FunBind _ fId _ _ [] -> "FunBind " ++ (Text.unpack $ lrdrNameToText $ fId)
+ FunBind _ fId _ [] -> "FunBind " ++ (Text.unpack $ lrdrNameToText $ fId)
PatBind _ _pat _ ([], []) -> "PatBind smth"
_ -> "unknown bind"
diff --git a/src/Language/Haskell/Brittany/Internal/Backend.hs b/source/library/Language/Haskell/Brittany/Internal/Backend.hs
similarity index 94%
rename from src/Language/Haskell/Brittany/Internal/Backend.hs
rename to source/library/Language/Haskell/Brittany/Internal/Backend.hs
index 234d55e..6cfbaf3 100644
--- a/src/Language/Haskell/Brittany/Internal/Backend.hs
+++ b/source/library/Language/Haskell/Brittany/Internal/Backend.hs
@@ -1,41 +1,33 @@
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE ScopedTypeVariables #-}
-module Language.Haskell.Brittany.Internal.Backend
- ( layoutBriDocM
- )
-where
-
-
-
-#include "prelude.inc"
-
-import qualified Language.Haskell.GHC.ExactPrint as ExactPrint
-import qualified Language.Haskell.GHC.ExactPrint.Annotate as ExactPrint.Annotate
-import qualified Language.Haskell.GHC.ExactPrint.Types as ExactPrint.Types
-import Language.Haskell.GHC.ExactPrint.Types ( AnnKey, Annotation )
-
-import GHC ( AnnKeywordId (..) )
-
-import Language.Haskell.Brittany.Internal.LayouterBasics
-import Language.Haskell.Brittany.Internal.BackendUtils
-import Language.Haskell.Brittany.Internal.Utils
-import Language.Haskell.Brittany.Internal.Config.Types
-import Language.Haskell.Brittany.Internal.Types
-
+module Language.Haskell.Brittany.Internal.Backend where
+import qualified Control.Monad.Trans.State.Strict as StateS
+import qualified Data.Either as Either
+import qualified Data.Foldable as Foldable
+import qualified Data.IntMap.Lazy as IntMapL
+import qualified Data.IntMap.Strict as IntMapS
+import qualified Data.Map as Map
+import qualified Data.Maybe as Maybe
+import qualified Data.Semigroup as Semigroup
+import qualified Data.Sequence as Seq
+import qualified Data.Set as Set
+import qualified Data.Text as Text
import qualified Data.Text.Lazy.Builder as Text.Builder
-
-
-import Data.HList.ContainsType
-
-import Control.Monad.Extra ( whenM )
-
-import qualified Control.Monad.Trans.Writer.Strict as WriterS
+import qualified GHC.OldList as List
+import Language.Haskell.Brittany.Internal.BackendUtils
+import Language.Haskell.Brittany.Internal.Config.Types
+import Language.Haskell.Brittany.Internal.LayouterBasics
+import Language.Haskell.Brittany.Internal.Prelude
+import Language.Haskell.Brittany.Internal.PreludeUtils
+import Language.Haskell.Brittany.Internal.Types
+import Language.Haskell.Brittany.Internal.Utils
+import qualified Language.Haskell.GHC.ExactPrint as ExactPrint
+import qualified Language.Haskell.GHC.ExactPrint.Types as ExactPrint.Types
@@ -175,7 +167,7 @@ layoutBriDocM = \case
-- layoutResetSepSpace
priors
`forM_` \(ExactPrint.Types.Comment comment _ _, ExactPrint.Types.DP (y, x)) ->
- when (not $ comment == "(" || comment == ")") $ do
+ when (comment /= "(" && comment /= ")") $ do
let commentLines = Text.lines $ Text.pack $ comment
case comment of
('#':_) -> layoutMoveToCommentPos y (-999) (length commentLines)
@@ -195,7 +187,7 @@ layoutBriDocM = \case
let m = _lstate_comments state
let mAnn = ExactPrint.annsDP <$> Map.lookup annKey m
let mToSpan = case mAnn of
- Just anns | keyword == Nothing -> Just anns
+ Just anns | Maybe.isNothing keyword -> Just anns
Just ((ExactPrint.Types.G kw1, _):annR) | keyword == Just kw1 -> Just
annR
_ -> Nothing
@@ -216,7 +208,7 @@ layoutBriDocM = \case
Nothing -> pure ()
Just comments -> do
comments `forM_` \(ExactPrint.Types.Comment comment _ _, ExactPrint.Types.DP (y, x)) ->
- when (not $ comment == "(" || comment == ")") $ do
+ when (comment /= "(" && comment /= ")") $ do
let commentLines = Text.lines $ Text.pack $ comment
-- evil hack for CPP:
case comment of
@@ -233,7 +225,7 @@ layoutBriDocM = \case
state <- mGet
let m = _lstate_comments state
pure $ Map.lookup annKey m
- let mComments = nonEmpty =<< extractAllComments <$> annMay
+ let mComments = nonEmpty . extractAllComments =<< annMay
let semiCount = length [ ()
| Just ann <- [ annMay ]
, (ExactPrint.Types.AnnSemiSep, _) <- ExactPrint.Types.annsDP ann
@@ -256,10 +248,10 @@ layoutBriDocM = \case
case mComments of
Nothing -> do
when shouldAddSemicolonNewlines $ do
- [1..semiCount] `forM_` \_ -> layoutWriteNewline
+ [1..semiCount] `forM_` const layoutWriteNewline
Just comments -> do
comments `forM_` \(ExactPrint.Types.Comment comment _ _, ExactPrint.Types.DP (y, x)) ->
- when (not $ comment == "(" || comment == ")") $ do
+ when (comment /= "(" && comment /= ")") $ do
let commentLines = Text.lines $ Text.pack comment
case comment of
('#':_) -> layoutMoveToCommentPos y (-999) 1
@@ -355,13 +347,13 @@ briDocIsMultiLine briDoc = rec briDoc
BDBaseYPop bd -> rec bd
BDIndentLevelPushCur bd -> rec bd
BDIndentLevelPop bd -> rec bd
- BDPar _ _ _ -> True
+ BDPar{} -> True
BDAlt{} -> error "briDocIsMultiLine BDAlt"
BDForceMultiline _ -> True
BDForceSingleline bd -> rec bd
BDForwardLineMode bd -> rec bd
BDExternal _ _ _ t | [_] <- Text.lines t -> False
- BDExternal _ _ _ _ -> True
+ BDExternal{} -> True
BDPlain t | [_] <- Text.lines t -> False
BDPlain _ -> True
BDAnnotationPrior _ bd -> rec bd
@@ -457,7 +449,7 @@ alignColsLines bridocs = do -- colInfos `forM_` \colInfo -> do
-- tellDebugMess ("alignColsLines: at " ++ take 100 (show $ briDocToDoc $ head bridocs))
curX <- do
state <- mGet
- return $ either id (const 0) (_lstate_curYOrAddNewline state) + fromMaybe
+ return $ Either.fromLeft 0 (_lstate_curYOrAddNewline state) + fromMaybe
0
(_lstate_addSepSpace state)
colMax <- mAsk <&> _conf_layout .> _lconfig_cols .> confUnpack
@@ -547,8 +539,8 @@ alignColsLines bridocs = do -- colInfos `forM_` \colInfo -> do
-- personal preference to not break alignment for those, even if
-- multiline. Really, this should be configurable.. (TODO)
shouldBreakAfter :: BriDoc -> Bool
- shouldBreakAfter bd = if alignBreak
- then briDocIsMultiLine bd && case bd of
+ shouldBreakAfter bd = alignBreak &&
+ briDocIsMultiLine bd && case bd of
(BDCols ColTyOpPrefix _) -> False
(BDCols ColPatternsFuncPrefix _) -> True
(BDCols ColPatternsFuncInfix _) -> True
@@ -569,7 +561,6 @@ alignColsLines bridocs = do -- colInfos `forM_` \colInfo -> do
(BDCols ColTuples _) -> False
(BDCols ColOpPrefix _) -> False
_ -> True
- else False
mergeInfoBriDoc
:: Bool
@@ -648,9 +639,7 @@ processInfo maxSpace m = \case
curX <- do
state <- mGet
-- tellDebugMess ("processInfo: " ++ show (_lstate_curYOrAddNewline state) ++ " - " ++ show ((_lstate_addSepSpace state)))
- let spaceAdd = case _lstate_addSepSpace state of
- Nothing -> 0
- Just i -> i
+ let spaceAdd = fromMaybe 0 $ _lstate_addSepSpace state
return $ case _lstate_curYOrAddNewline state of
Left i -> case _lstate_commentCol state of
Nothing -> spaceAdd + i
@@ -659,7 +648,7 @@ processInfo maxSpace m = \case
let colMax = min colMaxConf (curX + maxSpace)
-- tellDebugMess $ show curX
let Just (ratio, maxCols1, _colss) = IntMapS.lookup ind m
- let maxCols2 = list <&> \e -> case e of
+ let maxCols2 = list <&> \case
(_, ColInfo i _ _) ->
let Just (_, ms, _) = IntMapS.lookup i m in sum ms
(l, _) -> l
@@ -716,4 +705,3 @@ processInfoIgnore = \case
ColInfoStart -> error "should not happen (TM)"
ColInfoNo doc -> layoutBriDocM doc
ColInfo _ _ list -> list `forM_` (snd .> processInfoIgnore)
-
diff --git a/src/Language/Haskell/Brittany/Internal/BackendUtils.hs b/source/library/Language/Haskell/Brittany/Internal/BackendUtils.hs
similarity index 79%
rename from src/Language/Haskell/Brittany/Internal/BackendUtils.hs
rename to source/library/Language/Haskell/Brittany/Internal/BackendUtils.hs
index 1253f1a..919a323 100644
--- a/src/Language/Haskell/Brittany/Internal/BackendUtils.hs
+++ b/source/library/Language/Haskell/Brittany/Internal/BackendUtils.hs
@@ -1,76 +1,37 @@
-#define INSERTTRACES 0
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE TypeApplications #-}
-#if !INSERTTRACES
-{-# OPTIONS_GHC -Wno-redundant-constraints #-}
-#endif
-
-module Language.Haskell.Brittany.Internal.BackendUtils
- ( layoutWriteAppend
- , layoutWriteAppendMultiline
- , layoutWriteNewlineBlock
- , layoutWriteNewline
- , layoutWriteEnsureNewlineBlock
- , layoutWriteEnsureBlock
- , layoutWithAddBaseCol
- , layoutWithAddBaseColBlock
- , layoutWithAddBaseColN
- , layoutWithAddBaseColNBlock
- , layoutBaseYPushCur
- , layoutBaseYPop
- , layoutIndentLevelPushCur
- , layoutIndentLevelPop
- , layoutWriteEnsureAbsoluteN
- , layoutAddSepSpace
- , layoutSetCommentCol
- , layoutMoveToCommentPos
- , layoutIndentRestorePostComment
- , moveToExactAnn
- , moveToY
- , ppmMoveToExactLoc
- , layoutWritePriorComments
- , layoutWritePostComments
- , layoutRemoveIndentLevelLinger
- )
-where
-
-
-#include "prelude.inc"
-
-import Language.Haskell.Brittany.Internal.Types
-import Language.Haskell.Brittany.Internal.Config.Types
-import Language.Haskell.GHC.ExactPrint.Types ( AnnKey
- , Annotation
- , KeywordId
- )
+module Language.Haskell.Brittany.Internal.BackendUtils where
+import qualified Data.Data
+import qualified Data.Either
+import qualified Data.Map as Map
+import qualified Data.Maybe
+import qualified Data.Semigroup as Semigroup
+import qualified Data.Text as Text
import qualified Data.Text.Lazy.Builder as Text.Builder
+import GHC (Located)
+import qualified GHC.OldList as List
+import Language.Haskell.Brittany.Internal.Config.Types
+import Language.Haskell.Brittany.Internal.Prelude
+import Language.Haskell.Brittany.Internal.PreludeUtils
+import Language.Haskell.Brittany.Internal.Types
+import Language.Haskell.Brittany.Internal.Utils
+import Language.Haskell.GHC.ExactPrint.Types (AnnKey, Annotation)
import qualified Language.Haskell.GHC.ExactPrint.Types as ExactPrint
-import Language.Haskell.Brittany.Internal.Utils
-
-import GHC ( Located, GenLocated(L), moduleNameString )
traceLocal
- :: (MonadMultiState LayoutState m, MonadMultiWriter (Seq String) m, Show a)
+ :: (MonadMultiState LayoutState m)
=> a
-> m ()
-#if INSERTTRACES
-traceLocal x = do
- mGet >>= tellDebugMessShow @LayoutState
- tellDebugMessShow x
-#else
traceLocal _ = return ()
-#endif
layoutWriteAppend
:: ( MonadMultiWriter Text.Builder.Builder m
, MonadMultiState LayoutState m
- , MonadMultiWriter (Seq String) m
)
=> Text
-> m ()
@@ -79,21 +40,10 @@ layoutWriteAppend t = do
state <- mGet
case _lstate_curYOrAddNewline state of
Right i -> do
-#if INSERTTRACES
- tellDebugMessShow (" inserted newlines: ", i)
-#endif
replicateM_ i $ mTell $ Text.Builder.fromString $ "\n"
Left{} -> do
-#if INSERTTRACES
- tellDebugMessShow (" inserted no newlines")
-#endif
return ()
- let spaces = case _lstate_addSepSpace state of
- Just i -> i
- Nothing -> 0
-#if INSERTTRACES
- tellDebugMessShow (" inserted spaces: ", spaces)
-#endif
+ let spaces = fromMaybe 0 $ _lstate_addSepSpace state
mTell $ Text.Builder.fromText $ Text.pack (replicate spaces ' ')
mTell $ Text.Builder.fromText $ t
mModify $ \s -> s
@@ -106,7 +56,6 @@ layoutWriteAppend t = do
layoutWriteAppendSpaces
:: ( MonadMultiWriter Text.Builder.Builder m
, MonadMultiState LayoutState m
- , MonadMultiWriter (Seq String) m
)
=> Int
-> m ()
@@ -121,7 +70,6 @@ layoutWriteAppendSpaces i = do
layoutWriteAppendMultiline
:: ( MonadMultiWriter Text.Builder.Builder m
, MonadMultiState LayoutState m
- , MonadMultiWriter (Seq String) m
)
=> [Text]
-> m ()
@@ -139,7 +87,6 @@ layoutWriteAppendMultiline ts = do
layoutWriteNewlineBlock
:: ( MonadMultiWriter Text.Builder.Builder m
, MonadMultiState LayoutState m
- , MonadMultiWriter (Seq String) m
)
=> m ()
layoutWriteNewlineBlock = do
@@ -159,12 +106,12 @@ layoutWriteNewlineBlock = do
-- mSet $ state
-- { _lstate_addSepSpace = Just
-- $ if isJust $ _lstate_addNewline state
--- then i
+-- then i
-- else _lstate_indLevelLinger state + i - _lstate_curY state
-- }
layoutSetCommentCol
- :: (MonadMultiState LayoutState m, MonadMultiWriter (Seq String) m) => m ()
+ :: (MonadMultiState LayoutState m) => m ()
layoutSetCommentCol = do
state <- mGet
let col = case _lstate_curYOrAddNewline state of
@@ -179,7 +126,6 @@ layoutSetCommentCol = do
layoutMoveToCommentPos
:: ( MonadMultiWriter Text.Builder.Builder m
, MonadMultiState LayoutState m
- , MonadMultiWriter (Seq String) m
)
=> Int
-> Int
@@ -212,7 +158,6 @@ layoutMoveToCommentPos y x commentLines = do
layoutWriteNewline
:: ( MonadMultiWriter Text.Builder.Builder m
, MonadMultiState LayoutState m
- , MonadMultiWriter (Seq String) m
)
=> m ()
layoutWriteNewline = do
@@ -232,7 +177,6 @@ _layoutResetCommentNewlines = do
layoutWriteEnsureNewlineBlock
:: ( MonadMultiWriter Text.Builder.Builder m
, MonadMultiState LayoutState m
- , MonadMultiWriter (Seq String) m
)
=> m ()
layoutWriteEnsureNewlineBlock = do
@@ -249,7 +193,6 @@ layoutWriteEnsureNewlineBlock = do
layoutWriteEnsureAbsoluteN
:: ( MonadMultiWriter Text.Builder.Builder m
, MonadMultiState LayoutState m
- , MonadMultiWriter (Seq String) m
)
=> Int
-> m ()
@@ -268,7 +211,7 @@ layoutWriteEnsureAbsoluteN n = do
}
layoutBaseYPushInternal
- :: (MonadMultiState LayoutState m, MonadMultiWriter (Seq String) m)
+ :: (MonadMultiState LayoutState m)
=> Int
-> m ()
layoutBaseYPushInternal i = do
@@ -276,13 +219,13 @@ layoutBaseYPushInternal i = do
mModify $ \s -> s { _lstate_baseYs = i : _lstate_baseYs s }
layoutBaseYPopInternal
- :: (MonadMultiState LayoutState m, MonadMultiWriter (Seq String) m) => m ()
+ :: (MonadMultiState LayoutState m) => m ()
layoutBaseYPopInternal = do
traceLocal ("layoutBaseYPopInternal")
mModify $ \s -> s { _lstate_baseYs = List.tail $ _lstate_baseYs s }
layoutIndentLevelPushInternal
- :: (MonadMultiState LayoutState m, MonadMultiWriter (Seq String) m)
+ :: (MonadMultiState LayoutState m)
=> Int
-> m ()
layoutIndentLevelPushInternal i = do
@@ -292,20 +235,15 @@ layoutIndentLevelPushInternal i = do
}
layoutIndentLevelPopInternal
- :: (MonadMultiState LayoutState m, MonadMultiWriter (Seq String) m) => m ()
+ :: (MonadMultiState LayoutState m) => m ()
layoutIndentLevelPopInternal = do
traceLocal ("layoutIndentLevelPopInternal")
mModify $ \s -> s { _lstate_indLevelLinger = lstate_indLevel s
, _lstate_indLevels = List.tail $ _lstate_indLevels s
}
-layoutRemoveIndentLevelLinger :: ( MonadMultiState LayoutState m
- , MonadMultiWriter (Seq String) m
- ) => m ()
+layoutRemoveIndentLevelLinger :: ( MonadMultiState LayoutState m) => m ()
layoutRemoveIndentLevelLinger = do
-#if INSERTTRACES
- tellDebugMessShow ("layoutRemoveIndentLevelLinger")
-#endif
mModify $ \s -> s { _lstate_indLevelLinger = lstate_indLevel s
}
@@ -313,14 +251,10 @@ layoutWithAddBaseCol
:: ( MonadMultiWriter Text.Builder.Builder m
, MonadMultiState LayoutState m
, MonadMultiReader Config m
- , MonadMultiWriter (Seq String) m
)
=> m ()
-> m ()
layoutWithAddBaseCol m = do
-#if INSERTTRACES
- tellDebugMessShow ("layoutWithAddBaseCol")
-#endif
amount <- mAsk <&> _conf_layout .> _lconfig_indentAmount .> confUnpack
state <- mGet
layoutBaseYPushInternal $ lstate_baseY state + amount
@@ -331,14 +265,10 @@ layoutWithAddBaseColBlock
:: ( MonadMultiWriter Text.Builder.Builder m
, MonadMultiState LayoutState m
, MonadMultiReader Config m
- , MonadMultiWriter (Seq String) m
)
=> m ()
-> m ()
layoutWithAddBaseColBlock m = do
-#if INSERTTRACES
- tellDebugMessShow ("layoutWithAddBaseColBlock")
-#endif
amount <- mAsk <&> _conf_layout .> _lconfig_indentAmount .> confUnpack
state <- mGet
layoutBaseYPushInternal $ lstate_baseY state + amount
@@ -349,7 +279,6 @@ layoutWithAddBaseColBlock m = do
layoutWithAddBaseColNBlock
:: ( MonadMultiWriter Text.Builder.Builder m
, MonadMultiState LayoutState m
- , MonadMultiWriter (Seq String) m
)
=> Int
-> m ()
@@ -365,7 +294,6 @@ layoutWithAddBaseColNBlock amount m = do
layoutWriteEnsureBlock
:: ( MonadMultiWriter Text.Builder.Builder m
, MonadMultiState LayoutState m
- , MonadMultiWriter (Seq String) m
)
=> m ()
layoutWriteEnsureBlock = do
@@ -384,22 +312,18 @@ layoutWriteEnsureBlock = do
layoutWithAddBaseColN
:: ( MonadMultiWriter Text.Builder.Builder m
, MonadMultiState LayoutState m
- , MonadMultiWriter (Seq String) m
)
=> Int
-> m ()
-> m ()
layoutWithAddBaseColN amount m = do
-#if INSERTTRACES
- tellDebugMessShow ("layoutWithAddBaseColN", amount)
-#endif
state <- mGet
layoutBaseYPushInternal $ lstate_baseY state + amount
m
layoutBaseYPopInternal
layoutBaseYPushCur
- :: (MonadMultiState LayoutState m, MonadMultiWriter (Seq String) m) => m ()
+ :: (MonadMultiState LayoutState m) => m ()
layoutBaseYPushCur = do
traceLocal ("layoutBaseYPushCur")
state <- mGet
@@ -412,13 +336,13 @@ layoutBaseYPushCur = do
Just cCol -> layoutBaseYPushInternal cCol
layoutBaseYPop
- :: (MonadMultiState LayoutState m, MonadMultiWriter (Seq String) m) => m ()
+ :: (MonadMultiState LayoutState m) => m ()
layoutBaseYPop = do
traceLocal ("layoutBaseYPop")
layoutBaseYPopInternal
layoutIndentLevelPushCur
- :: (MonadMultiState LayoutState m, MonadMultiWriter (Seq String) m) => m ()
+ :: (MonadMultiState LayoutState m) => m ()
layoutIndentLevelPushCur = do
traceLocal ("layoutIndentLevelPushCur")
state <- mGet
@@ -430,7 +354,7 @@ layoutIndentLevelPushCur = do
layoutIndentLevelPushInternal y
layoutIndentLevelPop
- :: (MonadMultiState LayoutState m, MonadMultiWriter (Seq String) m) => m ()
+ :: (MonadMultiState LayoutState m) => m ()
layoutIndentLevelPop = do
traceLocal ("layoutIndentLevelPop")
layoutIndentLevelPopInternal
@@ -440,13 +364,9 @@ layoutIndentLevelPop = do
-- make sense.
layoutRemoveIndentLevelLinger
-layoutAddSepSpace :: (MonadMultiState LayoutState m
- , MonadMultiWriter (Seq String) m)
+layoutAddSepSpace :: (MonadMultiState LayoutState m)
=> m ()
layoutAddSepSpace = do
-#if INSERTTRACES
- tellDebugMessShow ("layoutAddSepSpace")
-#endif
state <- mGet
mSet $ state
{ _lstate_addSepSpace = Just $ fromMaybe 1 $ _lstate_addSepSpace state }
@@ -457,7 +377,6 @@ moveToExactAnn
:: ( MonadMultiWriter Text.Builder.Builder m
, MonadMultiState LayoutState m
, MonadMultiReader (Map AnnKey Annotation) m
- , MonadMultiWriter (Seq String) m
)
=> AnnKey
-> m ()
@@ -508,7 +427,6 @@ layoutWritePriorComments
:: ( Data.Data.Data ast
, MonadMultiWriter Text.Builder.Builder m
, MonadMultiState LayoutState m
- , MonadMultiWriter (Seq String) m
)
=> Located ast
-> m ()
@@ -523,13 +441,10 @@ layoutWritePriorComments ast = do
Map.adjust (\ann -> ann { ExactPrint.annPriorComments = [] }) key anns
}
return mAnn
-#if INSERTTRACES
- tellDebugMessShow ("layoutWritePriorComments", ExactPrint.mkAnnKey ast, mAnn)
-#endif
case mAnn of
Nothing -> return ()
Just priors -> do
- when (not $ null priors) $ layoutSetCommentCol
+ unless (null priors) $ layoutSetCommentCol
priors `forM_` \( ExactPrint.Comment comment _ _
, ExactPrint.DP (x, y)
) -> do
@@ -543,8 +458,7 @@ layoutWritePriorComments ast = do
-- "..`annFollowingComments` are only added by AST transformations ..".
layoutWritePostComments :: (Data.Data.Data ast,
MonadMultiWriter Text.Builder.Builder m,
- MonadMultiState LayoutState m
- , MonadMultiWriter (Seq String) m)
+ MonadMultiState LayoutState m)
=> Located ast -> m ()
layoutWritePostComments ast = do
mAnn <- do
@@ -559,13 +473,10 @@ layoutWritePostComments ast = do
anns
}
return mAnn
-#if INSERTTRACES
- tellDebugMessShow ("layoutWritePostComments", ExactPrint.mkAnnKey ast, mAnn)
-#endif
case mAnn of
Nothing -> return ()
Just posts -> do
- when (not $ null posts) $ layoutSetCommentCol
+ unless (null posts) $ layoutSetCommentCol
posts `forM_` \( ExactPrint.Comment comment _ _
, ExactPrint.DP (x, y)
) -> do
@@ -577,16 +488,12 @@ layoutWritePostComments ast = do
layoutIndentRestorePostComment
:: ( MonadMultiState LayoutState m
, MonadMultiWriter Text.Builder.Builder m
- , MonadMultiWriter (Seq String) m
)
=> m ()
layoutIndentRestorePostComment = do
state <- mGet
let mCommentCol = _lstate_commentCol state
let eCurYAddNL = _lstate_curYOrAddNewline state
-#if INSERTTRACES
- tellDebugMessShow ("layoutIndentRestorePostComment", mCommentCol)
-#endif
mModify $ \s -> s { _lstate_commentCol = Nothing
, _lstate_commentNewlines = 0
}
@@ -604,7 +511,7 @@ layoutIndentRestorePostComment = do
-- layoutWritePriorCommentsRestore x = do
-- layoutWritePriorComments x
-- layoutIndentRestorePostComment
---
+--
-- layoutWritePostCommentsRestore :: (Data.Data.Data ast,
-- MonadMultiWriter Text.Builder.Builder m,
-- MonadMultiState LayoutState m
diff --git a/src/Language/Haskell/Brittany/Internal/Config.hs b/source/library/Language/Haskell/Brittany/Internal/Config.hs
similarity index 89%
rename from src/Language/Haskell/Brittany/Internal/Config.hs
rename to source/library/Language/Haskell/Brittany/Internal/Config.hs
index 520be3f..08d0fd4 100644
--- a/src/Language/Haskell/Brittany/Internal/Config.hs
+++ b/source/library/Language/Haskell/Brittany/Internal/Config.hs
@@ -1,50 +1,28 @@
-module Language.Haskell.Brittany.Internal.Config
- ( CConfig(..)
- , CDebugConfig(..)
- , CLayoutConfig(..)
- , DebugConfig
- , LayoutConfig
- , Config
- , cmdlineConfigParser
- , staticDefaultConfig
- , forwardOptionsSyntaxExtsEnabled
- , readConfig
- , userConfigPath
- , findLocalConfigPath
- , readConfigs
- , readConfigsWithUserConfig
- , writeDefaultConfig
- , showConfigYaml
- )
-where
+{-# LANGUAGE MonadComprehensions #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+module Language.Haskell.Brittany.Internal.Config where
-
-#include "prelude.inc"
-
-import Language.Haskell.Brittany.Internal.Types
-import Language.Haskell.Brittany.Internal.LayouterBasics
-
+import qualified Data.Bool as Bool
+import qualified Data.ByteString as ByteString
+import qualified Data.ByteString.Char8
+import Data.CZipWith
+import Data.Coerce (coerce)
+import qualified Data.List.NonEmpty as NonEmpty
+import qualified Data.Semigroup as Semigroup
import qualified Data.Yaml
-import Data.CZipWith
-
-import UI.Butcher.Monadic
-import Data.Monoid ( (<>) )
-
-import qualified System.Console.CmdArgs.Explicit
- as CmdArgs
-
-import Language.Haskell.Brittany.Internal.Config.Types
-import Language.Haskell.Brittany.Internal.Config.Types.Instances
-import Language.Haskell.Brittany.Internal.Utils
-
-import Data.Coerce ( Coercible
- , coerce
- )
-import qualified Data.List.NonEmpty as NonEmpty
-
-import qualified System.Directory as Directory
-import qualified System.FilePath.Posix as FilePath
+import qualified GHC.OldList as List
+import Language.Haskell.Brittany.Internal.Config.Types
+import Language.Haskell.Brittany.Internal.Config.Types.Instances ()
+import Language.Haskell.Brittany.Internal.Prelude
+import Language.Haskell.Brittany.Internal.PreludeUtils
+import Language.Haskell.Brittany.Internal.Utils
+import qualified System.Console.CmdArgs.Explicit as CmdArgs
+import qualified System.Directory
+import qualified System.Directory as Directory
+import qualified System.FilePath.Posix as FilePath
+import qualified System.IO
+import UI.Butcher.Monadic
-- brittany-next-binding { lconfig_indentPolicy: IndentPolicyLeft }
staticDefaultConfig :: Config
@@ -118,7 +96,7 @@ forwardOptionsSyntaxExtsEnabled = ForwardOptions
}
-- brittany-next-binding { lconfig_indentPolicy: IndentPolicyLeft, lconfig_cols: 200 }
-cmdlineConfigParser :: CmdParser Identity out (CConfig Option)
+cmdlineConfigParser :: CmdParser Identity out (CConfig Maybe)
cmdlineConfigParser = do
-- TODO: why does the default not trigger; ind never should be []!!
ind <- addFlagReadParams "" ["indent"] "AMOUNT" (flagHelpStr "spaces per indentation level")
@@ -196,10 +174,10 @@ cmdlineConfigParser = do
, _conf_obfuscate = wrapLast $ falseToNothing obfuscate
}
where
- falseToNothing = Option . Bool.bool Nothing (Just True)
- wrapLast :: Option a -> Option (Semigroup.Last a)
+ falseToNothing = Bool.bool Nothing (Just True)
+ wrapLast :: Maybe a -> Maybe (Semigroup.Last a)
wrapLast = fmap Semigroup.Last
- optionConcat :: (Semigroup.Semigroup (f a), Applicative f) => [a] -> Option (f a)
+ optionConcat :: (Semigroup.Semigroup (f a), Applicative f) => [a] -> Maybe (f a)
optionConcat = mconcat . fmap (pure . pure)
-- configParser :: Parser Config
@@ -230,7 +208,7 @@ cmdlineConfigParser = do
-- If the second parameter is True and the file does not exist, writes the
-- staticDefaultConfig to the file.
readConfig
- :: MonadIO m => System.IO.FilePath -> MaybeT m (Maybe (CConfig Option))
+ :: MonadIO m => System.IO.FilePath -> MaybeT m (Maybe (CConfig Maybe))
readConfig path = do
-- TODO: probably should catch IOErrors and then omit the existence check.
exists <- liftIO $ System.Directory.doesFileExist path
@@ -278,7 +256,7 @@ findLocalConfigPath dir = do
-- | Reads specified configs.
readConfigs
- :: CConfig Option -- ^ Explicit options, take highest priority
+ :: CConfig Maybe -- ^ Explicit options, take highest priority
-> [System.IO.FilePath] -- ^ List of config files to load and merge, highest priority first
-> MaybeT IO Config
readConfigs cmdlineConfig configPaths = do
@@ -290,7 +268,7 @@ readConfigs cmdlineConfig configPaths = do
-- | Reads provided configs
-- but also applies the user default configuration (with lowest priority)
readConfigsWithUserConfig
- :: CConfig Option -- ^ Explicit options, take highest priority
+ :: CConfig Maybe -- ^ Explicit options, take highest priority
-> [System.IO.FilePath] -- ^ List of config files to load and merge, highest priority first
-> MaybeT IO Config
readConfigsWithUserConfig cmdlineConfig configPaths = do
@@ -300,10 +278,9 @@ readConfigsWithUserConfig cmdlineConfig configPaths = do
writeDefaultConfig :: MonadIO m => System.IO.FilePath -> m ()
writeDefaultConfig path =
liftIO $ ByteString.writeFile path $ Data.Yaml.encode $ cMap
- (Option . Just . runIdentity)
+ (Just . runIdentity)
staticDefaultConfig
showConfigYaml :: Config -> String
showConfigYaml = Data.ByteString.Char8.unpack . Data.Yaml.encode . cMap
(\(Identity x) -> Just x)
-
diff --git a/src/Language/Haskell/Brittany/Internal/Config/Types.hs b/source/library/Language/Haskell/Brittany/Internal/Config/Types.hs
similarity index 88%
rename from src/Language/Haskell/Brittany/Internal/Config/Types.hs
rename to source/library/Language/Haskell/Brittany/Internal/Config/Types.hs
index c5d8eb0..bb7148d 100644
--- a/src/Language/Haskell/Brittany/Internal/Config/Types.hs
+++ b/source/library/Language/Haskell/Brittany/Internal/Config/Types.hs
@@ -1,31 +1,21 @@
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE StandaloneDeriving #-}
-{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TemplateHaskell #-}
-module Language.Haskell.Brittany.Internal.Config.Types
- ( module Language.Haskell.Brittany.Internal.Config.Types
- , cMap
- )
-where
-
-
-
-#include "prelude.inc"
-
-import Data.Yaml
-import qualified Data.Aeson.Types as Aeson
-import GHC.Generics
-
-import Data.Data ( Data )
-
-import Data.Coerce ( Coercible, coerce )
-
-import Data.Semigroup.Generic
-import Data.Semigroup ( Last, Option )
+module Language.Haskell.Brittany.Internal.Config.Types where
import Data.CZipWith
+import Data.Coerce (Coercible, coerce)
+import Data.Data (Data)
+import qualified Data.Semigroup as Semigroup
+import Data.Semigroup (Last)
+import Data.Semigroup.Generic
+import GHC.Generics
+import Language.Haskell.Brittany.Internal.Prelude
+import Language.Haskell.Brittany.Internal.PreludeUtils ()
@@ -215,12 +205,12 @@ deriving instance Show (CForwardOptions Identity)
deriving instance Show (CPreProcessorConfig Identity)
deriving instance Show (CConfig Identity)
-deriving instance Show (CDebugConfig Option)
-deriving instance Show (CLayoutConfig Option)
-deriving instance Show (CErrorHandlingConfig Option)
-deriving instance Show (CForwardOptions Option)
-deriving instance Show (CPreProcessorConfig Option)
-deriving instance Show (CConfig Option)
+deriving instance Show (CDebugConfig Maybe)
+deriving instance Show (CLayoutConfig Maybe)
+deriving instance Show (CErrorHandlingConfig Maybe)
+deriving instance Show (CForwardOptions Maybe)
+deriving instance Show (CPreProcessorConfig Maybe)
+deriving instance Show (CConfig Maybe)
deriving instance Data (CDebugConfig Identity)
deriving instance Data (CLayoutConfig Identity)
@@ -229,24 +219,24 @@ deriving instance Data (CForwardOptions Identity)
deriving instance Data (CPreProcessorConfig Identity)
deriving instance Data (CConfig Identity)
-deriving instance Data (CDebugConfig Option)
-deriving instance Data (CLayoutConfig Option)
-deriving instance Data (CErrorHandlingConfig Option)
-deriving instance Data (CForwardOptions Option)
-deriving instance Data (CPreProcessorConfig Option)
-deriving instance Data (CConfig Option)
+deriving instance Data (CDebugConfig Maybe)
+deriving instance Data (CLayoutConfig Maybe)
+deriving instance Data (CErrorHandlingConfig Maybe)
+deriving instance Data (CForwardOptions Maybe)
+deriving instance Data (CPreProcessorConfig Maybe)
+deriving instance Data (CConfig Maybe)
-instance Semigroup.Semigroup (CDebugConfig Option) where
+instance Semigroup.Semigroup (CDebugConfig Maybe) where
(<>) = gmappend
-instance Semigroup.Semigroup (CLayoutConfig Option) where
+instance Semigroup.Semigroup (CLayoutConfig Maybe) where
(<>) = gmappend
-instance Semigroup.Semigroup (CErrorHandlingConfig Option) where
+instance Semigroup.Semigroup (CErrorHandlingConfig Maybe) where
(<>) = gmappend
-instance Semigroup.Semigroup (CForwardOptions Option) where
+instance Semigroup.Semigroup (CForwardOptions Maybe) where
(<>) = gmappend
-instance Semigroup.Semigroup (CPreProcessorConfig Option) where
+instance Semigroup.Semigroup (CPreProcessorConfig Maybe) where
(<>) = gmappend
-instance Semigroup.Semigroup (CConfig Option) where
+instance Semigroup.Semigroup (CConfig Maybe) where
(<>) = gmappend
instance Semigroup.Semigroup (CDebugConfig Identity) where
@@ -262,24 +252,18 @@ instance Semigroup.Semigroup (CPreProcessorConfig Identity) where
instance Semigroup.Semigroup (CConfig Identity) where
(<>) = gmappend
-instance Monoid (CDebugConfig Option) where
+instance Monoid (CDebugConfig Maybe) where
mempty = gmempty
- mappend = gmappend
-instance Monoid (CLayoutConfig Option) where
+instance Monoid (CLayoutConfig Maybe) where
mempty = gmempty
- mappend = gmappend
-instance Monoid (CErrorHandlingConfig Option) where
+instance Monoid (CErrorHandlingConfig Maybe) where
mempty = gmempty
- mappend = gmappend
-instance Monoid (CForwardOptions Option) where
+instance Monoid (CForwardOptions Maybe) where
mempty = gmempty
- mappend = gmappend
-instance Monoid (CPreProcessorConfig Option) where
+instance Monoid (CPreProcessorConfig Maybe) where
mempty = gmempty
- mappend = gmappend
-instance Monoid (CConfig Option) where
+instance Monoid (CConfig Maybe) where
mempty = gmempty
- mappend = gmappend
data IndentPolicy = IndentPolicyLeft -- never create a new indentation at more
@@ -340,16 +324,16 @@ data ExactPrintFallbackMode
-- A PROGRAM BY TRANSFORMING IT.
deriving (Show, Generic, Data)
-instance CFunctor CDebugConfig
-instance CFunctor CLayoutConfig
-instance CFunctor CErrorHandlingConfig
-instance CFunctor CForwardOptions
-instance CFunctor CPreProcessorConfig
-instance CFunctor CConfig
-
deriveCZipWith ''CDebugConfig
deriveCZipWith ''CLayoutConfig
deriveCZipWith ''CErrorHandlingConfig
deriveCZipWith ''CForwardOptions
deriveCZipWith ''CPreProcessorConfig
deriveCZipWith ''CConfig
+
+instance CFunctor CDebugConfig
+instance CFunctor CLayoutConfig
+instance CFunctor CErrorHandlingConfig
+instance CFunctor CForwardOptions
+instance CFunctor CPreProcessorConfig
+instance CFunctor CConfig
diff --git a/source/library/Language/Haskell/Brittany/Internal/Config/Types/Instances.hs b/source/library/Language/Haskell/Brittany/Internal/Config/Types/Instances.hs
new file mode 100644
index 0000000..0c25537
--- /dev/null
+++ b/source/library/Language/Haskell/Brittany/Internal/Config/Types/Instances.hs
@@ -0,0 +1,121 @@
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+-- These optimizations are disabled to improve compile times (and compilation
+-- memory usage). When we do not disable them, the CI servers take more than
+-- 10 minutes to compile this module alone.
+-- Having looked into aeson and how the instances are written, I still do
+-- not understand what makes GHC choke so much here. The size of the raw
+-- expressions below looks fairly negligible, so there must be some expansion
+-- due to inlining going on. But even disabling INLINE pragmas in aeson did
+-- not seem to change anything.
+-- Nonetheless, this solution works and has no downsides because the
+-- instances defined here are not in any way performance-critical.
+{-# OPTIONS_GHC -fno-pre-inlining #-}
+{-# OPTIONS_GHC -fno-specialise #-}
+{-# OPTIONS_GHC -fignore-interface-pragmas #-}
+
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+
+module Language.Haskell.Brittany.Internal.Config.Types.Instances where
+
+import qualified Data.Aeson.Key as Key
+import qualified Data.Aeson.Types as Aeson
+import Data.Yaml
+import Language.Haskell.Brittany.Internal.Config.Types
+import Language.Haskell.Brittany.Internal.Prelude
+
+
+
+aesonDecodeOptionsBrittany :: Aeson.Options
+aesonDecodeOptionsBrittany = Aeson.defaultOptions
+ { Aeson.omitNothingFields = True
+ , Aeson.fieldLabelModifier = dropWhile (=='_')
+ }
+
+instance FromJSON (CDebugConfig Maybe) where
+ parseJSON = Aeson.genericParseJSON aesonDecodeOptionsBrittany
+
+instance ToJSON (CDebugConfig Maybe) where
+ toJSON = Aeson.genericToJSON aesonDecodeOptionsBrittany
+
+instance FromJSON IndentPolicy where
+ parseJSON = Aeson.genericParseJSON aesonDecodeOptionsBrittany
+
+instance ToJSON IndentPolicy where
+ toJSON = Aeson.genericToJSON aesonDecodeOptionsBrittany
+ toEncoding = Aeson.genericToEncoding aesonDecodeOptionsBrittany
+
+instance FromJSON AltChooser where
+ parseJSON = Aeson.genericParseJSON aesonDecodeOptionsBrittany
+
+instance ToJSON AltChooser where
+ toJSON = Aeson.genericToJSON aesonDecodeOptionsBrittany
+ toEncoding = Aeson.genericToEncoding aesonDecodeOptionsBrittany
+
+instance FromJSON ColumnAlignMode where
+ parseJSON = Aeson.genericParseJSON aesonDecodeOptionsBrittany
+
+instance ToJSON ColumnAlignMode where
+ toJSON = Aeson.genericToJSON aesonDecodeOptionsBrittany
+ toEncoding = Aeson.genericToEncoding aesonDecodeOptionsBrittany
+
+instance FromJSON CPPMode where
+ parseJSON = Aeson.genericParseJSON aesonDecodeOptionsBrittany
+
+instance ToJSON CPPMode where
+ toJSON = Aeson.genericToJSON aesonDecodeOptionsBrittany
+ toEncoding = Aeson.genericToEncoding aesonDecodeOptionsBrittany
+
+instance FromJSON ExactPrintFallbackMode where
+ parseJSON = Aeson.genericParseJSON aesonDecodeOptionsBrittany
+
+instance ToJSON ExactPrintFallbackMode where
+ toJSON = Aeson.genericToJSON aesonDecodeOptionsBrittany
+ toEncoding = Aeson.genericToEncoding aesonDecodeOptionsBrittany
+
+instance FromJSON (CLayoutConfig Maybe) where
+ parseJSON = Aeson.genericParseJSON aesonDecodeOptionsBrittany
+
+instance ToJSON (CLayoutConfig Maybe) where
+ toJSON = Aeson.genericToJSON aesonDecodeOptionsBrittany
+
+instance FromJSON (CErrorHandlingConfig Maybe) where
+ parseJSON = Aeson.genericParseJSON aesonDecodeOptionsBrittany
+
+instance ToJSON (CErrorHandlingConfig Maybe) where
+ toJSON = Aeson.genericToJSON aesonDecodeOptionsBrittany
+
+instance FromJSON (CForwardOptions Maybe) where
+ parseJSON = Aeson.genericParseJSON aesonDecodeOptionsBrittany
+
+instance ToJSON (CForwardOptions Maybe) where
+ toJSON = Aeson.genericToJSON aesonDecodeOptionsBrittany
+
+instance FromJSON (CPreProcessorConfig Maybe) where
+ parseJSON = Aeson.genericParseJSON aesonDecodeOptionsBrittany
+
+instance ToJSON (CPreProcessorConfig Maybe) where
+ toJSON = Aeson.genericToJSON aesonDecodeOptionsBrittany
+
+instance ToJSON (CConfig Maybe) where
+ toJSON = Aeson.genericToJSON aesonDecodeOptionsBrittany
+
+-- This custom instance ensures the "omitNothingFields" behaviour not only for
+-- leafs, but for nodes of the config as well. This way e.g. "{}" is valid
+-- config file content.
+instance FromJSON (CConfig Maybe) where
+ parseJSON (Object v) = Config
+ <$> v .:? Key.fromString "conf_version"
+ <*> v .:?= Key.fromString "conf_debug"
+ <*> v .:?= Key.fromString "conf_layout"
+ <*> v .:?= Key.fromString "conf_errorHandling"
+ <*> v .:?= Key.fromString "conf_forward"
+ <*> v .:?= Key.fromString "conf_preprocessor"
+ <*> v .:? Key.fromString "conf_roundtrip_exactprint_only"
+ <*> v .:? Key.fromString "conf_disable_formatting"
+ <*> v .:? Key.fromString "conf_obfuscate"
+ parseJSON invalid = Aeson.typeMismatch "Config" invalid
+
+-- Pretends that the value is {} when the key is not present.
+(.:?=) :: FromJSON a => Object -> Key.Key -> Parser a
+o .:?= k = o .:? k >>= maybe (parseJSON (Aeson.object [])) pure
diff --git a/source/library/Language/Haskell/Brittany/Internal/ExactPrintUtils.hs b/source/library/Language/Haskell/Brittany/Internal/ExactPrintUtils.hs
new file mode 100644
index 0000000..b93fbbc
--- /dev/null
+++ b/source/library/Language/Haskell/Brittany/Internal/ExactPrintUtils.hs
@@ -0,0 +1,247 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MonadComprehensions #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module Language.Haskell.Brittany.Internal.ExactPrintUtils where
+
+import qualified Control.Monad.State.Class as State.Class
+import qualified Control.Monad.Trans.MultiRWS.Strict as MultiRWSS
+import Data.Data
+import qualified Data.Foldable as Foldable
+import qualified Data.Generics as SYB
+import Data.HList.HList
+import qualified Data.Map as Map
+import qualified Data.Maybe
+import qualified Data.Sequence as Seq
+import qualified Data.Set as Set
+import GHC (GenLocated(L))
+import qualified GHC hiding (parseModule)
+import qualified GHC.Driver.CmdLine as GHC
+import GHC.Hs
+import qualified GHC.Types.SrcLoc as GHC
+import GHC.Types.SrcLoc (Located, SrcSpan)
+import Language.Haskell.Brittany.Internal.Config.Types
+import qualified Language.Haskell.Brittany.Internal.ParseModule as ParseModule
+import Language.Haskell.Brittany.Internal.Prelude
+import Language.Haskell.Brittany.Internal.PreludeUtils
+import qualified Language.Haskell.GHC.ExactPrint as ExactPrint
+import qualified Language.Haskell.GHC.ExactPrint.Types as ExactPrint
+import qualified System.IO
+
+
+
+parseModule
+ :: [String]
+ -> System.IO.FilePath
+ -> (GHC.DynFlags -> IO (Either String a))
+ -> IO (Either String (ExactPrint.Anns, GHC.ParsedSource, a))
+parseModule args fp dynCheck = do
+ str <- System.IO.readFile fp
+ parseModuleFromString args fp dynCheck str
+
+parseModuleFromString
+ :: [String]
+ -> System.IO.FilePath
+ -> (GHC.DynFlags -> IO (Either String a))
+ -> String
+ -> IO (Either String (ExactPrint.Anns, GHC.ParsedSource, a))
+parseModuleFromString = ParseModule.parseModule
+
+
+commentAnnFixTransformGlob :: SYB.Data ast => ast -> ExactPrint.Transform ()
+commentAnnFixTransformGlob ast = do
+ let extract :: forall a . SYB.Data a => a -> Seq (SrcSpan, ExactPrint.AnnKey)
+ extract = -- traceFunctionWith "extract" (show . SYB.typeOf) show $
+ const Seq.empty
+ `SYB.ext1Q`
+ (\l@(L span _) -> Seq.singleton (span, ExactPrint.mkAnnKey l))
+ let nodes = SYB.everything (<>) extract ast
+ let annsMap :: Map GHC.RealSrcLoc ExactPrint.AnnKey
+ annsMap = Map.fromListWith
+ (const id)
+ [ (GHC.realSrcSpanEnd span, annKey)
+ | (GHC.RealSrcSpan span _, annKey) <- Foldable.toList nodes
+ ]
+ nodes `forM_` (snd .> processComs annsMap)
+ where
+ processComs annsMap annKey1 = do
+ mAnn <- State.Class.gets fst <&> Map.lookup annKey1
+ mAnn `forM_` \ann1 -> do
+ let priors = ExactPrint.annPriorComments ann1
+ follows = ExactPrint.annFollowingComments ann1
+ assocs = ExactPrint.annsDP ann1
+ let
+ processCom
+ :: (ExactPrint.Comment, ExactPrint.DeltaPos)
+ -> ExactPrint.TransformT Identity Bool
+ processCom comPair@(com, _) =
+ case GHC.realSrcSpanStart $ ExactPrint.commentIdentifier com of
+ comLoc -> case Map.lookupLE comLoc annsMap of
+ Just (_, annKey2) | loc1 /= loc2 -> case (con1, con2) of
+ (ExactPrint.CN "RecordCon", ExactPrint.CN "HsRecField") ->
+ move $> False
+ (x, y) | x == y -> move $> False
+ _ -> return True
+ where
+ ExactPrint.AnnKey annKeyLoc1 con1 = annKey1
+ ExactPrint.AnnKey annKeyLoc2 con2 = annKey2
+ loc1 = GHC.realSrcSpanStart annKeyLoc1
+ loc2 = GHC.realSrcSpanStart annKeyLoc2
+ move = ExactPrint.modifyAnnsT $ \anns ->
+ let
+ ann2 = Data.Maybe.fromJust $ Map.lookup annKey2 anns
+ ann2' = ann2
+ { ExactPrint.annFollowingComments =
+ ExactPrint.annFollowingComments ann2 ++ [comPair]
+ }
+ in
+ Map.insert annKey2 ann2' anns
+ _ -> return True -- retain comment at current node.
+ priors' <- filterM processCom priors
+ follows' <- filterM processCom follows
+ assocs' <- flip filterM assocs $ \case
+ (ExactPrint.AnnComment com, dp) -> processCom (com, dp)
+ _ -> return True
+ let ann1' = ann1 { ExactPrint.annPriorComments = priors'
+ , ExactPrint.annFollowingComments = follows'
+ , ExactPrint.annsDP = assocs'
+ }
+ ExactPrint.modifyAnnsT $ \anns -> Map.insert annKey1 ann1' anns
+
+
+-- TODO: this is unused by now, but it contains one detail that
+-- commentAnnFixTransformGlob does not include: Moving of comments for
+-- "RecordUpd"s.
+-- commentAnnFixTransform :: GHC.ParsedSource -> ExactPrint.Transform ()
+-- commentAnnFixTransform modul = SYB.everything (>>) genF modul
+-- where
+-- genF :: Data.Data.Data a => a -> ExactPrint.Transform ()
+-- genF = (\_ -> return ()) `SYB.extQ` exprF
+-- exprF :: Located (HsExpr GhcPs) -> ExactPrint.Transform ()
+-- exprF lexpr@(L _ expr) = case expr of
+-- #if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
+-- RecordCon _ _ (HsRecFields fs@(_:_) Nothing) ->
+-- #else
+-- RecordCon _ _ _ (HsRecFields fs@(_:_) Nothing) ->
+-- #endif
+-- moveTrailingComments lexpr (List.last fs)
+-- #if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
+-- RecordUpd _ _e fs@(_:_) ->
+-- #else
+-- RecordUpd _e fs@(_:_) _cons _ _ _ ->
+-- #endif
+-- moveTrailingComments lexpr (List.last fs)
+-- _ -> return ()
+
+-- commentAnnFixTransform :: GHC.ParsedSource -> ExactPrint.Transform ()
+-- commentAnnFixTransform modul = SYB.everything (>>) genF modul
+-- where
+-- genF :: Data.Data.Data a => a -> ExactPrint.Transform ()
+-- genF = (\_ -> return ()) `SYB.extQ` exprF
+-- exprF :: Located (HsExpr GhcPs) -> ExactPrint.Transform ()
+-- exprF lexpr@(L _ expr) = case expr of
+-- RecordCon _ _ (HsRecFields fs@(_:_) Nothing) ->
+-- moveTrailingComments lexpr (List.last fs)
+-- RecordUpd _ _e fs@(_:_) ->
+-- moveTrailingComments lexpr (List.last fs)
+-- _ -> return ()
+
+-- moveTrailingComments :: (Data.Data.Data a,Data.Data.Data b)
+-- => GHC.Located a -> GHC.Located b -> ExactPrint.Transform ()
+-- moveTrailingComments astFrom astTo = do
+-- let
+-- k1 = ExactPrint.mkAnnKey astFrom
+-- k2 = ExactPrint.mkAnnKey astTo
+-- moveComments ans = ans'
+-- where
+-- an1 = Data.Maybe.fromJust $ Map.lookup k1 ans
+-- an2 = Data.Maybe.fromJust $ Map.lookup k2 ans
+-- cs1f = ExactPrint.annFollowingComments an1
+-- cs2f = ExactPrint.annFollowingComments an2
+-- (comments, nonComments) = flip breakEither (ExactPrint.annsDP an1)
+-- $ \case
+-- (ExactPrint.AnnComment com, dp) -> Left (com, dp)
+-- x -> Right x
+-- an1' = an1
+-- { ExactPrint.annsDP = nonComments
+-- , ExactPrint.annFollowingComments = []
+-- }
+-- an2' = an2
+-- { ExactPrint.annFollowingComments = cs1f ++ cs2f ++ comments
+-- }
+-- ans' = Map.insert k1 an1' $ Map.insert k2 an2' ans
+
+-- ExactPrint.modifyAnnsT moveComments
+
+-- | split a set of annotations in a module into a map from top-level module
+-- elements to the relevant annotations. Avoids quadratic behaviour a trivial
+-- implementation would have.
+extractToplevelAnns
+ :: Located HsModule
+ -> ExactPrint.Anns
+ -> Map ExactPrint.AnnKey ExactPrint.Anns
+extractToplevelAnns lmod anns = output
+ where
+ (L _ (HsModule _ _ _ _ ldecls _ _)) = lmod
+ declMap1 :: Map ExactPrint.AnnKey ExactPrint.AnnKey
+ declMap1 = Map.unions $ ldecls <&> \ldecl ->
+ Map.fromSet (const (ExactPrint.mkAnnKey ldecl)) (foldedAnnKeys ldecl)
+ declMap2 :: Map ExactPrint.AnnKey ExactPrint.AnnKey
+ declMap2 =
+ Map.fromList
+ $ [ (captured, declMap1 Map.! k)
+ | (k, ExactPrint.Ann _ _ _ _ _ (Just captured)) <- Map.toList anns
+ ]
+ declMap = declMap1 `Map.union` declMap2
+ modKey = ExactPrint.mkAnnKey lmod
+ output = groupMap (\k _ -> Map.findWithDefault modKey k declMap) anns
+
+groupMap :: (Ord k, Ord l) => (k -> a -> l) -> Map k a -> Map l (Map k a)
+groupMap f = Map.foldlWithKey' (\m k a -> Map.alter (insert k a) (f k a) m)
+ Map.empty
+ where
+ insert k a Nothing = Just (Map.singleton k a)
+ insert k a (Just m) = Just (Map.insert k a m)
+
+foldedAnnKeys :: Data.Data.Data ast => ast -> Set ExactPrint.AnnKey
+foldedAnnKeys ast = SYB.everything
+ Set.union
+ ( \x -> maybe
+ Set.empty
+ Set.singleton
+ [ SYB.gmapQi 1 (ExactPrint.mkAnnKey . L l) x
+ | locTyCon == SYB.typeRepTyCon (SYB.typeOf x)
+ , l :: SrcSpan <- SYB.gmapQi 0 SYB.cast x
+ -- for some reason, ghc-8.8 has forgotten how to infer the type of l,
+ -- even though it is passed to mkAnnKey above, which only accepts
+ -- SrcSpan.
+ ]
+ )
+ ast
+ where locTyCon = SYB.typeRepTyCon (SYB.typeOf (L () ()))
+
+
+withTransformedAnns
+ :: Data ast
+ => ast
+ -> MultiRWSS.MultiRWS '[Config, ExactPrint.Anns] w s a
+ -> MultiRWSS.MultiRWS '[Config, ExactPrint.Anns] w s a
+withTransformedAnns ast m = MultiRWSS.mGetRawR >>= \case
+ readers@(conf :+: anns :+: HNil) -> do
+ -- TODO: implement `local` for MultiReader/MultiRWS
+ MultiRWSS.mPutRawR (conf :+: f anns :+: HNil)
+ x <- m
+ MultiRWSS.mPutRawR readers
+ pure x
+ where
+ f anns =
+ let ((), (annsBalanced, _), _) =
+ ExactPrint.runTransform anns (commentAnnFixTransformGlob ast)
+ in annsBalanced
+
+
+warnExtractorCompat :: GHC.Warn -> String
+warnExtractorCompat (GHC.Warn _ (L _ s)) = s
diff --git a/src/Language/Haskell/Brittany/Internal/LayouterBasics.hs b/source/library/Language/Haskell/Brittany/Internal/LayouterBasics.hs
similarity index 92%
rename from src/Language/Haskell/Brittany/Internal/LayouterBasics.hs
rename to source/library/Language/Haskell/Brittany/Internal/LayouterBasics.hs
index 770cbdd..4606eac 100644
--- a/src/Language/Haskell/Brittany/Internal/LayouterBasics.hs
+++ b/source/library/Language/Haskell/Brittany/Internal/LayouterBasics.hs
@@ -1,121 +1,42 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NoImplicitPrelude #-}
-module Language.Haskell.Brittany.Internal.LayouterBasics
- ( processDefault
- , rdrNameToText
- , lrdrNameToText
- , lrdrNameToTextAnn
- , lrdrNameToTextAnnTypeEqualityIsSpecial
- , lrdrNameToTextAnnTypeEqualityIsSpecialAndRespectTick
- , askIndent
- , extractAllComments
- , extractRestComments
- , filterAnns
- , docEmpty
- , docLit
- , docLitS
- , docAlt
- , CollectAltM
- , addAlternativeCond
- , addAlternative
- , runFilteredAlternative
- , docLines
- , docCols
- , docSeq
- , docPar
- , docNodeAnnKW
- , docNodeMoveToKWDP
- , docWrapNode
- , docWrapNodePrior
- , docWrapNodeRest
- , docForceSingleline
- , docForceMultiline
- , docEnsureIndent
- , docAddBaseY
- , docSetBaseY
- , docSetIndentLevel
- , docSeparator
- , docAnnotationPrior
- , docAnnotationKW
- , docAnnotationRest
- , docMoveToKWDP
- , docNonBottomSpacing
- , docNonBottomSpacingS
- , docSetParSpacing
- , docForceParSpacing
- , docDebug
- , docSetBaseAndIndent
- , briDocByExact
- , briDocByExactNoComment
- , briDocByExactInlineOnly
- , foldedAnnKeys
- , unknownNodeError
- , appSep
- , docCommaSep
- , docParenLSep
- , docParenL
- , docParenR
- , docParenHashLSep
- , docParenHashRSep
- , docBracketL
- , docBracketR
- , docTick
- , spacifyDocs
- , briDocMToPPM
- , briDocMToPPMInner
- , allocateNode
- , docSharedWrapper
- , hasAnyCommentsBelow
- , hasCommentsBetween
- , hasAnyCommentsConnected
- , hasAnyCommentsPrior
- , hasAnyRegularCommentsConnected
- , hasAnyRegularCommentsRest
- , hasAnnKeywordComment
- , hasAnnKeyword
- , astAnn
- , allocNodeIndex
- )
-where
-
-
-
-#include "prelude.inc"
+module Language.Haskell.Brittany.Internal.LayouterBasics where
+import qualified Control.Monad.Trans.MultiRWS.Strict as MultiRWSS
import qualified Control.Monad.Writer.Strict as Writer
-
+import qualified Data.Char as Char
+import Data.Data
+import qualified Data.Map as Map
+import qualified Data.Semigroup as Semigroup
+import qualified Data.Sequence as Seq
+import qualified Data.Set as Set
+import qualified Data.Text as Text
+import qualified Data.Text.Lazy.Builder as Text.Builder
+import DataTreePrint
+import GHC (GenLocated(L), Located, moduleName, moduleNameString)
+import qualified GHC.OldList as List
+import GHC.Parser.Annotation (AnnKeywordId(..))
+import GHC.Types.Name (getOccString)
+import GHC.Types.Name.Occurrence (occNameString)
+import GHC.Types.Name.Reader (RdrName(..))
+import qualified GHC.Types.SrcLoc as GHC
+import Language.Haskell.Brittany.Internal.Config.Types
+import Language.Haskell.Brittany.Internal.ExactPrintUtils
+import Language.Haskell.Brittany.Internal.Prelude
+import Language.Haskell.Brittany.Internal.PreludeUtils
+import Language.Haskell.Brittany.Internal.Types
+import Language.Haskell.Brittany.Internal.Utils
import qualified Language.Haskell.GHC.ExactPrint as ExactPrint
import qualified Language.Haskell.GHC.ExactPrint.Annotate as ExactPrint.Annotate
import qualified Language.Haskell.GHC.ExactPrint.Types as ExactPrint.Types
import qualified Language.Haskell.GHC.ExactPrint.Types as ExactPrint
+import Language.Haskell.GHC.ExactPrint.Types (AnnKey, Annotation)
import qualified Language.Haskell.GHC.ExactPrint.Utils as ExactPrint.Utils
-import Language.Haskell.GHC.ExactPrint.Types ( AnnKey, Annotation, KeywordId )
-
-import qualified Data.Text.Lazy.Builder as Text.Builder
-
-import Language.Haskell.Brittany.Internal.Config.Types
-import Language.Haskell.Brittany.Internal.Types
-import Language.Haskell.Brittany.Internal.Utils
-import Language.Haskell.Brittany.Internal.ExactPrintUtils
-
-import RdrName ( RdrName(..) )
-import GHC ( Located, runGhc, GenLocated(L), moduleNameString )
-import qualified SrcLoc as GHC
-import OccName ( occNameString )
-import Name ( getOccString )
-import Module ( moduleName )
-import ApiAnnotation ( AnnKeywordId(..) )
-
-import Data.Data
-import Data.Generics.Schemes
-
-import qualified Data.Char as Char
-
-import DataTreePrint
-
-import Data.HList.HList
-
processDefault
@@ -172,7 +93,7 @@ briDocByExactNoComment ast = do
-- not contain any newlines. If this property is not met, the semantics
-- depend on the @econf_AllowRiskyExactPrintUse@ config flag.
briDocByExactInlineOnly
- :: (ExactPrint.Annotate.Annotate ast, Data ast)
+ :: (ExactPrint.Annotate.Annotate ast)
=> String
-> Located ast
-> ToBriDocM BriDocNumbered
@@ -299,7 +220,7 @@ filterAnns ast =
-- b) after (in source code order) the node.
hasAnyCommentsBelow :: Data ast => GHC.Located ast -> ToBriDocM Bool
hasAnyCommentsBelow ast@(L l _) =
- List.any (\(c, _) -> ExactPrint.commentIdentifier c > l)
+ List.any (\(c, _) -> ExactPrint.commentIdentifier c > ExactPrint.Utils.rs l)
<$> astConnectedComments ast
hasCommentsBetween
diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/DataDecl.hs b/source/library/Language/Haskell/Brittany/Internal/Layouters/DataDecl.hs
similarity index 86%
rename from src/Language/Haskell/Brittany/Internal/Layouters/DataDecl.hs
rename to source/library/Language/Haskell/Brittany/Internal/Layouters/DataDecl.hs
index 22f11d4..dc7d022 100644
--- a/src/Language/Haskell/Brittany/Internal/Layouters/DataDecl.hs
+++ b/source/library/Language/Haskell/Brittany/Internal/Layouters/DataDecl.hs
@@ -1,40 +1,21 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE TypeApplications #-}
-{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NoImplicitPrelude #-}
-module Language.Haskell.Brittany.Internal.Layouters.DataDecl
- ( layoutDataDecl
- )
-where
+module Language.Haskell.Brittany.Internal.Layouters.DataDecl where
-
-
-#include "prelude.inc"
-
-import Language.Haskell.Brittany.Internal.Types
-import Language.Haskell.Brittany.Internal.LayouterBasics
-import Language.Haskell.Brittany.Internal.Config.Types
-
-import RdrName ( RdrName(..) )
-import GHC ( Located, runGhc, GenLocated(L), moduleNameString )
+import qualified Data.Data
+import qualified Data.Semigroup as Semigroup
+import qualified Data.Text as Text
+import GHC (GenLocated(L), Located)
import qualified GHC
-#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
-import GHC.Hs
-#else
-import HsSyn
-#endif
-import Name
-import BasicTypes
-import Language.Haskell.GHC.ExactPrint.Types ( mkAnnKey )
-
-import Language.Haskell.Brittany.Internal.Layouters.Type
-import {-# SOURCE #-} Language.Haskell.Brittany.Internal.Layouters.Expr
-import {-# SOURCE #-} Language.Haskell.Brittany.Internal.Layouters.Stmt
-import Language.Haskell.Brittany.Internal.Layouters.Pattern
-import Language.Haskell.Brittany.Internal.Utils
-
-import Bag ( mapBagM )
+import GHC.Hs
+import qualified GHC.OldList as List
+import Language.Haskell.Brittany.Internal.Config.Types
+import Language.Haskell.Brittany.Internal.LayouterBasics
+import Language.Haskell.Brittany.Internal.Layouters.Type
+import Language.Haskell.Brittany.Internal.Prelude
+import Language.Haskell.Brittany.Internal.PreludeUtils
+import Language.Haskell.Brittany.Internal.Types
@@ -44,7 +25,6 @@ layoutDataDecl
-> LHsQTyVars GhcPs
-> HsDataDefn GhcPs
-> ToBriDocM BriDocNumbered
-layoutDataDecl _ _ (XLHsQTyVars ext) _ = absurdExt ext
layoutDataDecl ltycl name (HsQTvs _ bndrs) defn = case defn of
-- newtype MyType a b = MyType ..
HsDataDefn _ext NewType (L _ []) _ctype Nothing [cons] mDerivs -> case cons of
@@ -52,13 +32,13 @@ layoutDataDecl ltycl name (HsQTvs _ bndrs) defn = case defn of
docWrapNode ltycl $ do
nameStr <- lrdrNameToTextAnn name
consNameStr <- lrdrNameToTextAnn consName
- tyVarLine <- fmap return $ createBndrDoc bndrs
+ tyVarLine <- return <$> createBndrDoc bndrs
-- headDoc <- fmap return $ docSeq
-- [ appSep $ docLitS "newtype")
-- , appSep $ docLit nameStr
-- , appSep tyVarLine
-- ]
- rhsDoc <- fmap return $ createDetailsDoc consNameStr details
+ rhsDoc <- return <$> createDetailsDoc consNameStr details
createDerivingPar mDerivs $ docSeq
[ appSep $ docLitS "newtype"
, appSep $ docLit nameStr
@@ -77,7 +57,7 @@ layoutDataDecl ltycl name (HsQTvs _ bndrs) defn = case defn of
docWrapNode ltycl $ do
lhsContextDoc <- docSharedWrapper createContextDoc lhsContext
nameStr <- lrdrNameToTextAnn name
- tyVarLine <- fmap return $ createBndrDoc bndrs
+ tyVarLine <- return <$> createBndrDoc bndrs
createDerivingPar mDerivs $ docSeq
[ appSep $ docLitS "data"
, lhsContextDoc
@@ -94,14 +74,14 @@ layoutDataDecl ltycl name (HsQTvs _ bndrs) defn = case defn of
lhsContextDoc <- docSharedWrapper createContextDoc lhsContext
nameStr <- lrdrNameToTextAnn name
consNameStr <- lrdrNameToTextAnn consName
- tyVarLine <- fmap return $ createBndrDoc bndrs
+ tyVarLine <- return <$> createBndrDoc bndrs
forallDocMay <- case createForallDoc qvars of
Nothing -> pure Nothing
Just x -> Just . pure <$> x
rhsContextDocMay <- case mRhsContext of
Nothing -> pure Nothing
Just (L _ ctxt) -> Just . pure <$> createContextDoc ctxt
- rhsDoc <- fmap return $ createDetailsDoc consNameStr details
+ rhsDoc <- return <$> createDetailsDoc consNameStr details
consDoc <- fmap pure
$ docNonBottomSpacing
$ case (forallDocMay, rhsContextDocMay) of
@@ -242,14 +222,13 @@ createContextDoc (t1 : tR) = do
]
]
-createBndrDoc :: [LHsTyVarBndr GhcPs] -> ToBriDocM BriDocNumbered
+createBndrDoc :: [LHsTyVarBndr flag GhcPs] -> ToBriDocM BriDocNumbered
createBndrDoc bs = do
tyVarDocs <- bs `forM` \case
- (L _ (UserTyVar _ext vname)) -> return $ (lrdrNameToText vname, Nothing)
- (L _ (KindedTyVar _ext lrdrName kind)) -> do
+ (L _ (UserTyVar _ _ext vname)) -> return $ (lrdrNameToText vname, Nothing)
+ (L _ (KindedTyVar _ _ext lrdrName kind)) -> do
d <- docSharedWrapper layoutType kind
return $ (lrdrNameToText lrdrName, Just $ d)
- (L _ (XTyVarBndr ext)) -> absurdExt ext
docSeq
$ List.intersperse docSeparator
$ tyVarDocs
@@ -279,7 +258,6 @@ createDerivingPar derivs mainDoc = do
<$> types
derivingClauseDoc :: LHsDerivingClause GhcPs -> ToBriDocM BriDocNumbered
-derivingClauseDoc (L _ (XHsDerivingClause ext)) = absurdExt ext
derivingClauseDoc (L _ (HsDerivingClause _ext mStrategy types)) = case types of
(L _ []) -> docSeq []
(L _ ts) ->
@@ -299,7 +277,6 @@ derivingClauseDoc (L _ (HsDerivingClause _ext mStrategy types)) = case types of
$ List.intersperse docCommaSep
$ ts <&> \case
HsIB _ t -> layoutType t
- XHsImplicitBndrs x -> absurdExt x
, whenMoreThan1Type ")"
, rhsStrategy
]
@@ -316,7 +293,6 @@ derivingClauseDoc (L _ (HsDerivingClause _ext mStrategy types)) = case types of
, docSeparator
, layoutType t
]
- XHsImplicitBndrs ext -> absurdExt ext
)
docDeriving :: ToBriDocM BriDocNumbered
@@ -334,21 +310,21 @@ createDetailsDoc consNameStr details = case details of
, docForceSingleline
$ docSeq
$ List.intersperse docSeparator
- $ args <&> layoutType
+ $ fmap hsScaledThing args <&> layoutType
]
leftIndented = docSetParSpacing
. docAddBaseY BrIndentRegular
. docPar (docLit consNameStr)
. docLines
- $ layoutType <$> args
+ $ layoutType <$> fmap hsScaledThing args
multiAppended = docSeq
[ docLit consNameStr
, docSeparator
- , docSetBaseY $ docLines $ layoutType <$> args
+ , docSetBaseY $ docLines $ layoutType <$> fmap hsScaledThing args
]
multiIndented = docSetBaseY $ docAddBaseY BrIndentRegular $ docPar
(docLit consNameStr)
- (docLines $ layoutType <$> args)
+ (docLines $ layoutType <$> fmap hsScaledThing args)
case indentPolicy of
IndentPolicyLeft -> docAlt [singleLine, leftIndented]
IndentPolicyMultiple -> docAlt [singleLine, multiAppended, leftIndented]
@@ -424,11 +400,11 @@ createDetailsDoc consNameStr details = case details of
]
)
InfixCon arg1 arg2 -> docSeq
- [ layoutType arg1
+ [ layoutType $ hsScaledThing arg1
, docSeparator
, docLit consNameStr
, docSeparator
- , layoutType arg2
+ , layoutType $ hsScaledThing arg2
]
where
mkFieldDocs
@@ -436,9 +412,8 @@ createDetailsDoc consNameStr details = case details of
-> [(ToBriDocM BriDocNumbered, ToBriDocM BriDocNumbered)]
mkFieldDocs = fmap $ \lField -> case lField of
L _ (ConDeclField _ext names t _) -> createNamesAndTypeDoc lField names t
- L _ (XConDeclField x) -> absurdExt x
-createForallDoc :: [LHsTyVarBndr GhcPs] -> Maybe (ToBriDocM BriDocNumbered)
+createForallDoc :: [LHsTyVarBndr flag GhcPs] -> Maybe (ToBriDocM BriDocNumbered)
createForallDoc [] = Nothing
createForallDoc lhsTyVarBndrs = Just $ docSeq
[docLitS "forall ", createBndrDoc lhsTyVarBndrs]
@@ -455,7 +430,6 @@ createNamesAndTypeDoc lField names t =
$ List.intersperse docCommaSep
$ names
<&> \case
- L _ (XFieldOcc x) -> absurdExt x
L _ (FieldOcc _ fieldName) ->
docLit =<< lrdrNameToTextAnn fieldName
]
diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Decl.hs b/source/library/Language/Haskell/Brittany/Internal/Layouters/Decl.hs
similarity index 90%
rename from src/Language/Haskell/Brittany/Internal/Layouters/Decl.hs
rename to source/library/Language/Haskell/Brittany/Internal/Layouters/Decl.hs
index f6f59a4..db58abc 100644
--- a/src/Language/Haskell/Brittany/Internal/Layouters/Decl.hs
+++ b/source/library/Language/Haskell/Brittany/Internal/Layouters/Decl.hs
@@ -1,66 +1,42 @@
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE TypeApplications #-}
-{-# LANGUAGE PatternSynonyms #-}
-{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE ScopedTypeVariables #-}
-module Language.Haskell.Brittany.Internal.Layouters.Decl
- ( layoutDecl
- , layoutSig
- , layoutBind
- , layoutLocalBinds
- , layoutGuardLStmt
- , layoutPatternBind
- , layoutGrhs
- , layoutPatternBindFinal
+module Language.Haskell.Brittany.Internal.Layouters.Decl where
+
+import qualified Data.Data
+import qualified Data.Foldable
+import qualified Data.Maybe
+import qualified Data.Semigroup as Semigroup
+import qualified Data.Text as Text
+import GHC (AnnKeywordId(..), GenLocated(L))
+import GHC.Data.Bag (bagToList, emptyBag)
+import qualified GHC.Data.FastString as FastString
+import GHC.Hs
+import qualified GHC.OldList as List
+import GHC.Types.Basic
+ ( Activation(..)
+ , InlinePragma(..)
+ , InlineSpec(..)
+ , LexicalFixity(..)
+ , RuleMatchInfo(..)
)
-where
-
-
-
-#include "prelude.inc"
-
-import Language.Haskell.Brittany.Internal.Types
-import Language.Haskell.Brittany.Internal.LayouterBasics
-import Language.Haskell.Brittany.Internal.Config.Types
-import Language.Haskell.Brittany.Internal.Layouters.Type
-
-import qualified Language.Haskell.GHC.ExactPrint as ExactPrint
-import qualified Language.Haskell.GHC.ExactPrint.Types as ExactPrint
-import Language.Haskell.Brittany.Internal.ExactPrintUtils
-import Language.Haskell.Brittany.Internal.Utils
-
-import GHC ( runGhc
- , GenLocated(L)
- , moduleNameString
- , AnnKeywordId(..)
- )
-import SrcLoc ( SrcSpan, noSrcSpan, Located , getLoc, unLoc )
-import qualified FastString
-#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
-import GHC.Hs
-import GHC.Hs.Extension (NoExtField (..))
-#else
-import HsSyn
-import HsExtension (NoExt (..))
-#endif
-import Name
-import BasicTypes ( InlinePragma(..)
- , Activation(..)
- , InlineSpec(..)
- , RuleMatchInfo(..)
- , LexicalFixity(..)
- )
-import Language.Haskell.GHC.ExactPrint.Types ( mkAnnKey )
-
-import Language.Haskell.Brittany.Internal.Layouters.Type
+import GHC.Types.SrcLoc (Located, SrcSpan, getLoc, unLoc)
+import Language.Haskell.Brittany.Internal.Config.Types
+import Language.Haskell.Brittany.Internal.ExactPrintUtils
+import Language.Haskell.Brittany.Internal.LayouterBasics
+import Language.Haskell.Brittany.Internal.Layouters.DataDecl
import {-# SOURCE #-} Language.Haskell.Brittany.Internal.Layouters.Expr
+import Language.Haskell.Brittany.Internal.Layouters.Pattern
import {-# SOURCE #-} Language.Haskell.Brittany.Internal.Layouters.Stmt
-import Language.Haskell.Brittany.Internal.Layouters.Pattern
-import Language.Haskell.Brittany.Internal.Layouters.DataDecl
-
-import Bag ( mapBagM, bagToList, emptyBag )
-import Data.Char (isUpper)
+import Language.Haskell.Brittany.Internal.Layouters.Type
+import Language.Haskell.Brittany.Internal.Prelude
+import Language.Haskell.Brittany.Internal.PreludeUtils
+import Language.Haskell.Brittany.Internal.Types
+import qualified Language.Haskell.GHC.ExactPrint as ExactPrint
+import Language.Haskell.GHC.ExactPrint.Types (mkAnnKey)
+import qualified Language.Haskell.GHC.ExactPrint.Utils as ExactPrint
@@ -94,6 +70,7 @@ layoutSig lsig@(L _loc sig) = case sig of
AlwaysActive -> ""
ActiveBefore _ i -> "[~" ++ show i ++ "] "
ActiveAfter _ i -> "[" ++ show i ++ "] "
+ FinalActive -> error "brittany internal error: FinalActive"
let conlikeStr = case conlike of
FunLike -> ""
ConLike -> "CONLIKE "
@@ -145,7 +122,7 @@ specStringCompat ast = \case
layoutGuardLStmt :: ToBriDoc' (Stmt GhcPs (LHsExpr GhcPs))
layoutGuardLStmt lgstmt@(L _ stmtLR) = docWrapNode lgstmt $ case stmtLR of
BodyStmt _ body _ _ -> layoutExpr body
- BindStmt _ lPat expr _ _ -> do
+ BindStmt _ lPat expr -> do
patDoc <- docSharedWrapper layoutPat lPat
expDoc <- docSharedWrapper layoutExpr expr
docCols ColBindStmt
@@ -164,7 +141,7 @@ layoutBind
(HsBindLR GhcPs GhcPs)
(Either [BriDocNumbered] BriDocNumbered)
layoutBind lbind@(L _ bind) = case bind of
- FunBind _ fId (MG _ lmatches@(L _ matches) _) _ [] -> do
+ FunBind _ fId (MG _ lmatches@(L _ matches) _) [] -> do
idStr <- lrdrNameToTextAnn fId
binderDoc <- docLit $ Text.pack "="
funcPatDocs <-
@@ -177,7 +154,7 @@ layoutBind lbind@(L _ bind) = case bind of
patDocs <- colsWrapPat =<< layoutPat pat
clauseDocs <- layoutGrhs `mapM` grhss
mWhereDocs <- layoutLocalBinds whereBinds
- let mWhereArg = mWhereDocs <&> \d -> (mkAnnKey lbind, d) -- TODO: is this the right AnnKey?
+ let mWhereArg = mWhereDocs <&> (,) (mkAnnKey lbind) -- TODO: is this the right AnnKey?
binderDoc <- docLit $ Text.pack "="
hasComments <- hasAnyCommentsBelow lbind
fmap Right $ docWrapNode lbind $ layoutPatternBindFinal Nothing
@@ -186,11 +163,7 @@ layoutBind lbind@(L _ bind) = case bind of
clauseDocs
mWhereArg
hasComments
-#if MIN_VERSION_ghc(8,8,0)
PatSynBind _ (PSB _ patID lpat rpat dir) -> do
-#else
- PatSynBind _ (PSB _ patID lpat rpat dir) -> do
-#endif
fmap Right $ docWrapNode lbind $ layoutPatSynBind patID
lpat
dir
@@ -198,7 +171,6 @@ layoutBind lbind@(L _ bind) = case bind of
_ -> Right <$> unknownNodeError "" lbind
layoutIPBind :: ToBriDoc IPBind
layoutIPBind lipbind@(L _ bind) = case bind of
- XIPBind{} -> unknownNodeError "XIPBind" lipbind
IPBind _ (Right _) _ -> error "brittany internal error: IPBind Right"
IPBind _ (Left (L _ (HsIPName name))) expr -> do
ipName <- docLit $ Text.pack $ '?' : FastString.unpackFS name
@@ -226,16 +198,13 @@ layoutLocalBinds lbinds@(L _ binds) = case binds of
let unordered =
[ BagBind b | b <- Data.Foldable.toList bindlrs ]
++ [ BagSig s | s <- sigs ]
- ordered = sortBy (comparing bindOrSigtoSrcSpan) unordered
+ ordered = List.sortOn (ExactPrint.rs . bindOrSigtoSrcSpan) unordered
docs <- docWrapNode lbinds $ join <$> ordered `forM` \case
BagBind b -> either id return <$> layoutBind b
BagSig s -> return <$> layoutSig s
return $ Just $ docs
-- x@(HsValBinds (ValBindsOut _binds _lsigs)) ->
HsValBinds _ (XValBindsLR{}) -> error "brittany internal error: XValBindsLR"
- XHsLocalBindsLR{} -> error "brittany internal error: XHsLocalBindsLR"
- x@(HsIPBinds _ XHsIPBinds{}) ->
- Just . (: []) <$> unknownNodeError "XHsIPBinds" (L noSrcSpan x)
HsIPBinds _ (IPBinds _ bb) ->
Just <$> mapM layoutIPBind bb
EmptyLocalBinds{} -> return $ Nothing
@@ -249,7 +218,6 @@ layoutGrhs lgrhs@(L _ (GRHS _ guards body)) = do
guardDocs <- docWrapNode lgrhs $ layoutStmt `mapM` guards
bodyDoc <- layoutExpr body
return (guardDocs, bodyDoc, body)
-layoutGrhs (L _ (XGRHS{})) = error "brittany internal error: XGRHS"
layoutPatternBind
:: Maybe Text
@@ -295,7 +263,7 @@ layoutPatternBind funId binderDoc lmatch@(L _ match) = do
$ (List.intersperse docSeparator $ docForceSingleline <$> ps)
clauseDocs <- docWrapNodeRest lmatch $ layoutGrhs `mapM` grhss
mWhereDocs <- layoutLocalBinds whereBinds
- let mWhereArg = mWhereDocs <&> \d -> (mkAnnKey lmatch, d)
+ let mWhereArg = mWhereDocs <&> (,) (mkAnnKey lmatch)
let alignmentToken = if null pats then Nothing else funId
hasComments <- hasAnyCommentsBelow lmatch
layoutPatternBindFinal alignmentToken
@@ -355,7 +323,7 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs mWhereDocs ha
-- be shared between alternatives.
wherePartMultiLine :: [ToBriDocM BriDocNumbered] <- case mWhereDocs of
Nothing -> return $ []
- Just (annKeyWhere, [w]) -> fmap (pure . pure) $ docAlt
+ Just (annKeyWhere, [w]) -> pure . pure <$> docAlt
[ docEnsureIndent BrIndentRegular
$ docSeq
[ docLit $ Text.pack "where"
@@ -734,7 +702,7 @@ layoutSynDecl
:: Bool
-> (ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered)
-> Located (IdP GhcPs)
- -> [LHsTyVarBndr GhcPs]
+ -> [LHsTyVarBndr () GhcPs]
-> LHsType GhcPs
-> ToBriDocM BriDocNumbered
layoutSynDecl isInfix wrapNodeRest name vars typ = do
@@ -771,14 +739,13 @@ layoutSynDecl isInfix wrapNodeRest name vars typ = do
hasComments <- hasAnyCommentsConnected typ
layoutLhsAndType hasComments sharedLhs "=" typeDoc
-layoutTyVarBndr :: Bool -> ToBriDoc HsTyVarBndr
+layoutTyVarBndr :: Bool -> ToBriDoc (HsTyVarBndr ())
layoutTyVarBndr needsSep lbndr@(L _ bndr) = do
docWrapNodePrior lbndr $ case bndr of
- XTyVarBndr{} -> error "brittany internal error: XTyVarBndr"
- UserTyVar _ name -> do
+ UserTyVar _ _ name -> do
nameStr <- lrdrNameToTextAnn name
docSeq $ [docSeparator | needsSep] ++ [docLit nameStr]
- KindedTyVar _ name kind -> do
+ KindedTyVar _ _ name kind -> do
nameStr <- lrdrNameToTextAnn name
docSeq
$ [ docSeparator | needsSep ]
@@ -804,16 +771,10 @@ layoutTyFamInstDecl
-> ToBriDocM BriDocNumbered
layoutTyFamInstDecl inClass outerNode tfid = do
let
-#if MIN_VERSION_ghc(8,8,0)
FamEqn _ name bndrsMay pats _fixity typ = hsib_body $ tfid_eqn tfid
-- bndrsMay isJust e.g. with
-- type instance forall a . MyType (Maybe a) = Either () a
innerNode = outerNode
-#else
- FamEqn _ name pats _fixity typ = hsib_body $ tfid_eqn tfid
- bndrsMay = Nothing
- innerNode = outerNode
-#endif
docWrapNodePrior outerNode $ do
nameStr <- lrdrNameToTextAnn name
needsParens <- hasAnnKeyword outerNode AnnOpenP
@@ -822,7 +783,7 @@ layoutTyFamInstDecl inClass outerNode tfid = do
then docLit $ Text.pack "type"
else docSeq
[appSep . docLit $ Text.pack "type", docLit $ Text.pack "instance"]
- makeForallDoc :: [LHsTyVarBndr GhcPs] -> ToBriDocM BriDocNumbered
+ makeForallDoc :: [LHsTyVarBndr () GhcPs] -> ToBriDocM BriDocNumbered
makeForallDoc bndrs = do
bndrDocs <- layoutTyVarBndrs bndrs
docSeq
@@ -845,7 +806,6 @@ layoutTyFamInstDecl inClass outerNode tfid = do
layoutLhsAndType hasComments lhs "=" typeDoc
-#if MIN_VERSION_ghc(8,8,0)
layoutHsTyPats :: [HsArg (LHsType GhcPs) (LHsKind GhcPs)] -> [ToBriDocM BriDocNumbered]
layoutHsTyPats pats = pats <&> \case
HsValArg tm -> layoutType tm
@@ -854,10 +814,6 @@ layoutHsTyPats pats = pats <&> \case
-- is a bit strange. Hopefully this does not ignore any important
-- annotations.
HsArgPar _l -> error "brittany internal error: HsArgPar{}"
-#else
-layoutHsTyPats :: [LHsType GhcPs] -> [ToBriDocM BriDocNumbered]
-layoutHsTyPats pats = layoutType <$> pats
-#endif
--------------------------------------------------------------------------------
-- ClsInstDecl
@@ -881,23 +837,14 @@ layoutClsInst lcid@(L _ cid) = docLines
]
where
layoutInstanceHead :: ToBriDocM BriDocNumbered
-#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
layoutInstanceHead =
briDocByExactNoComment
$ InstD NoExtField
. ClsInstD NoExtField
. removeChildren
<$> lcid
-#else
- layoutInstanceHead =
- briDocByExactNoComment
- $ InstD NoExt
- . ClsInstD NoExt
- . removeChildren
- <$> lcid
-#endif
- removeChildren :: ClsInstDecl p -> ClsInstDecl p
+ removeChildren :: ClsInstDecl GhcPs -> ClsInstDecl GhcPs
removeChildren c = c
{ cid_binds = emptyBag
, cid_sigs = []
@@ -909,7 +856,7 @@ layoutClsInst lcid@(L _ cid) = docLines
docSortedLines
:: [ToBriDocM (Located BriDocNumbered)] -> ToBriDocM BriDocNumbered
docSortedLines l =
- allocateNode . BDFLines . fmap unLoc . List.sortOn getLoc =<< sequence l
+ allocateNode . BDFLines . fmap unLoc . List.sortOn (ExactPrint.rs . getLoc) =<< sequence l
layoutAndLocateSig :: ToBriDocC (Sig GhcPs) (Located BriDocNumbered)
layoutAndLocateSig lsig@(L loc _) = L loc <$> layoutSig lsig
diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs b/source/library/Language/Haskell/Brittany/Internal/Layouters/Expr.hs
similarity index 90%
rename from src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs
rename to source/library/Language/Haskell/Brittany/Internal/Layouters/Expr.hs
index ae514f1..9a13adf 100644
--- a/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs
+++ b/source/library/Language/Haskell/Brittany/Internal/Layouters/Expr.hs
@@ -1,38 +1,29 @@
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MonadComprehensions #-}
+{-# LANGUAGE NoImplicitPrelude #-}
-module Language.Haskell.Brittany.Internal.Layouters.Expr
- ( layoutExpr
- , litBriDoc
- , overLitValBriDoc
- )
-where
+module Language.Haskell.Brittany.Internal.Layouters.Expr where
-
-
-#include "prelude.inc"
-
-import Language.Haskell.Brittany.Internal.Types
-import Language.Haskell.Brittany.Internal.LayouterBasics
-import Language.Haskell.Brittany.Internal.Config.Types
-
-import qualified Language.Haskell.GHC.ExactPrint.Types as ExactPrint.Types
-
-import GHC ( runGhc, GenLocated(L), SrcSpan, moduleNameString, AnnKeywordId(..), RdrName(..) )
-#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
-import GHC.Hs
-#else
-import HsSyn
-#endif
-import Name
-import qualified FastString
-import BasicTypes
-
-import Language.Haskell.Brittany.Internal.Utils
-import Language.Haskell.Brittany.Internal.Layouters.Pattern
-import Language.Haskell.Brittany.Internal.Layouters.Decl
-import Language.Haskell.Brittany.Internal.Layouters.Stmt
-import Language.Haskell.Brittany.Internal.Layouters.Type
+import qualified Data.Data
+import qualified Data.Semigroup as Semigroup
+import qualified Data.Sequence as Seq
+import qualified Data.Text as Text
+import GHC (AnnKeywordId(..), GenLocated(L), RdrName(..), SrcSpan)
+import qualified GHC.Data.FastString as FastString
+import GHC.Hs
+import qualified GHC.OldList as List
+import GHC.Types.Basic
+import GHC.Types.Name
+import Language.Haskell.Brittany.Internal.Config.Types
+import Language.Haskell.Brittany.Internal.LayouterBasics
+import Language.Haskell.Brittany.Internal.Layouters.Decl
+import Language.Haskell.Brittany.Internal.Layouters.Pattern
+import Language.Haskell.Brittany.Internal.Layouters.Stmt
+import Language.Haskell.Brittany.Internal.Layouters.Type
+import Language.Haskell.Brittany.Internal.Prelude
+import Language.Haskell.Brittany.Internal.PreludeUtils
+import Language.Haskell.Brittany.Internal.Types
+import Language.Haskell.Brittany.Internal.Utils
@@ -46,9 +37,8 @@ layoutExpr lexpr@(L _ expr) = do
docWrapNode lexpr $ case expr of
HsVar _ vname -> do
docLit =<< lrdrNameToTextAnn vname
- HsUnboundVar _ var -> case var of
- OutOfScope oname _ -> docLit $ Text.pack $ occNameString oname
- TrueExprHole oname -> docLit $ Text.pack $ occNameString oname
+ HsUnboundVar _ oname ->
+ docLit $ Text.pack $ occNameString oname
HsRecFld{} -> do
-- TODO
briDocByExactInlineOnly "HsRecFld" lexpr
@@ -79,8 +69,8 @@ layoutExpr lexpr@(L _ expr) = do
-- by wrapping it in docSeq below. We _could_ add alignments for
-- stuff like lists-of-lambdas. Nothing terribly important..)
let shouldPrefixSeparator = case p of
- (ghcDL -> L _ LazyPat{}) -> isFirst
- (ghcDL -> L _ BangPat{}) -> isFirst
+ L _ LazyPat{} -> isFirst
+ L _ BangPat{} -> isFirst
_ -> False
patDocSeq <- layoutPat p
fixed <- case Seq.viewl patDocSeq of
@@ -132,8 +122,6 @@ layoutExpr lexpr@(L _ expr) = do
]
HsLam{} ->
unknownNodeError "HsLam too complex" lexpr
- HsLamCase _ XMatchGroup{} ->
- error "brittany internal error: HsLamCase XMatchGroup"
HsLamCase _ (MG _ (L _ []) _) -> do
docSetParSpacing $ docAddBaseY BrIndentRegular $
(docLit $ Text.pack "\\case {}")
@@ -235,15 +223,7 @@ layoutExpr lexpr@(L _ expr) = do
expDoc1
expDoc2
]
-#if MIN_VERSION_ghc(8,8,0) /* ghc-8.8 */
- HsAppType _ _ XHsWildCardBndrs{} ->
- error "brittany internal error: HsAppType XHsWildCardBndrs"
HsAppType _ exp1 (HsWC _ ty1) -> do
-#else
- HsAppType XHsWildCardBndrs{} _ ->
- error "brittany internal error: HsAppType XHsWildCardBndrs"
- HsAppType (HsWC _ ty1) exp1 -> do
-#endif
t <- docSharedWrapper layoutType ty1
e <- docSharedWrapper layoutExpr exp1
docAlt
@@ -400,17 +380,9 @@ layoutExpr lexpr@(L _ expr) = do
rightDoc <- docSharedWrapper layoutExpr right
docSeq [opDoc, docSeparator, rightDoc]
ExplicitTuple _ args boxity -> do
-#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
let argExprs = args <&> \arg -> case arg of
(L _ (Present _ e)) -> (arg, Just e);
(L _ (Missing NoExtField)) -> (arg, Nothing)
- (L _ XTupArg{}) -> error "brittany internal error: XTupArg"
-#else
- let argExprs = args <&> \arg -> case arg of
- (L _ (Present _ e)) -> (arg, Just e);
- (L _ (Missing NoExt)) -> (arg, Nothing)
- (L _ XTupArg{}) -> error "brittany internal error: XTupArg"
-#endif
argDocs <- forM argExprs
$ docSharedWrapper
$ \(arg, exprM) -> docWrapNode arg $ maybe docEmpty layoutExpr exprM
@@ -455,8 +427,6 @@ layoutExpr lexpr@(L _ expr) = do
lineN = docCols ColTuples [docCommaSep, docNodeAnnKW lexpr (Just AnnOpenP) eN]
end = closeLit
in docSetBaseY $ docLines $ [start] ++ linesM ++ [lineN, end]
- HsCase _ _ XMatchGroup{} ->
- error "brittany internal error: HsCase XMatchGroup"
HsCase _ cExp (MG _ (L _ []) _) -> do
cExpDoc <- docSharedWrapper layoutExpr cExp
docAlt
@@ -496,7 +466,7 @@ layoutExpr lexpr@(L _ expr) = do
(docSetBaseAndIndent $ docNonBottomSpacing $ docLines $ return <$> funcPatDocs)
)
]
- HsIf _ _ ifExpr thenExpr elseExpr -> do
+ HsIf _ ifExpr thenExpr elseExpr -> do
ifExprDoc <- docSharedWrapper layoutExpr ifExpr
thenExprDoc <- docSharedWrapper layoutExpr thenExpr
elseExprDoc <- docSharedWrapper layoutExpr elseExpr
@@ -620,7 +590,7 @@ layoutExpr lexpr@(L _ expr) = do
expDoc1 <- docSharedWrapper layoutExpr exp1
-- We jump through some ugly hoops here to ensure proper sharing.
hasComments <- hasAnyCommentsBelow lexpr
- mBindDocs <- fmap (fmap (fmap pure)) $ layoutLocalBinds binds
+ mBindDocs <- fmap (fmap pure) <$> layoutLocalBinds binds
let
ifIndentFreeElse :: a -> a -> a
ifIndentFreeElse x y =
@@ -723,14 +693,14 @@ layoutExpr lexpr@(L _ expr) = do
_ -> docSeq [appSep $ docLit $ Text.pack "let in", expDoc1]
-- docSeq [appSep $ docLit "let in", expDoc1]
HsDo _ stmtCtx (L _ stmts) -> case stmtCtx of
- DoExpr -> do
+ DoExpr _ -> do
stmtDocs <- docSharedWrapper layoutStmt `mapM` stmts
docSetParSpacing
$ docAddBaseY BrIndentRegular
$ docPar
(docLit $ Text.pack "do")
(docSetBaseAndIndent $ docNonBottomSpacing $ docLines stmtDocs)
- MDoExpr -> do
+ MDoExpr _ -> do
stmtDocs <- docSharedWrapper layoutStmt `mapM` stmts
docSetParSpacing
$ docAddBaseY BrIndentRegular
@@ -829,18 +799,10 @@ layoutExpr lexpr@(L _ expr) = do
else Just <$> docSharedWrapper layoutExpr rFExpr
return $ (lfield, lrdrNameToText lnameF, rFExpDoc)
recordExpression False indentPolicy lexpr nameDoc rFs
-#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
HsRecFields [] (Just (L _ 0)) -> do
-#else
- HsRecFields [] (Just 0) -> do
-#endif
let t = lrdrNameToText lname
docWrapNode lname $ docLit $ t <> Text.pack " { .. }"
-#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
HsRecFields fs@(_:_) (Just (L _ dotdoti)) | dotdoti == length fs -> do
-#else
- HsRecFields fs@(_:_) (Just dotdoti) | dotdoti == length fs -> do
-#endif
let nameDoc = docWrapNode lname $ docLit $ lrdrNameToText lname
fieldDocs <- fs `forM` \fieldl@(L _ (HsRecField (L _ fieldOcc) fExpr pun)) -> do
let FieldOcc _ lnameF = fieldOcc
@@ -860,22 +822,8 @@ layoutExpr lexpr@(L _ expr) = do
return $ case ambName of
Unambiguous _ n -> (lfield, lrdrNameToText n, rFExpDoc)
Ambiguous _ n -> (lfield, lrdrNameToText n, rFExpDoc)
- XAmbiguousFieldOcc{} ->
- error "brittany internal error: XAmbiguousFieldOcc"
recordExpression False indentPolicy lexpr rExprDoc rFs
-#if MIN_VERSION_ghc(8,8,0) /* ghc-8.6 */
- ExprWithTySig _ _ (HsWC _ XHsImplicitBndrs{}) ->
- error "brittany internal error: ExprWithTySig HsWC XHsImplicitBndrs"
- ExprWithTySig _ _ XHsWildCardBndrs{} ->
- error "brittany internal error: ExprWithTySig XHsWildCardBndrs"
ExprWithTySig _ exp1 (HsWC _ (HsIB _ typ1)) -> do
-#else
- ExprWithTySig (HsWC _ XHsImplicitBndrs{}) _ ->
- error "brittany internal error: ExprWithTySig HsWC XHsImplicitBndrs"
- ExprWithTySig XHsWildCardBndrs{} _ ->
- error "brittany internal error: ExprWithTySig XHsWildCardBndrs"
- ExprWithTySig (HsWC _ (HsIB _ typ1)) exp1 -> do
-#endif
expDoc <- docSharedWrapper layoutExpr exp1
typDoc <- docSharedWrapper layoutType typ1
docSeq
@@ -927,12 +875,6 @@ layoutExpr lexpr@(L _ expr) = do
]
ArithSeq{} ->
briDocByExactInlineOnly "ArithSeq" lexpr
- HsSCC{} -> do
- -- TODO
- briDocByExactInlineOnly "HsSCC{}" lexpr
- HsCoreAnn{} -> do
- -- TODO
- briDocByExactInlineOnly "HsCoreAnn{}" lexpr
HsBracket{} -> do
-- TODO
briDocByExactInlineOnly "HsBracket{}" lexpr
@@ -959,50 +901,21 @@ layoutExpr lexpr@(L _ expr) = do
HsStatic{} -> do
-- TODO
briDocByExactInlineOnly "HsStatic{}" lexpr
-#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
-#else
- HsArrApp{} -> do
- -- TODO
- briDocByExactInlineOnly "HsArrApp{}" lexpr
- HsArrForm{} -> do
- -- TODO
- briDocByExactInlineOnly "HsArrForm{}" lexpr
-#endif
HsTick{} -> do
-- TODO
briDocByExactInlineOnly "HsTick{}" lexpr
HsBinTick{} -> do
-- TODO
briDocByExactInlineOnly "HsBinTick{}" lexpr
- HsTickPragma{} -> do
- -- TODO
- briDocByExactInlineOnly "HsTickPragma{}" lexpr
-#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
-#else
- EWildPat{} -> do
- docLit $ Text.pack "_"
- EAsPat _ asName asExpr -> do
- docSeq
- [ docLit $ lrdrNameToText asName <> Text.pack "@"
- , layoutExpr asExpr
- ]
- EViewPat{} -> do
- -- TODO
- briDocByExactInlineOnly "EViewPat{}" lexpr
- ELazyPat{} -> do
- -- TODO
- briDocByExactInlineOnly "ELazyPat{}" lexpr
-#endif
- HsWrap{} -> do
- -- TODO
- briDocByExactInlineOnly "HsWrap{}" lexpr
HsConLikeOut{} -> do
-- TODO
briDocByExactInlineOnly "HsWrap{}" lexpr
ExplicitSum{} -> do
-- TODO
briDocByExactInlineOnly "ExplicitSum{}" lexpr
- XExpr{} -> error "brittany internal error: XExpr"
+ HsPragE{} -> do
+ -- TODO
+ briDocByExactInlineOnly "HsPragE{}" lexpr
recordExpression
:: (Data.Data.Data lExpr, Data.Data.Data name)
diff --git a/source/library/Language/Haskell/Brittany/Internal/Layouters/Expr.hs-boot b/source/library/Language/Haskell/Brittany/Internal/Layouters/Expr.hs-boot
new file mode 100644
index 0000000..4f913c3
--- /dev/null
+++ b/source/library/Language/Haskell/Brittany/Internal/Layouters/Expr.hs-boot
@@ -0,0 +1,16 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+
+module Language.Haskell.Brittany.Internal.Layouters.Expr where
+
+import GHC.Hs
+import Language.Haskell.Brittany.Internal.Types
+
+
+
+layoutExpr :: ToBriDoc HsExpr
+
+-- layoutStmt :: ToBriDoc' (StmtLR GhcPs GhcPs (LHsExpr GhcPs))
+
+litBriDoc :: HsLit GhcPs -> BriDocFInt
+
+overLitValBriDoc :: OverLitVal -> BriDocFInt
diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/IE.hs b/source/library/Language/Haskell/Brittany/Internal/Layouters/IE.hs
similarity index 85%
rename from src/Language/Haskell/Brittany/Internal/Layouters/IE.hs
rename to source/library/Language/Haskell/Brittany/Internal/Layouters/IE.hs
index 2a722d1..78c56e4 100644
--- a/src/Language/Haskell/Brittany/Internal/Layouters/IE.hs
+++ b/source/library/Language/Haskell/Brittany/Internal/Layouters/IE.hs
@@ -1,38 +1,25 @@
-module Language.Haskell.Brittany.Internal.Layouters.IE
- ( layoutIE
- , layoutLLIEs
- , layoutAnnAndSepLLIEs
- , SortItemsFlag(..)
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MultiWayIf #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+
+module Language.Haskell.Brittany.Internal.Layouters.IE where
+
+import qualified Data.List.Extra
+import qualified Data.Text as Text
+import GHC
+ ( AnnKeywordId(..)
+ , GenLocated(L)
+ , Located
+ , ModuleName
+ , moduleNameString
+ , unLoc
)
-where
-
-#include "prelude.inc"
-
-import Language.Haskell.Brittany.Internal.Types
-import Language.Haskell.Brittany.Internal.LayouterBasics
-import Language.Haskell.Brittany.Internal.Config.Types
-
-import GHC ( unLoc
- , runGhc
- , GenLocated(L)
- , moduleNameString
- , AnnKeywordId(..)
- , Located
- , ModuleName
- )
-#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
-import GHC.Hs
-import GHC.Hs.ImpExp
-#else
-import HsSyn
-import HsImpExp
-#endif
-import Name
-import FieldLabel
-import qualified FastString
-import BasicTypes
-
-import Language.Haskell.Brittany.Internal.Utils
+import GHC.Hs
+import qualified GHC.OldList as List
+import Language.Haskell.Brittany.Internal.LayouterBasics
+import Language.Haskell.Brittany.Internal.Prelude
+import Language.Haskell.Brittany.Internal.Types
+import Language.Haskell.Brittany.Internal.Utils
@@ -66,7 +53,7 @@ layoutIE lie@(L _ ie) = docWrapNode lie $ case ie of
(layoutWrapped lie x)
(layoutItems (splitFirstLast sortedNs))
where
- nameDoc = (docLit =<<) . lrdrNameToTextAnn . prepareName
+ nameDoc = docLit <=< lrdrNameToTextAnn . prepareName
layoutItem n = docSeq [docCommaSep, docWrapNode n $ nameDoc n]
layoutItems FirstLastEmpty = docSetBaseY $ docLines
[docSeq [docParenLSep, docNodeAnnKW lie (Just AnnOpenP) docEmpty], docParenR]
@@ -219,10 +206,9 @@ lieToText = \case
-- Need to check, and either put them at the top (for module) or do some
-- other clever thing.
L _ (IEModuleContents _ n) -> moduleNameToText n
- L _ (IEGroup _ _ _ ) -> Text.pack "@IEGroup"
- L _ (IEDoc _ _ ) -> Text.pack "@IEDoc"
- L _ (IEDocNamed _ _ ) -> Text.pack "@IEDocNamed"
- L _ (XIE _ ) -> Text.pack "@XIE"
+ L _ IEGroup{} -> Text.pack "@IEGroup"
+ L _ IEDoc{} -> Text.pack "@IEDoc"
+ L _ IEDocNamed{} -> Text.pack "@IEDocNamed"
where
moduleNameToText :: Located ModuleName -> Text
moduleNameToText (L _ name) = Text.pack ("@IEModuleContents" ++ moduleNameString name)
diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Import.hs b/source/library/Language/Haskell/Brittany/Internal/Layouters/Import.hs
similarity index 78%
rename from src/Language/Haskell/Brittany/Internal/Layouters/Import.hs
rename to source/library/Language/Haskell/Brittany/Internal/Layouters/Import.hs
index e23c11b..d8ff3ff 100644
--- a/src/Language/Haskell/Brittany/Internal/Layouters/Import.hs
+++ b/source/library/Language/Haskell/Brittany/Internal/Layouters/Import.hs
@@ -1,29 +1,19 @@
-module Language.Haskell.Brittany.Internal.Layouters.Import (layoutImport) where
+{-# LANGUAGE NoImplicitPrelude #-}
-#include "prelude.inc"
+module Language.Haskell.Brittany.Internal.Layouters.Import where
-import Language.Haskell.Brittany.Internal.Types
-import Language.Haskell.Brittany.Internal.LayouterBasics
-import Language.Haskell.Brittany.Internal.Layouters.IE
-import Language.Haskell.Brittany.Internal.Config.Types
-
-import GHC ( unLoc
- , GenLocated(L)
- , moduleNameString
- , Located
- )
-#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
-import GHC.Hs
-#else
-import HsSyn
-#endif
-import Name
-import FieldLabel
-import qualified FastString
-import BasicTypes
-import qualified Language.Haskell.GHC.ExactPrint.Types as ExactPrint.Types
-
-import Language.Haskell.Brittany.Internal.Utils
+import qualified Data.Semigroup as Semigroup
+import qualified Data.Text as Text
+import GHC (GenLocated(L), Located, moduleNameString, unLoc)
+import GHC.Hs
+import GHC.Types.Basic
+import GHC.Unit.Types (IsBootInterface(..))
+import Language.Haskell.Brittany.Internal.Config.Types
+import Language.Haskell.Brittany.Internal.LayouterBasics
+import Language.Haskell.Brittany.Internal.Layouters.IE
+import Language.Haskell.Brittany.Internal.Prelude
+import Language.Haskell.Brittany.Internal.PreludeUtils
+import Language.Haskell.Brittany.Internal.Types
@@ -50,14 +40,10 @@ layoutImport importD = case importD of
hiding = maybe False fst mllies
minQLength = length "import qualified "
qLengthReal =
-#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
let qualifiedPart = if q /= NotQualified then length "qualified " else 0
-#else
- let qualifiedPart = if q then length "qualified " else 0
-#endif
safePart = if safe then length "safe " else 0
pkgPart = maybe 0 ((+ 1) . Text.length) pkgNameT
- srcPart = if src then length "{-# SOURCE #-} " else 0
+ srcPart = case src of { IsBoot -> length "{-# SOURCE #-} "; NotBoot -> 0 }
in length "import " + srcPart + safePart + qualifiedPart + pkgPart
qLength = max minQLength qLengthReal
-- Cost in columns of importColumn
@@ -66,13 +52,9 @@ layoutImport importD = case importD of
nameCost = Text.length modNameT + qLength
importQualifiers = docSeq
[ appSep $ docLit $ Text.pack "import"
- , if src then appSep $ docLit $ Text.pack "{-# SOURCE #-}" else docEmpty
+ , case src of { IsBoot -> appSep $ docLit $ Text.pack "{-# SOURCE #-}"; NotBoot -> docEmpty }
, if safe then appSep $ docLit $ Text.pack "safe" else docEmpty
-#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
, if q /= NotQualified then appSep $ docLit $ Text.pack "qualified" else docEmpty
-#else
- , if q then appSep $ docLit $ Text.pack "qualified" else docEmpty
-#endif
, maybe docEmpty (appSep . docLit) pkgNameT
]
indentName =
diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Module.hs b/source/library/Language/Haskell/Brittany/Internal/Layouters/Module.hs
similarity index 83%
rename from src/Language/Haskell/Brittany/Internal/Layouters/Module.hs
rename to source/library/Language/Haskell/Brittany/Internal/Layouters/Module.hs
index 7887489..73090ce 100644
--- a/src/Language/Haskell/Brittany/Internal/Layouters/Module.hs
+++ b/source/library/Language/Haskell/Brittany/Internal/Layouters/Module.hs
@@ -1,49 +1,37 @@
-{-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NoImplicitPrelude #-}
-module Language.Haskell.Brittany.Internal.Layouters.Module (layoutModule) where
+module Language.Haskell.Brittany.Internal.Layouters.Module where
-#include "prelude.inc"
-
-import Language.Haskell.Brittany.Internal.Types
-import Language.Haskell.Brittany.Internal.LayouterBasics
-import Language.Haskell.Brittany.Internal.Layouters.IE
-import Language.Haskell.Brittany.Internal.Layouters.Import
-import Language.Haskell.Brittany.Internal.Config.Types
-
-import GHC (unLoc, runGhc, GenLocated(L), moduleNameString, AnnKeywordId(..))
-#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
-import GHC.Hs
-import GHC.Hs.ImpExp
-#else
-import HsSyn
-import HsImpExp
-#endif
-import Name
-import FieldLabel
-import qualified FastString
-import BasicTypes
-import Language.Haskell.GHC.ExactPrint as ExactPrint
-import qualified Language.Haskell.GHC.ExactPrint.Types as ExactPrint.Types
-import Language.Haskell.GHC.ExactPrint.Types
- ( DeltaPos(..)
- , deltaRow
- , commentContents
- )
-
-import Language.Haskell.Brittany.Internal.Utils
+import qualified Data.Maybe
+import qualified Data.Semigroup as Semigroup
+import qualified Data.Text as Text
+import GHC (AnnKeywordId(..), GenLocated(L), moduleNameString, unLoc)
+import GHC.Hs
+import qualified GHC.OldList as List
+import Language.Haskell.Brittany.Internal.Config.Types
+import Language.Haskell.Brittany.Internal.LayouterBasics
+import Language.Haskell.Brittany.Internal.Layouters.IE
+import Language.Haskell.Brittany.Internal.Layouters.Import
+import Language.Haskell.Brittany.Internal.Prelude
+import Language.Haskell.Brittany.Internal.PreludeUtils
+import Language.Haskell.Brittany.Internal.Types
+import Language.Haskell.GHC.ExactPrint as ExactPrint
+import Language.Haskell.GHC.ExactPrint.Types
+ (DeltaPos(..), commentContents, deltaRow)
-layoutModule :: ToBriDoc HsModule
+layoutModule :: ToBriDoc' HsModule
layoutModule lmod@(L _ mod') = case mod' of
-- Implicit module Main
- HsModule Nothing _ imports _ _ _ -> do
+ HsModule _ Nothing _ imports _ _ _ -> do
commentedImports <- transformToCommentedImport imports
-- groupify commentedImports `forM_` tellDebugMessShow
docLines (commentedImportsToDoc <$> sortCommentedImports commentedImports)
-- sortedImports <- sortImports imports
-- docLines $ [layoutImport y i | (y, i) <- sortedImports]
- HsModule (Just n) les imports _ _ _ -> do
+ HsModule _ (Just n) les imports _ _ _ -> do
commentedImports <- transformToCommentedImport imports
-- groupify commentedImports `forM_` tellDebugMessShow
-- sortedImports <- sortImports imports
diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Pattern.hs b/source/library/Language/Haskell/Brittany/Internal/Layouters/Pattern.hs
similarity index 79%
rename from src/Language/Haskell/Brittany/Internal/Layouters/Pattern.hs
rename to source/library/Language/Haskell/Brittany/Internal/Layouters/Pattern.hs
index 037d693..fd4025a 100644
--- a/src/Language/Haskell/Brittany/Internal/Layouters/Pattern.hs
+++ b/source/library/Language/Haskell/Brittany/Internal/Layouters/Pattern.hs
@@ -1,36 +1,21 @@
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NoImplicitPrelude #-}
-module Language.Haskell.Brittany.Internal.Layouters.Pattern
- ( layoutPat
- , colsWrapPat
- )
-where
-
-
-
-#include "prelude.inc"
-
-import Language.Haskell.Brittany.Internal.Types
-import Language.Haskell.Brittany.Internal.LayouterBasics
-
-import GHC ( Located
- , runGhc
- , GenLocated(L)
- , moduleNameString
- , ol_val
- )
-import qualified GHC
-#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
-import GHC.Hs
-#else
-import HsSyn
-#endif
-import Name
-import BasicTypes
+module Language.Haskell.Brittany.Internal.Layouters.Pattern where
+import qualified Data.Foldable as Foldable
+import qualified Data.Sequence as Seq
+import qualified Data.Text as Text
+import GHC (GenLocated(L), ol_val)
+import GHC.Hs
+import qualified GHC.OldList as List
+import GHC.Types.Basic
+import Language.Haskell.Brittany.Internal.LayouterBasics
import {-# SOURCE #-} Language.Haskell.Brittany.Internal.Layouters.Expr
-import Language.Haskell.Brittany.Internal.Layouters.Type
+import Language.Haskell.Brittany.Internal.Layouters.Type
+import Language.Haskell.Brittany.Internal.Prelude
+import Language.Haskell.Brittany.Internal.PreludeUtils
+import Language.Haskell.Brittany.Internal.Types
@@ -45,7 +30,7 @@ import Language.Haskell.Brittany.Internal.Layouters.Type
-- We will use `case .. of` as the imagined prefix to the examples used in
-- the different cases below.
layoutPat :: LPat GhcPs -> ToBriDocM (Seq BriDocNumbered)
-layoutPat (ghcDL -> lpat@(L _ pat)) = docWrapNode lpat $ case pat of
+layoutPat lpat@(L _ pat) = docWrapNode lpat $ case pat of
WildPat _ -> fmap Seq.singleton $ docLit $ Text.pack "_"
-- _ -> expr
VarPat _ n ->
@@ -54,11 +39,7 @@ layoutPat (ghcDL -> lpat@(L _ pat)) = docWrapNode lpat $ case pat of
LitPat _ lit ->
fmap Seq.singleton $ allocateNode $ litBriDoc lit
-- 0 -> expr
-#if MIN_VERSION_ghc(8,8,0) /* ghc-8.8 */
ParPat _ inner -> do
-#else
- ParPat _ inner -> do
-#endif
-- (nestedpat) -> expr
left <- docLit $ Text.pack "("
right <- docLit $ Text.pack ")"
@@ -78,7 +59,7 @@ layoutPat (ghcDL -> lpat@(L _ pat)) = docWrapNode lpat $ case pat of
-- x1' <- docSeq [docLit $ Text.pack "(", return x1]
-- xN' <- docSeq [return xN, docLit $ Text.pack ")"]
-- return $ (x1' Seq.<| middle) Seq.|> xN'
- ConPatIn lname (PrefixCon args) -> do
+ ConPat _ lname (PrefixCon args) -> do
-- Abc a b c -> expr
nameDoc <- lrdrNameToTextAnn lname
argDocs <- layoutPat `mapM` args
@@ -91,18 +72,18 @@ layoutPat (ghcDL -> lpat@(L _ pat)) = docWrapNode lpat $ case pat of
$ spacifyDocs
$ fmap colsWrapPat argDocs
return $ x1 Seq.<| xR
- ConPatIn lname (InfixCon left right) -> do
+ ConPat _ lname (InfixCon left right) -> do
-- a :< b -> expr
nameDoc <- lrdrNameToTextAnn lname
leftDoc <- appSep . colsWrapPat =<< layoutPat left
rightDoc <- colsWrapPat =<< layoutPat right
middle <- appSep $ docLit nameDoc
return $ Seq.empty Seq.|> leftDoc Seq.|> middle Seq.|> rightDoc
- ConPatIn lname (RecCon (HsRecFields [] Nothing)) -> do
+ ConPat _ lname (RecCon (HsRecFields [] Nothing)) -> do
-- Abc{} -> expr
let t = lrdrNameToText lname
fmap Seq.singleton $ docLit $ t <> Text.pack "{}"
- ConPatIn lname (RecCon (HsRecFields fs@(_:_) Nothing)) -> do
+ ConPat _ lname (RecCon (HsRecFields fs@(_:_) Nothing)) -> do
-- Abc { a = locA, b = locB, c = locC } -> expr1
-- Abc { a, b, c } -> expr2
let t = lrdrNameToText lname
@@ -126,22 +107,14 @@ layoutPat (ghcDL -> lpat@(L _ pat)) = docWrapNode lpat $ case pat of
, docSeparator
, docLit $ Text.pack "}"
]
-#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
- ConPatIn lname (RecCon (HsRecFields [] (Just (L _ 0)))) -> do
-#else
- ConPatIn lname (RecCon (HsRecFields [] (Just 0))) -> do
-#endif
+ ConPat _ lname (RecCon (HsRecFields [] (Just (L _ 0)))) -> do
-- Abc { .. } -> expr
let t = lrdrNameToText lname
Seq.singleton <$> docSeq
[ appSep $ docLit t
, docLit $ Text.pack "{..}"
]
-#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
- ConPatIn lname (RecCon (HsRecFields fs@(_:_) (Just (L _ dotdoti)))) | dotdoti == length fs -> do
-#else
- ConPatIn lname (RecCon (HsRecFields fs@(_:_) (Just dotdoti))) | dotdoti == length fs -> do
-#endif
+ ConPat _ lname (RecCon (HsRecFields fs@(_:_) (Just (L _ dotdoti)))) | dotdoti == length fs -> do
-- Abc { a = locA, .. }
let t = lrdrNameToText lname
fds <- fs `forM` \(L _ (HsRecField (L _ fieldOcc) fPat pun)) -> do
@@ -172,11 +145,7 @@ layoutPat (ghcDL -> lpat@(L _ pat)) = docWrapNode lpat $ case pat of
AsPat _ asName asPat -> do
-- bind@nestedpat -> expr
wrapPatPrepend asPat (docLit $ lrdrNameToText asName <> Text.pack "@")
-#if MIN_VERSION_ghc(8,8,0) /* ghc-8.8 */
- SigPat _ pat1 (HsWC _ (HsIB _ ty1)) -> do
-#else
- SigPat (HsWC _ (HsIB _ ty1)) pat1 -> do
-#endif
+ SigPat _ pat1 (HsPS _ ty1) -> do
-- i :: Int -> expr
patDocs <- layoutPat pat1
tyDoc <- docSharedWrapper layoutType ty1
@@ -214,7 +183,7 @@ layoutPat (ghcDL -> lpat@(L _ pat)) = docWrapNode lpat $ case pat of
Just{} -> Seq.fromList [negDoc, litDoc]
Nothing -> Seq.singleton litDoc
- _ -> return <$> briDocByExactInlineOnly "some unknown pattern" (ghcDL lpat)
+ _ -> return <$> briDocByExactInlineOnly "some unknown pattern" lpat
colsWrapPat :: Seq BriDocNumbered -> ToBriDocM BriDocNumbered
colsWrapPat = docCols ColPatterns . fmap return . Foldable.toList
diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Stmt.hs b/source/library/Language/Haskell/Brittany/Internal/Layouters/Stmt.hs
similarity index 78%
rename from src/Language/Haskell/Brittany/Internal/Layouters/Stmt.hs
rename to source/library/Language/Haskell/Brittany/Internal/Layouters/Stmt.hs
index 5427d7a..7f297fe 100644
--- a/src/Language/Haskell/Brittany/Internal/Layouters/Stmt.hs
+++ b/source/library/Language/Haskell/Brittany/Internal/Layouters/Stmt.hs
@@ -1,34 +1,21 @@
-{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE ScopedTypeVariables #-}
-module Language.Haskell.Brittany.Internal.Layouters.Stmt
- ( layoutStmt
- )
-where
+module Language.Haskell.Brittany.Internal.Layouters.Stmt where
-
-
-#include "prelude.inc"
-
-import Language.Haskell.Brittany.Internal.Types
-import Language.Haskell.Brittany.Internal.LayouterBasics
-import Language.Haskell.Brittany.Internal.Config.Types
-
-import GHC ( runGhc
- , GenLocated(L)
- , moduleNameString
- )
-#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
-import GHC.Hs
-#else
-import HsSyn
-#endif
-import Name
-import qualified FastString
-import BasicTypes
-
-import Language.Haskell.Brittany.Internal.Layouters.Pattern
-import Language.Haskell.Brittany.Internal.Layouters.Decl
+import qualified Data.Semigroup as Semigroup
+import qualified Data.Text as Text
+import GHC (GenLocated(L))
+import GHC.Hs
+import Language.Haskell.Brittany.Internal.Config.Types
+import Language.Haskell.Brittany.Internal.LayouterBasics
+import Language.Haskell.Brittany.Internal.Layouters.Decl
import {-# SOURCE #-} Language.Haskell.Brittany.Internal.Layouters.Expr
+import Language.Haskell.Brittany.Internal.Layouters.Pattern
+import Language.Haskell.Brittany.Internal.Prelude
+import Language.Haskell.Brittany.Internal.PreludeUtils
+import Language.Haskell.Brittany.Internal.Types
@@ -38,9 +25,9 @@ layoutStmt lstmt@(L _ stmt) = do
indentAmount :: Int <-
mAsk <&> _conf_layout .> _lconfig_indentAmount .> confUnpack
docWrapNode lstmt $ case stmt of
- LastStmt _ body False _ -> do
+ LastStmt _ body Nothing _ -> do
layoutExpr body
- BindStmt _ lPat expr _ _ -> do
+ BindStmt _ lPat expr -> do
patDoc <- fmap return $ colsWrapPat =<< layoutPat lPat
expDoc <- docSharedWrapper layoutExpr expr
docAlt
diff --git a/source/library/Language/Haskell/Brittany/Internal/Layouters/Stmt.hs-boot b/source/library/Language/Haskell/Brittany/Internal/Layouters/Stmt.hs-boot
new file mode 100644
index 0000000..6cfd5c8
--- /dev/null
+++ b/source/library/Language/Haskell/Brittany/Internal/Layouters/Stmt.hs-boot
@@ -0,0 +1,10 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+
+module Language.Haskell.Brittany.Internal.Layouters.Stmt where
+
+import GHC.Hs
+import Language.Haskell.Brittany.Internal.Types
+
+
+
+layoutStmt :: ToBriDoc' (StmtLR GhcPs GhcPs (LHsExpr GhcPs))
diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Type.hs b/source/library/Language/Haskell/Brittany/Internal/Layouters/Type.hs
similarity index 92%
rename from src/Language/Haskell/Brittany/Internal/Layouters/Type.hs
rename to source/library/Language/Haskell/Brittany/Internal/Layouters/Type.hs
index 3437fcd..208f6b4 100644
--- a/src/Language/Haskell/Brittany/Internal/Layouters/Type.hs
+++ b/source/library/Language/Haskell/Brittany/Internal/Layouters/Type.hs
@@ -1,41 +1,20 @@
-{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NoImplicitPrelude #-}
-module Language.Haskell.Brittany.Internal.Layouters.Type
- ( layoutType
- , layoutTyVarBndrs
- , processTyVarBndrsSingleline
- )
-where
+module Language.Haskell.Brittany.Internal.Layouters.Type where
-
-
-#include "prelude.inc"
-
-import Language.Haskell.Brittany.Internal.Config.Types
-import Language.Haskell.Brittany.Internal.Types
-import Language.Haskell.Brittany.Internal.LayouterBasics
-import Language.Haskell.Brittany.Internal.Utils
- ( splitFirstLast
- , FirstLastView(..)
- )
-
-import GHC ( runGhc
- , GenLocated(L)
- , moduleNameString
- , AnnKeywordId (..)
- )
-import Language.Haskell.GHC.ExactPrint.Types ( mkAnnKey )
-#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
-import GHC.Hs
-#else
-import HsSyn
-#endif
-import Name
-import Outputable ( ftext, showSDocUnsafe )
-import BasicTypes
-import qualified SrcLoc
-
-import DataTreePrint
+import qualified Data.Text as Text
+import GHC (AnnKeywordId(..), GenLocated(L))
+import GHC.Hs
+import qualified GHC.OldList as List
+import GHC.Types.Basic
+import GHC.Utils.Outputable (ftext, showSDocUnsafe)
+import Language.Haskell.Brittany.Internal.LayouterBasics
+import Language.Haskell.Brittany.Internal.Prelude
+import Language.Haskell.Brittany.Internal.PreludeUtils
+import Language.Haskell.Brittany.Internal.Types
+import Language.Haskell.Brittany.Internal.Utils
+ (FirstLastView(..), splitFirstLast)
@@ -45,21 +24,14 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
HsTyVar _ promoted name -> do
t <- lrdrNameToTextAnnTypeEqualityIsSpecial name
case promoted of
-#if MIN_VERSION_ghc(8,8,0)
IsPromoted -> docSeq
-#else /* ghc-8.6 */
- Promoted -> docSeq
-#endif
[ docSeparator
, docTick
, docWrapNode name $ docLit t
]
NotPromoted -> docWrapNode name $ docLit t
-#if MIN_VERSION_ghc(8,10,1)
- HsForAllTy _ _ bndrs (L _ (HsQualTy _ (L _ cntxts) typ2)) -> do
-#else
- HsForAllTy _ bndrs (L _ (HsQualTy _ (L _ cntxts) typ2)) -> do
-#endif
+ HsForAllTy _ hsf (L _ (HsQualTy _ (L _ cntxts) typ2)) -> do
+ let bndrs = getBinders hsf
typeDoc <- docSharedWrapper layoutType typ2
tyVarDocs <- layoutTyVarBndrs bndrs
cntxtDocs <- cntxts `forM` docSharedWrapper layoutType
@@ -145,11 +117,8 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
]
)
]
-#if MIN_VERSION_ghc(8,10,1)
- HsForAllTy _ _ bndrs typ2 -> do
-#else
- HsForAllTy _ bndrs typ2 -> do
-#endif
+ HsForAllTy _ hsf typ2 -> do
+ let bndrs = getBinders hsf
typeDoc <- layoutType typ2
tyVarDocs <- layoutTyVarBndrs bndrs
let maybeForceML = case typ2 of
@@ -254,7 +223,7 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
]
)
]
- HsFunTy _ typ1 typ2 -> do
+ HsFunTy _ _ typ1 typ2 -> do
typeDoc1 <- docSharedWrapper layoutType typ1
typeDoc2 <- docSharedWrapper layoutType typ2
let maybeForceML = case typ2 of
@@ -624,7 +593,6 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
then docLit $ Text.pack "\x2605" -- Unicode star
else docLit $ Text.pack "*"
XHsType{} -> error "brittany internal error: XHsType"
-#if MIN_VERSION_ghc(8,8,0)
HsAppKindTy _ ty kind -> do
t <- docSharedWrapper layoutType ty
k <- docSharedWrapper layoutType kind
@@ -639,17 +607,15 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
t
(docSeq [docLit $ Text.pack "@", k ])
]
-#endif
layoutTyVarBndrs
- :: [LHsTyVarBndr GhcPs]
+ :: [LHsTyVarBndr () GhcPs]
-> ToBriDocM [(Text, Maybe (ToBriDocM BriDocNumbered))]
layoutTyVarBndrs = mapM $ \case
- (L _ (UserTyVar _ name)) -> return $ (lrdrNameToText name, Nothing)
- (L _ (KindedTyVar _ lrdrName kind)) -> do
+ (L _ (UserTyVar _ _ name)) -> return $ (lrdrNameToText name, Nothing)
+ (L _ (KindedTyVar _ _ lrdrName kind)) -> do
d <- docSharedWrapper layoutType kind
return $ (lrdrNameToText lrdrName, Just $ d)
- (L _ (XTyVarBndr{})) -> error "brittany internal error: XTyVarBndr"
-- there is no specific reason this returns a list instead of a single
-- BriDoc node.
@@ -663,3 +629,15 @@ processTyVarBndrsSingleline bndrDocs = bndrDocs >>= \case
, docForceSingleline $ doc
, docLit $ Text.pack ")"
]
+
+getBinders :: HsForAllTelescope pass -> [LHsTyVarBndr () pass]
+getBinders x = case x of
+ HsForAllVis _ b -> b
+ HsForAllInvis _ b -> fmap withoutSpecificity b
+ XHsForAllTelescope _ -> []
+
+withoutSpecificity :: LHsTyVarBndr flag pass -> LHsTyVarBndr () pass
+withoutSpecificity = fmap $ \case
+ UserTyVar a _ c -> UserTyVar a () c
+ KindedTyVar a _ c d -> KindedTyVar a () c d
+ XTyVarBndr a -> XTyVarBndr a
diff --git a/src/Language/Haskell/Brittany/Internal/Obfuscation.hs b/source/library/Language/Haskell/Brittany/Internal/Obfuscation.hs
similarity index 83%
rename from src/Language/Haskell/Brittany/Internal/Obfuscation.hs
rename to source/library/Language/Haskell/Brittany/Internal/Obfuscation.hs
index 5bdcfa8..8b09fa1 100644
--- a/src/Language/Haskell/Brittany/Internal/Obfuscation.hs
+++ b/source/library/Language/Haskell/Brittany/Internal/Obfuscation.hs
@@ -1,14 +1,15 @@
-module Language.Haskell.Brittany.Internal.Obfuscation
- ( obfuscate
- )
-where
+{-# LANGUAGE NoImplicitPrelude #-}
+module Language.Haskell.Brittany.Internal.Obfuscation where
-
-#include "prelude.inc"
-
-import Data.Char
-import System.Random
+import Data.Char
+import qualified Data.Map as Map
+import qualified Data.Set as Set
+import qualified Data.Text as Text
+import qualified GHC.OldList as List
+import Language.Haskell.Brittany.Internal.Prelude
+import Language.Haskell.Brittany.Internal.PreludeUtils
+import System.Random
@@ -91,7 +92,7 @@ _randomRange lo hi = do
setStdGen gen'
pure x
-randomFrom :: Random a => [a] -> IO a
+randomFrom :: [a] -> IO a
randomFrom l = do
let hi = length l - 1
gen <- getStdGen
diff --git a/source/library/Language/Haskell/Brittany/Internal/ParseModule.hs b/source/library/Language/Haskell/Brittany/Internal/ParseModule.hs
new file mode 100644
index 0000000..2cc259f
--- /dev/null
+++ b/source/library/Language/Haskell/Brittany/Internal/ParseModule.hs
@@ -0,0 +1,500 @@
+{-# OPTIONS_GHC -Wno-implicit-prelude #-}
+
+module Language.Haskell.Brittany.Internal.ParseModule where
+
+import qualified Control.Monad as Monad
+import qualified Control.Monad.IO.Class as IO
+import qualified Control.Monad.Trans.Except as Except
+import qualified Data.Set as Set
+import qualified GHC
+import qualified GHC.ByteOrder
+import qualified GHC.Data.Bag
+import qualified GHC.Data.EnumSet
+import qualified GHC.Data.StringBuffer
+import qualified GHC.Driver.Session
+import qualified GHC.Parser.Header
+import qualified GHC.Platform
+import qualified GHC.Settings
+import qualified GHC.Types.Basic
+import qualified GHC.Types.SrcLoc
+import qualified GHC.Unit.Module.Name
+import qualified GHC.Unit.State
+import qualified GHC.Unit.Types
+import qualified GHC.Utils.Error
+import qualified GHC.Utils.Fingerprint
+import qualified GHC.Utils.Misc
+import qualified GHC.Utils.Ppr.Colour
+import qualified Language.Haskell.GHC.ExactPrint.Parsers as ExactPrint
+import qualified Language.Haskell.GHC.ExactPrint.Types as ExactPrint
+
+-- | Parses a Haskell module. Although this nominally requires IO, it is
+-- morally pure. It should have no observable effects.
+parseModule
+ :: IO.MonadIO io
+ => [String]
+ -> FilePath
+ -> (GHC.Driver.Session.DynFlags -> io (Either String a))
+ -> String
+ -> io (Either String (ExactPrint.Anns, GHC.ParsedSource, a))
+parseModule arguments1 filePath checkDynFlags string = Except.runExceptT $ do
+ let
+ dynFlags1 = GHC.Driver.Session.gopt_set
+ -- It feels like this should be either @Sf_Ignore@ or @Sf_None@, but both
+ -- of those modes have trouble parsing safe imports (@import safe ...@).
+ -- Neither passing in @"-XUnsafe"@ as a command line argument nor having
+ -- @{-# LANGUAGE Unsafe #-}@ in the source file seem to help.
+ initialDynFlags
+ { GHC.Driver.Session.safeHaskell = GHC.Driver.Session.Sf_Unsafe
+ }
+ GHC.Driver.Session.Opt_KeepRawTokenStream
+ (dynFlags2, leftovers1, _) <-
+ GHC.Driver.Session.parseDynamicFlagsCmdLine dynFlags1
+ $ fmap GHC.Types.SrcLoc.noLoc arguments1
+ handleLeftovers leftovers1
+ let
+ stringBuffer = GHC.Data.StringBuffer.stringToStringBuffer string
+ arguments2 = GHC.Parser.Header.getOptions dynFlags2 stringBuffer filePath
+ (dynFlags3, leftovers2, _) <- GHC.Driver.Session.parseDynamicFilePragma
+ dynFlags2
+ arguments2
+ handleLeftovers leftovers2
+ dynFlagsResult <- Except.ExceptT $ checkDynFlags dynFlags3
+ let
+ parseResult =
+ ExactPrint.parseModuleFromStringInternal dynFlags3 filePath string
+ case parseResult of
+ Left errorMessages -> handleErrorMessages errorMessages
+ Right (anns, parsedSource) -> pure (anns, parsedSource, dynFlagsResult)
+
+handleLeftovers
+ :: Monad m => [GHC.Types.SrcLoc.Located String] -> Except.ExceptT String m ()
+handleLeftovers leftovers =
+ Monad.unless (null leftovers) . Except.throwE $ "leftovers: " <> show
+ (fmap GHC.Types.SrcLoc.unLoc leftovers)
+
+handleErrorMessages
+ :: Monad m => GHC.Utils.Error.ErrorMessages -> Except.ExceptT String m a
+handleErrorMessages =
+ Except.throwE . mappend "errorMessages: " . show . GHC.Data.Bag.bagToList
+
+initialCfgWeights :: GHC.Driver.Session.CfgWeights
+initialCfgWeights = GHC.Driver.Session.CFGWeights
+ { GHC.Driver.Session.backEdgeBonus = 0
+ , GHC.Driver.Session.callWeight = 0
+ , GHC.Driver.Session.condBranchWeight = 0
+ , GHC.Driver.Session.infoTablePenalty = 0
+ , GHC.Driver.Session.likelyCondWeight = 0
+ , GHC.Driver.Session.switchWeight = 0
+ , GHC.Driver.Session.uncondWeight = 0
+ , GHC.Driver.Session.unlikelyCondWeight = 0
+ }
+
+initialDynFlags :: GHC.Driver.Session.DynFlags
+initialDynFlags = GHC.Driver.Session.DynFlags
+ { GHC.Driver.Session.avx = False
+ , GHC.Driver.Session.avx2 = False
+ , GHC.Driver.Session.avx512cd = False
+ , GHC.Driver.Session.avx512er = False
+ , GHC.Driver.Session.avx512f = False
+ , GHC.Driver.Session.avx512pf = False
+ , GHC.Driver.Session.binBlobThreshold = 0
+ , GHC.Driver.Session.bmiVersion = Nothing
+ , GHC.Driver.Session.cachedPlugins = []
+ , GHC.Driver.Session.canGenerateDynamicToo = error "canGenerateDynamicToo"
+ , GHC.Driver.Session.canUseColor = False
+ , GHC.Driver.Session.cfgWeightInfo = initialCfgWeights
+ , GHC.Driver.Session.cmdlineFrameworks = []
+ , GHC.Driver.Session.cmmProcAlignment = Nothing
+ , GHC.Driver.Session.colScheme = GHC.Utils.Ppr.Colour.defaultScheme
+ , GHC.Driver.Session.debugLevel = 0
+ , GHC.Driver.Session.depExcludeMods = []
+ , GHC.Driver.Session.depIncludeCppDeps = False
+ , GHC.Driver.Session.depIncludePkgDeps = False
+ , GHC.Driver.Session.depMakefile = ""
+ , GHC.Driver.Session.depSuffixes = []
+ , GHC.Driver.Session.dirsToClean = error "dirsToClean"
+ , GHC.Driver.Session.dump_action = \_ _ _ _ _ _ -> pure ()
+ , GHC.Driver.Session.dumpDir = Nothing
+ , GHC.Driver.Session.dumpFlags = GHC.Data.EnumSet.fromList []
+ , GHC.Driver.Session.dumpPrefix = Nothing
+ , GHC.Driver.Session.dumpPrefixForce = Nothing
+ , GHC.Driver.Session.dylibInstallName = Nothing
+ , GHC.Driver.Session.dynHiSuf = ""
+ , GHC.Driver.Session.dynLibLoader = GHC.Driver.Session.Deployable
+ , GHC.Driver.Session.dynObjectSuf = ""
+ , GHC.Driver.Session.dynOutputFile = Nothing
+ , GHC.Driver.Session.enableTimeStats = False
+ , GHC.Driver.Session.extensionFlags = GHC.Data.EnumSet.fromList []
+ , GHC.Driver.Session.extensions = []
+ , GHC.Driver.Session.fatalWarningFlags = GHC.Data.EnumSet.fromList []
+ , GHC.Driver.Session.fileSettings = initialFileSettings
+ , GHC.Driver.Session.filesToClean = error "filesToClean"
+ , GHC.Driver.Session.floatLamArgs = Nothing
+ , GHC.Driver.Session.flushErr = GHC.Driver.Session.defaultFlushErr
+ , GHC.Driver.Session.flushOut = GHC.Driver.Session.defaultFlushOut
+ , GHC.Driver.Session.frameworkPaths = []
+ , GHC.Driver.Session.frontendPluginOpts = []
+ , GHC.Driver.Session.generalFlags = GHC.Data.EnumSet.fromList []
+ , GHC.Driver.Session.generatedDumps = error "generatedDumps"
+ , GHC.Driver.Session.ghcHeapSize = Nothing
+ , GHC.Driver.Session.ghciHistSize = 0
+ , GHC.Driver.Session.ghciScripts = []
+ , GHC.Driver.Session.ghcLink = GHC.Driver.Session.NoLink
+ , GHC.Driver.Session.ghcMode = GHC.Driver.Session.OneShot
+ , GHC.Driver.Session.ghcNameVersion = initialGhcNameVersion
+ , GHC.Driver.Session.ghcVersionFile = Nothing
+ , GHC.Driver.Session.haddockOptions = Nothing
+ , GHC.Driver.Session.hcSuf = ""
+ , GHC.Driver.Session.hiDir = Nothing
+ , GHC.Driver.Session.hieDir = Nothing
+ , GHC.Driver.Session.hieSuf = ""
+ , GHC.Driver.Session.historySize = 0
+ , GHC.Driver.Session.hiSuf = ""
+ , GHC.Driver.Session.homeUnitId = GHC.Unit.Types.stringToUnitId ""
+ , GHC.Driver.Session.homeUnitInstanceOfId = Nothing
+ , GHC.Driver.Session.homeUnitInstantiations = []
+ , GHC.Driver.Session.hooks = error "hooks"
+ , GHC.Driver.Session.hpcDir = ""
+ , GHC.Driver.Session.hscTarget = GHC.Driver.Session.HscNothing
+ , GHC.Driver.Session.ignorePackageFlags = []
+ , GHC.Driver.Session.importPaths = []
+ , GHC.Driver.Session.includePaths = initialIncludeSpecs
+ , GHC.Driver.Session.incoherentOnLoc = initialSrcSpan
+ , GHC.Driver.Session.initialUnique = 0
+ , GHC.Driver.Session.inlineCheck = Nothing
+ , GHC.Driver.Session.interactivePrint = Nothing
+ , GHC.Driver.Session.language = Nothing
+ , GHC.Driver.Session.ldInputs = []
+ , GHC.Driver.Session.liberateCaseThreshold = Nothing
+ , GHC.Driver.Session.libraryPaths = []
+ , GHC.Driver.Session.liftLamsKnown = False
+ , GHC.Driver.Session.liftLamsNonRecArgs = Nothing
+ , GHC.Driver.Session.liftLamsRecArgs = Nothing
+ , GHC.Driver.Session.llvmConfig = initialLlvmConfig
+ , GHC.Driver.Session.log_action = \_ _ _ _ _ -> pure ()
+ , GHC.Driver.Session.mainFunIs = Nothing
+ , GHC.Driver.Session.mainModIs = GHC.Unit.Types.mkModule
+ (GHC.Unit.Types.stringToUnit "")
+ (GHC.Unit.Module.Name.mkModuleName "")
+ , GHC.Driver.Session.maxErrors = Nothing
+ , GHC.Driver.Session.maxInlineAllocSize = 0
+ , GHC.Driver.Session.maxInlineMemcpyInsns = 0
+ , GHC.Driver.Session.maxInlineMemsetInsns = 0
+ , GHC.Driver.Session.maxPmCheckModels = 0
+ , GHC.Driver.Session.maxRefHoleFits = Nothing
+ , GHC.Driver.Session.maxRelevantBinds = Nothing
+ , GHC.Driver.Session.maxSimplIterations = 0
+ , GHC.Driver.Session.maxUncoveredPatterns = 0
+ , GHC.Driver.Session.maxValidHoleFits = Nothing
+ , GHC.Driver.Session.maxWorkerArgs = 0
+ , GHC.Driver.Session.newDerivOnLoc = initialSrcSpan
+ , GHC.Driver.Session.nextTempSuffix = error "nextTempSuffix"
+ , GHC.Driver.Session.nextWrapperNum = error "nextWrapperNum"
+ , GHC.Driver.Session.objectDir = Nothing
+ , GHC.Driver.Session.objectSuf = ""
+ , GHC.Driver.Session.optLevel = 0
+ , GHC.Driver.Session.outputFile = Nothing
+ , GHC.Driver.Session.outputHi = Nothing
+ , GHC.Driver.Session.overlapInstLoc = initialSrcSpan
+ , GHC.Driver.Session.packageDBFlags = []
+ , GHC.Driver.Session.packageEnv = Nothing
+ , GHC.Driver.Session.packageFlags = []
+ , GHC.Driver.Session.parMakeCount = Nothing
+ , GHC.Driver.Session.pkgTrustOnLoc = initialSrcSpan
+ , GHC.Driver.Session.platformConstants = initialPlatformConstants
+ , GHC.Driver.Session.platformMisc = initialPlatformMisc
+ , GHC.Driver.Session.pluginModNameOpts = []
+ , GHC.Driver.Session.pluginModNames = []
+ , GHC.Driver.Session.pluginPackageFlags = []
+ , GHC.Driver.Session.pprCols = 80
+ , GHC.Driver.Session.pprUserLength = 0
+ , GHC.Driver.Session.profAuto = GHC.Driver.Session.NoProfAuto
+ , GHC.Driver.Session.rawSettings = []
+ , GHC.Driver.Session.reductionDepth = GHC.Types.Basic.mkIntWithInf 0
+ , GHC.Driver.Session.refLevelHoleFits = Nothing
+ , GHC.Driver.Session.reverseErrors = False
+ , GHC.Driver.Session.rtccInfo = error "rtccInfo"
+ , GHC.Driver.Session.rtldInfo = error "rtldInfo"
+ , GHC.Driver.Session.rtsOpts = Nothing
+ , GHC.Driver.Session.rtsOptsEnabled = GHC.Driver.Session.RtsOptsNone
+ , GHC.Driver.Session.rtsOptsSuggestions = False
+ , GHC.Driver.Session.ruleCheck = Nothing
+ , GHC.Driver.Session.safeHaskell = GHC.Driver.Session.Sf_Ignore
+ , GHC.Driver.Session.safeInfer = False
+ , GHC.Driver.Session.safeInferred = False
+ , GHC.Driver.Session.simplPhases = 0
+ , GHC.Driver.Session.simplTickFactor = 0
+ , GHC.Driver.Session.solverIterations = GHC.Types.Basic.mkIntWithInf 0
+ , GHC.Driver.Session.specConstrCount = Nothing
+ , GHC.Driver.Session.specConstrRecursive = 0
+ , GHC.Driver.Session.specConstrThreshold = Nothing
+ , GHC.Driver.Session.splitInfo = Nothing
+ , GHC.Driver.Session.sseVersion = Nothing
+ , GHC.Driver.Session.staticPlugins = []
+ , GHC.Driver.Session.strictnessBefore = []
+ , GHC.Driver.Session.stubDir = Nothing
+ , GHC.Driver.Session.targetPlatform = initialTargetPlatform
+ , GHC.Driver.Session.thOnLoc = initialSrcSpan
+ , GHC.Driver.Session.toolSettings = initialToolSettings
+ , GHC.Driver.Session.trace_action = \_ _ _ a -> a
+ , GHC.Driver.Session.trustFlags = []
+ , GHC.Driver.Session.trustworthyOnLoc = initialSrcSpan
+ , GHC.Driver.Session.ufCreationThreshold = 0
+ , GHC.Driver.Session.ufDearOp = 0
+ , GHC.Driver.Session.ufDictDiscount = 0
+ , GHC.Driver.Session.ufFunAppDiscount = 0
+ , GHC.Driver.Session.ufUseThreshold = 0
+ , GHC.Driver.Session.ufVeryAggressive = False
+ , GHC.Driver.Session.uniqueIncrement = 0
+ , GHC.Driver.Session.unitDatabases = Nothing
+ , GHC.Driver.Session.unitState = GHC.Unit.State.emptyUnitState
+ , GHC.Driver.Session.useColor = GHC.Utils.Misc.Never
+ , GHC.Driver.Session.useUnicode = False
+ , GHC.Driver.Session.verbosity = 0
+ , GHC.Driver.Session.warningFlags = GHC.Data.EnumSet.fromList []
+ , GHC.Driver.Session.warnSafeOnLoc = initialSrcSpan
+ , GHC.Driver.Session.warnUnsafeOnLoc = initialSrcSpan
+ , GHC.Driver.Session.ways = Set.empty
+ }
+
+initialFileSettings :: GHC.Driver.Session.FileSettings
+initialFileSettings = GHC.Driver.Session.FileSettings
+ { GHC.Driver.Session.fileSettings_ghciUsagePath = ""
+ , GHC.Driver.Session.fileSettings_ghcUsagePath = ""
+ , GHC.Driver.Session.fileSettings_globalPackageDatabase = ""
+ , GHC.Driver.Session.fileSettings_tmpDir = ""
+ , GHC.Driver.Session.fileSettings_toolDir = Nothing
+ , GHC.Driver.Session.fileSettings_topDir = ""
+ }
+
+initialGhcNameVersion :: GHC.Driver.Session.GhcNameVersion
+initialGhcNameVersion = GHC.Driver.Session.GhcNameVersion
+ { GHC.Driver.Session.ghcNameVersion_programName = ""
+ , GHC.Driver.Session.ghcNameVersion_projectVersion = ""
+ }
+
+initialIncludeSpecs :: GHC.Driver.Session.IncludeSpecs
+initialIncludeSpecs = GHC.Driver.Session.IncludeSpecs
+ { GHC.Driver.Session.includePathsGlobal = []
+ , GHC.Driver.Session.includePathsQuote = []
+ }
+
+initialLlvmConfig :: GHC.Driver.Session.LlvmConfig
+initialLlvmConfig = GHC.Driver.Session.LlvmConfig
+ { GHC.Driver.Session.llvmPasses = []
+ , GHC.Driver.Session.llvmTargets = []
+ }
+
+initialPlatformConstants :: GHC.Settings.PlatformConstants
+initialPlatformConstants = GHC.Settings.PlatformConstants
+ { GHC.Settings.pc_AP_STACK_SPLIM = 0
+ , GHC.Settings.pc_BITMAP_BITS_SHIFT = 0
+ , GHC.Settings.pc_BLOCK_SIZE = 0
+ , GHC.Settings.pc_BLOCKS_PER_MBLOCK = 0
+ , GHC.Settings.pc_CINT_SIZE = 0
+ , GHC.Settings.pc_CLONG_LONG_SIZE = 0
+ , GHC.Settings.pc_CLONG_SIZE = 0
+ , GHC.Settings.pc_CONTROL_GROUP_CONST_291 = 0
+ , GHC.Settings.pc_DYNAMIC_BY_DEFAULT = False
+ , GHC.Settings.pc_ILDV_CREATE_MASK = 0
+ , GHC.Settings.pc_ILDV_STATE_CREATE = 0
+ , GHC.Settings.pc_ILDV_STATE_USE = 0
+ , GHC.Settings.pc_LDV_SHIFT = 0
+ , GHC.Settings.pc_MAX_CHARLIKE = 0
+ , GHC.Settings.pc_MAX_Double_REG = 0
+ , GHC.Settings.pc_MAX_Float_REG = 0
+ , GHC.Settings.pc_MAX_INTLIKE = 0
+ , GHC.Settings.pc_MAX_Long_REG = 0
+ , GHC.Settings.pc_MAX_Real_Double_REG = 0
+ , GHC.Settings.pc_MAX_Real_Float_REG = 0
+ , GHC.Settings.pc_MAX_Real_Long_REG = 0
+ , GHC.Settings.pc_MAX_Real_Vanilla_REG = 0
+ , GHC.Settings.pc_MAX_Real_XMM_REG = 0
+ , GHC.Settings.pc_MAX_SPEC_AP_SIZE = 0
+ , GHC.Settings.pc_MAX_SPEC_SELECTEE_SIZE = 0
+ , GHC.Settings.pc_MAX_Vanilla_REG = 0
+ , GHC.Settings.pc_MAX_XMM_REG = 0
+ , GHC.Settings.pc_MIN_CHARLIKE = 0
+ , GHC.Settings.pc_MIN_INTLIKE = 0
+ , GHC.Settings.pc_MIN_PAYLOAD_SIZE = 0
+ , GHC.Settings.pc_MUT_ARR_PTRS_CARD_BITS = 0
+ , GHC.Settings.pc_OFFSET_bdescr_blocks = 0
+ , GHC.Settings.pc_OFFSET_bdescr_flags = 0
+ , GHC.Settings.pc_OFFSET_bdescr_free = 0
+ , GHC.Settings.pc_OFFSET_bdescr_start = 0
+ , GHC.Settings.pc_OFFSET_Capability_r = 0
+ , GHC.Settings.pc_OFFSET_CostCentreStack_mem_alloc = 0
+ , GHC.Settings.pc_OFFSET_CostCentreStack_scc_count = 0
+ , GHC.Settings.pc_OFFSET_StgArrBytes_bytes = 0
+ , GHC.Settings.pc_OFFSET_stgEagerBlackholeInfo = 0
+ , GHC.Settings.pc_OFFSET_StgEntCounter_allocd = 0
+ , GHC.Settings.pc_OFFSET_StgEntCounter_allocs = 0
+ , GHC.Settings.pc_OFFSET_StgEntCounter_entry_count = 0
+ , GHC.Settings.pc_OFFSET_StgEntCounter_link = 0
+ , GHC.Settings.pc_OFFSET_StgEntCounter_registeredp = 0
+ , GHC.Settings.pc_OFFSET_StgFunInfoExtraFwd_arity = 0
+ , GHC.Settings.pc_OFFSET_StgFunInfoExtraRev_arity = 0
+ , GHC.Settings.pc_OFFSET_stgGCEnter1 = 0
+ , GHC.Settings.pc_OFFSET_stgGCFun = 0
+ , GHC.Settings.pc_OFFSET_StgHeader_ccs = 0
+ , GHC.Settings.pc_OFFSET_StgHeader_ldvw = 0
+ , GHC.Settings.pc_OFFSET_StgMutArrPtrs_ptrs = 0
+ , GHC.Settings.pc_OFFSET_StgMutArrPtrs_size = 0
+ , GHC.Settings.pc_OFFSET_StgRegTable_rCCCS = 0
+ , GHC.Settings.pc_OFFSET_StgRegTable_rCurrentNursery = 0
+ , GHC.Settings.pc_OFFSET_StgRegTable_rCurrentTSO = 0
+ , GHC.Settings.pc_OFFSET_StgRegTable_rD1 = 0
+ , GHC.Settings.pc_OFFSET_StgRegTable_rD2 = 0
+ , GHC.Settings.pc_OFFSET_StgRegTable_rD3 = 0
+ , GHC.Settings.pc_OFFSET_StgRegTable_rD4 = 0
+ , GHC.Settings.pc_OFFSET_StgRegTable_rD5 = 0
+ , GHC.Settings.pc_OFFSET_StgRegTable_rD6 = 0
+ , GHC.Settings.pc_OFFSET_StgRegTable_rF1 = 0
+ , GHC.Settings.pc_OFFSET_StgRegTable_rF2 = 0
+ , GHC.Settings.pc_OFFSET_StgRegTable_rF3 = 0
+ , GHC.Settings.pc_OFFSET_StgRegTable_rF4 = 0
+ , GHC.Settings.pc_OFFSET_StgRegTable_rF5 = 0
+ , GHC.Settings.pc_OFFSET_StgRegTable_rF6 = 0
+ , GHC.Settings.pc_OFFSET_StgRegTable_rHp = 0
+ , GHC.Settings.pc_OFFSET_StgRegTable_rHpAlloc = 0
+ , GHC.Settings.pc_OFFSET_StgRegTable_rHpLim = 0
+ , GHC.Settings.pc_OFFSET_StgRegTable_rL1 = 0
+ , GHC.Settings.pc_OFFSET_StgRegTable_rR1 = 0
+ , GHC.Settings.pc_OFFSET_StgRegTable_rR10 = 0
+ , GHC.Settings.pc_OFFSET_StgRegTable_rR2 = 0
+ , GHC.Settings.pc_OFFSET_StgRegTable_rR3 = 0
+ , GHC.Settings.pc_OFFSET_StgRegTable_rR4 = 0
+ , GHC.Settings.pc_OFFSET_StgRegTable_rR5 = 0
+ , GHC.Settings.pc_OFFSET_StgRegTable_rR6 = 0
+ , GHC.Settings.pc_OFFSET_StgRegTable_rR7 = 0
+ , GHC.Settings.pc_OFFSET_StgRegTable_rR8 = 0
+ , GHC.Settings.pc_OFFSET_StgRegTable_rR9 = 0
+ , GHC.Settings.pc_OFFSET_StgRegTable_rSp = 0
+ , GHC.Settings.pc_OFFSET_StgRegTable_rSpLim = 0
+ , GHC.Settings.pc_OFFSET_StgRegTable_rXMM1 = 0
+ , GHC.Settings.pc_OFFSET_StgRegTable_rXMM2 = 0
+ , GHC.Settings.pc_OFFSET_StgRegTable_rXMM3 = 0
+ , GHC.Settings.pc_OFFSET_StgRegTable_rXMM4 = 0
+ , GHC.Settings.pc_OFFSET_StgRegTable_rXMM5 = 0
+ , GHC.Settings.pc_OFFSET_StgRegTable_rXMM6 = 0
+ , GHC.Settings.pc_OFFSET_StgRegTable_rYMM1 = 0
+ , GHC.Settings.pc_OFFSET_StgRegTable_rYMM2 = 0
+ , GHC.Settings.pc_OFFSET_StgRegTable_rYMM3 = 0
+ , GHC.Settings.pc_OFFSET_StgRegTable_rYMM4 = 0
+ , GHC.Settings.pc_OFFSET_StgRegTable_rYMM5 = 0
+ , GHC.Settings.pc_OFFSET_StgRegTable_rYMM6 = 0
+ , GHC.Settings.pc_OFFSET_StgRegTable_rZMM1 = 0
+ , GHC.Settings.pc_OFFSET_StgRegTable_rZMM2 = 0
+ , GHC.Settings.pc_OFFSET_StgRegTable_rZMM3 = 0
+ , GHC.Settings.pc_OFFSET_StgRegTable_rZMM4 = 0
+ , GHC.Settings.pc_OFFSET_StgRegTable_rZMM5 = 0
+ , GHC.Settings.pc_OFFSET_StgRegTable_rZMM6 = 0
+ , GHC.Settings.pc_OFFSET_StgSmallMutArrPtrs_ptrs = 0
+ , GHC.Settings.pc_OFFSET_StgStack_sp = 0
+ , GHC.Settings.pc_OFFSET_StgStack_stack = 0
+ , GHC.Settings.pc_OFFSET_StgTSO_alloc_limit = 0
+ , GHC.Settings.pc_OFFSET_StgTSO_cccs = 0
+ , GHC.Settings.pc_OFFSET_StgTSO_stackobj = 0
+ , GHC.Settings.pc_OFFSET_StgUpdateFrame_updatee = 0
+ , GHC.Settings.pc_PROF_HDR_SIZE = 0
+ , GHC.Settings.pc_REP_CostCentreStack_mem_alloc = 0
+ , GHC.Settings.pc_REP_CostCentreStack_scc_count = 0
+ , GHC.Settings.pc_REP_StgEntCounter_allocd = 0
+ , GHC.Settings.pc_REP_StgEntCounter_allocs = 0
+ , GHC.Settings.pc_REP_StgFunInfoExtraFwd_arity = 0
+ , GHC.Settings.pc_REP_StgFunInfoExtraRev_arity = 0
+ , GHC.Settings.pc_RESERVED_C_STACK_BYTES = 0
+ , GHC.Settings.pc_RESERVED_STACK_WORDS = 0
+ , GHC.Settings.pc_SIZEOF_CostCentreStack = 0
+ , GHC.Settings.pc_SIZEOF_StgArrBytes_NoHdr = 0
+ , GHC.Settings.pc_SIZEOF_StgFunInfoExtraRev = 0
+ , GHC.Settings.pc_SIZEOF_StgMutArrPtrs_NoHdr = 0
+ , GHC.Settings.pc_SIZEOF_StgSmallMutArrPtrs_NoHdr = 0
+ , GHC.Settings.pc_SIZEOF_StgSMPThunkHeader = 0
+ , GHC.Settings.pc_SIZEOF_StgUpdateFrame_NoHdr = 0
+ , GHC.Settings.pc_STD_HDR_SIZE = 0
+ , GHC.Settings.pc_TAG_BITS = 0
+ , GHC.Settings.pc_TICKY_BIN_COUNT = 0
+ , GHC.Settings.pc_WORD_SIZE = 0
+ }
+
+initialPlatformMini :: GHC.Settings.PlatformMini
+initialPlatformMini = GHC.Settings.PlatformMini
+ { GHC.Settings.platformMini_arch = GHC.Platform.ArchX86_64
+ , GHC.Settings.platformMini_os = GHC.Platform.OSLinux
+ }
+
+initialPlatformMisc :: GHC.Driver.Session.PlatformMisc
+initialPlatformMisc = GHC.Driver.Session.PlatformMisc
+ { GHC.Driver.Session.platformMisc_ghcDebugged = False
+ , GHC.Driver.Session.platformMisc_ghcRTSWays = ""
+ , GHC.Driver.Session.platformMisc_ghcRtsWithLibdw = False
+ , GHC.Driver.Session.platformMisc_ghcThreaded = False
+ , GHC.Driver.Session.platformMisc_ghcWithInterpreter = False
+ , GHC.Driver.Session.platformMisc_ghcWithSMP = False
+ , GHC.Driver.Session.platformMisc_libFFI = False
+ , GHC.Driver.Session.platformMisc_llvmTarget = ""
+ , GHC.Driver.Session.platformMisc_targetPlatformString = ""
+ }
+
+initialSrcSpan :: GHC.Types.SrcLoc.SrcSpan
+initialSrcSpan =
+ GHC.Types.SrcLoc.UnhelpfulSpan GHC.Types.SrcLoc.UnhelpfulNoLocationInfo
+
+initialTargetPlatform :: GHC.Settings.Platform
+initialTargetPlatform = GHC.Settings.Platform
+ { GHC.Settings.platformByteOrder = GHC.ByteOrder.LittleEndian
+ , GHC.Settings.platformHasGnuNonexecStack = False
+ , GHC.Settings.platformHasIdentDirective = False
+ , GHC.Settings.platformHasSubsectionsViaSymbols = False
+ , GHC.Settings.platformIsCrossCompiling = False
+ , GHC.Settings.platformLeadingUnderscore = False
+ , GHC.Settings.platformMini = initialPlatformMini
+ , GHC.Settings.platformTablesNextToCode = False
+ , GHC.Settings.platformUnregisterised = False
+ , GHC.Settings.platformWordSize = GHC.Platform.PW8
+ }
+
+initialToolSettings :: GHC.Settings.ToolSettings
+initialToolSettings = GHC.Settings.ToolSettings
+ { GHC.Settings.toolSettings_ccSupportsNoPie = False
+ , GHC.Settings.toolSettings_extraGccViaCFlags = []
+ , GHC.Settings.toolSettings_ldIsGnuLd = False
+ , GHC.Settings.toolSettings_ldSupportsBuildId = False
+ , GHC.Settings.toolSettings_ldSupportsCompactUnwind = False
+ , GHC.Settings.toolSettings_ldSupportsFilelist = False
+ , GHC.Settings.toolSettings_opt_a = []
+ , GHC.Settings.toolSettings_opt_c = []
+ , GHC.Settings.toolSettings_opt_cxx = []
+ , GHC.Settings.toolSettings_opt_F = []
+ , GHC.Settings.toolSettings_opt_i = []
+ , GHC.Settings.toolSettings_opt_l = []
+ , GHC.Settings.toolSettings_opt_L = []
+ , GHC.Settings.toolSettings_opt_lc = []
+ , GHC.Settings.toolSettings_opt_lcc = []
+ , GHC.Settings.toolSettings_opt_lm = []
+ , GHC.Settings.toolSettings_opt_lo = []
+ , GHC.Settings.toolSettings_opt_P = []
+ , GHC.Settings.toolSettings_opt_P_fingerprint =
+ GHC.Utils.Fingerprint.fingerprint0
+ , GHC.Settings.toolSettings_opt_windres = []
+ , GHC.Settings.toolSettings_pgm_a = ("", [])
+ , GHC.Settings.toolSettings_pgm_ar = ""
+ , GHC.Settings.toolSettings_pgm_c = ""
+ , GHC.Settings.toolSettings_pgm_dll = ("", [])
+ , GHC.Settings.toolSettings_pgm_F = ""
+ , GHC.Settings.toolSettings_pgm_i = ""
+ , GHC.Settings.toolSettings_pgm_install_name_tool = ""
+ , GHC.Settings.toolSettings_pgm_l = ("", [])
+ , GHC.Settings.toolSettings_pgm_L = ""
+ , GHC.Settings.toolSettings_pgm_lc = ("", [])
+ , GHC.Settings.toolSettings_pgm_lcc = ("", [])
+ , GHC.Settings.toolSettings_pgm_libtool = ""
+ , GHC.Settings.toolSettings_pgm_lm = ("", [])
+ , GHC.Settings.toolSettings_pgm_lo = ("", [])
+ , GHC.Settings.toolSettings_pgm_otool = ""
+ , GHC.Settings.toolSettings_pgm_P = ("", [])
+ , GHC.Settings.toolSettings_pgm_ranlib = ""
+ , GHC.Settings.toolSettings_pgm_T = ""
+ , GHC.Settings.toolSettings_pgm_windres = ""
+ }
diff --git a/source/library/Language/Haskell/Brittany/Internal/Prelude.hs b/source/library/Language/Haskell/Brittany/Internal/Prelude.hs
new file mode 100644
index 0000000..8198533
--- /dev/null
+++ b/source/library/Language/Haskell/Brittany/Internal/Prelude.hs
@@ -0,0 +1,194 @@
+module Language.Haskell.Brittany.Internal.Prelude
+ ( module E
+ ) where
+
+import Control.Applicative as E (Alternative(..), Applicative(..))
+import Control.Arrow as E ((&&&), (***), (<<<), (>>>), first, second)
+import Control.Concurrent as E (forkIO, forkOS, threadDelay)
+import Control.Concurrent.Chan as E (Chan)
+import Control.Concurrent.MVar as E
+ (MVar, newEmptyMVar, newMVar, putMVar, readMVar, swapMVar, takeMVar)
+import Control.Exception as E (assert, bracket, evaluate)
+import Control.Monad as E
+ ( (<$!>)
+ , (<=<)
+ , (=<<)
+ , (>=>)
+ , Functor(..)
+ , Monad(..)
+ , MonadPlus(..)
+ , filterM
+ , forM
+ , forM_
+ , forever
+ , guard
+ , join
+ , liftM
+ , liftM2
+ , liftM3
+ , liftM4
+ , liftM5
+ , mapM
+ , mapM_
+ , replicateM
+ , replicateM_
+ , sequence
+ , sequence_
+ , unless
+ , void
+ , when
+ )
+import Control.Monad.Extra as E
+ (allM, andM, anyM, ifM, notM, orM, unlessM, whenM)
+import Control.Monad.IO.Class as E (MonadIO(..))
+import Control.Monad.ST as E (ST)
+import Control.Monad.Trans.Class as E (lift)
+import Control.Monad.Trans.Maybe as E (MaybeT(..))
+import Control.Monad.Trans.MultiRWS as E
+ (MonadMultiReader(..), MonadMultiState(..), MonadMultiWriter(..), mGet)
+import Data.Bifunctor as E (bimap)
+import Data.Bool as E (Bool(..))
+import Data.Char as E (Char, chr, ord)
+import Data.Data as E (toConstr)
+import Data.Either as E (Either(..), either)
+import Data.Foldable as E (asum, fold, foldl', foldr')
+import Data.Function as E ((&), fix)
+import Data.Functor as E (($>))
+import Data.Functor.Identity as E (Identity(..))
+import Data.IORef as E (IORef)
+import Data.Int as E (Int)
+import Data.List as E
+ ( all
+ , break
+ , drop
+ , dropWhile
+ , elem
+ , filter
+ , find
+ , intercalate
+ , intersperse
+ , isPrefixOf
+ , isSuffixOf
+ , iterate
+ , length
+ , mapAccumL
+ , mapAccumR
+ , maximum
+ , minimum
+ , notElem
+ , nub
+ , null
+ , partition
+ , repeat
+ , replicate
+ , sortBy
+ , sum
+ , take
+ , takeWhile
+ , transpose
+ , uncons
+ , unzip
+ , zip
+ , zip3
+ , zipWith
+ )
+import Data.List.Extra as E (nubOrd, stripSuffix)
+import Data.List.NonEmpty as E (NonEmpty(..), nonEmpty)
+import Data.Map as E (Map)
+import Data.Maybe as E
+ (Maybe(..), catMaybes, fromMaybe, listToMaybe, maybe, maybeToList)
+import Data.Monoid as E
+ ( All(..)
+ , Alt(..)
+ , Any(..)
+ , Endo(..)
+ , Monoid(..)
+ , Product(..)
+ , Sum(..)
+ , mconcat
+ )
+import Data.Ord as E (Down(..), Ordering(..), comparing)
+import Data.Proxy as E (Proxy(..))
+import Data.Ratio as E ((%), Ratio, Rational, denominator, numerator)
+import Data.Semigroup as E ((<>), Semigroup(..))
+import Data.Sequence as E (Seq)
+import Data.Set as E (Set)
+import Data.String as E (String)
+import Data.Text as E (Text)
+import Data.Tree as E (Tree(..))
+import Data.Tuple as E (swap)
+import Data.Typeable as E (Typeable)
+import Data.Version as E (showVersion)
+import Data.Void as E (Void)
+import Data.Word as E (Word, Word32)
+import Debug.Trace as E
+ ( trace
+ , traceIO
+ , traceId
+ , traceM
+ , traceShow
+ , traceShowId
+ , traceShowM
+ , traceStack
+ )
+import Foreign.ForeignPtr as E (ForeignPtr)
+import Foreign.Storable as E (Storable)
+import GHC.Exts as E (Constraint)
+import GHC.Hs.Extension as E (GhcPs)
+import GHC.Types.Name.Reader as E (RdrName)
+import Prelude as E
+ ( ($)
+ , ($!)
+ , (&&)
+ , (++)
+ , (.)
+ , (<$>)
+ , Bounded(..)
+ , Double
+ , Enum(..)
+ , Eq(..)
+ , Float
+ , Floating(..)
+ , Foldable
+ , Fractional(..)
+ , Integer
+ , Integral(..)
+ , Num(..)
+ , Ord(..)
+ , RealFloat(..)
+ , RealFrac(..)
+ , Show(..)
+ , Traversable
+ , (^)
+ , and
+ , any
+ , const
+ , curry
+ , error
+ , flip
+ , foldl
+ , foldr
+ , foldr1
+ , fromIntegral
+ , fst
+ , head
+ , id
+ , map
+ , not
+ , or
+ , otherwise
+ , print
+ , putStr
+ , putStrLn
+ , realToFrac
+ , reverse
+ , seq
+ , snd
+ , subtract
+ , traverse
+ , uncurry
+ , undefined
+ , (||)
+ )
+import System.IO as E (IO, hFlush, stdout)
+import Text.Read as E (readMaybe)
diff --git a/src/Language/Haskell/Brittany/Internal/PreludeUtils.hs b/source/library/Language/Haskell/Brittany/Internal/PreludeUtils.hs
similarity index 89%
rename from src/Language/Haskell/Brittany/Internal/PreludeUtils.hs
rename to source/library/Language/Haskell/Brittany/Internal/PreludeUtils.hs
index df80168..d2527e9 100644
--- a/src/Language/Haskell/Brittany/Internal/PreludeUtils.hs
+++ b/source/library/Language/Haskell/Brittany/Internal/PreludeUtils.hs
@@ -1,19 +1,15 @@
{-# OPTIONS_GHC -fno-warn-orphans #-}
-module Language.Haskell.Brittany.Internal.PreludeUtils
-where
-
-
-import Prelude
-import qualified Data.Strict.Maybe as Strict
-import Debug.Trace
-import Control.Monad
-import System.IO
-
-import Control.DeepSeq ( NFData, force )
-import Control.Exception.Base ( evaluate )
+module Language.Haskell.Brittany.Internal.PreludeUtils where
import Control.Applicative
+import Control.DeepSeq (NFData, force)
+import Control.Exception.Base (evaluate)
+import Control.Monad
+import qualified Data.Strict.Maybe as Strict
+import Debug.Trace
+import Prelude
+import System.IO
@@ -23,7 +19,6 @@ instance Applicative Strict.Maybe where
_ <*> _ = Strict.Nothing
instance Monad Strict.Maybe where
- return = Strict.Just
Strict.Nothing >>= _ = Strict.Nothing
Strict.Just x >>= f = f x
diff --git a/src/Language/Haskell/Brittany/Internal/Transformations/Alt.hs b/source/library/Language/Haskell/Brittany/Internal/Transformations/Alt.hs
similarity index 93%
rename from src/Language/Haskell/Brittany/Internal/Transformations/Alt.hs
rename to source/library/Language/Haskell/Brittany/Internal/Transformations/Alt.hs
index 6a15eac..0e5b85f 100644
--- a/src/Language/Haskell/Brittany/Internal/Transformations/Alt.hs
+++ b/source/library/Language/Haskell/Brittany/Internal/Transformations/Alt.hs
@@ -1,27 +1,26 @@
-#define INSERTTRACESALT 0
-#define INSERTTRACESALTVISIT 0
-#define INSERTTRACESGETSPACING 0
-
-{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MonadComprehensions #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeOperators #-}
-module Language.Haskell.Brittany.Internal.Transformations.Alt
- ( transformAlts
- )
-where
-
-
-
-#include "prelude.inc"
-
-import Data.HList.ContainsType
-
-import Language.Haskell.Brittany.Internal.Utils
-import Language.Haskell.Brittany.Internal.Config.Types
-import Language.Haskell.Brittany.Internal.Types
+module Language.Haskell.Brittany.Internal.Transformations.Alt where
import qualified Control.Monad.Memo as Memo
+import qualified Control.Monad.Trans.MultiRWS.Strict as MultiRWSS
+import Data.HList.ContainsType
+import qualified Data.List.Extra
+import qualified Data.Semigroup as Semigroup
+import qualified Data.Text as Text
+import qualified GHC.OldList as List
+import Language.Haskell.Brittany.Internal.Config.Types
+import Language.Haskell.Brittany.Internal.Prelude
+import Language.Haskell.Brittany.Internal.PreludeUtils
+import Language.Haskell.Brittany.Internal.Types
+import Language.Haskell.Brittany.Internal.Utils
@@ -117,14 +116,6 @@ transformAlts =
rec :: BriDocNumbered -> Memo.MemoT Int [VerticalSpacing] (MultiRWSS.MultiRWS r w (AltCurPos ': s)) BriDocNumbered
rec bdX@(brDcId, brDc) = do
-#if INSERTTRACESALTVISIT
- do
- acp :: AltCurPos <- mGet
- tellDebugMess $ "transformAlts: visiting: " ++ case brDc of
- BDFAnnotationPrior annKey _ -> show (toConstr brDc, annKey, acp)
- BDFAnnotationRest annKey _ -> show (toConstr brDc, annKey, acp)
- _ -> show (toConstr brDc, acp)
-#endif
let reWrap = (,) brDcId
-- debugAcp :: AltCurPos <- mGet
case brDc of
@@ -206,22 +197,11 @@ transformAlts =
-- TODO: use COMPLETE pragma instead?
lineCheck _ = error "ghc exhaustive check is insufficient"
lconf <- _conf_layout <$> mAsk
-#if INSERTTRACESALT
- tellDebugMess $ "considering options with " ++ show (length alts, acp)
-#endif
let options = -- trace ("considering options:" ++ show (length alts, acp)) $
(zip spacings alts
<&> \(vs, bd) -> -- trace ("spacing=" ++ show vs ++ ",hasSpace=" ++ show (hasSpace lconf acp vs) ++ ",lineCheck=" ++ show (lineCheck vs))
( hasSpace1 lconf acp vs && lineCheck vs, bd))
-#if INSERTTRACESALT
- zip spacings options `forM_` \(vs, (_, bd)) ->
- tellDebugMess $ " " ++ "spacing=" ++ show vs
- ++ ",hasSpace1=" ++ show (hasSpace1 lconf acp vs)
- ++ ",lineCheck=" ++ show (lineCheck vs)
- ++ " " ++ show (toConstr bd)
-#endif
- id -- - $ (fmap $ \x -> traceShow (briDocToDoc x) x)
- $ rec
+ rec
$ fromMaybe (-- trace ("choosing last") $
List.last alts)
$ Data.List.Extra.firstJust (\(_i::Int, (b,x)) ->
@@ -240,9 +220,6 @@ transformAlts =
AltLineModeStateForceML{} -> p /= VerticalSpacingParNone
AltLineModeStateContradiction -> False
lconf <- _conf_layout <$> mAsk
-#if INSERTTRACESALT
- tellDebugMess $ "considering options with " ++ show (length alts, acp)
-#endif
let options = -- trace ("considering options:" ++ show (length alts, acp)) $
(zip spacings alts
<&> \(vs, bd) -> -- trace ("spacing=" ++ show vs ++ ",hasSpace=" ++ show (hasSpace lconf acp vs) ++ ",lineCheck=" ++ show (lineCheck vs))
@@ -250,16 +227,7 @@ transformAlts =
&& any lineCheck vs, bd))
let checkedOptions :: [Maybe (Int, BriDocNumbered)] =
zip [1..] options <&> (\(i, (b,x)) -> [ (i, x) | b ])
-#if INSERTTRACESALT
- zip spacings options `forM_` \(vs, (_, bd)) ->
- tellDebugMess $ " " ++ "spacing=" ++ show vs
- ++ ",hasSpace2=" ++ show (hasSpace2 lconf acp <$> vs)
- ++ ",lineCheck=" ++ show (lineCheck <$> vs)
- ++ " " ++ show (toConstr bd)
- tellDebugMess $ " " ++ show (Data.Maybe.mapMaybe (fmap fst) checkedOptions)
-#endif
- id -- - $ (fmap $ \x -> traceShow (briDocToDoc x) x)
- $ rec
+ rec
$ fromMaybe (-- trace ("choosing last") $
List.last alts)
$ Data.List.Extra.firstJust (fmap snd) checkedOptions
@@ -350,7 +318,7 @@ transformAlts =
LineModeValid (VerticalSpacing i VerticalSpacingParNone _) -> do
acp <- mGet
mSet $ acp { _acp_line = _acp_line acp + i }
- LineModeValid (VerticalSpacing _ _ _) -> error "processSpacingSimple par"
+ LineModeValid VerticalSpacing{} -> error "processSpacingSimple par"
_ -> error "ghc exhaustive check is insufficient"
hasSpace1 :: LayoutConfig -> AltCurPos -> LineModeValidity VerticalSpacing -> Bool
hasSpace1 _ _ LineModeInvalid = False
@@ -510,9 +478,6 @@ getSpacing !bridoc = rec bridoc
r <- rec bd
tellDebugMess $ "getSpacing: BDFDebug " ++ show s ++ " (node-id=" ++ show brDcId ++ "): mVs=" ++ show r
return r
-#if INSERTTRACESGETSPACING
- tellDebugMess $ "getSpacing: visiting: " ++ show (toConstr $ brDc) ++ " -> " ++ show result
-#endif
return result
maxVs :: [LineModeValidity VerticalSpacing] -> LineModeValidity VerticalSpacing
maxVs = foldl'
@@ -658,9 +623,9 @@ getSpacings limit bridoc = preFilterLimit <$> rec bridoc
BDFLit t ->
return $ [VerticalSpacing (Text.length t) VerticalSpacingParNone False]
BDFSeq list ->
- fmap sumVs . sequence . fmap filterAndLimit <$> rec `mapM` list
+ fmap sumVs . mapM filterAndLimit <$> rec `mapM` list
BDFCols _sig list ->
- fmap sumVs . sequence . fmap filterAndLimit <$> rec `mapM` list
+ fmap sumVs . mapM filterAndLimit <$> rec `mapM` list
BDFSeparator ->
return $ [VerticalSpacing 1 VerticalSpacingParNone False]
BDFAddBaseY indent bd -> do
@@ -867,16 +832,6 @@ getSpacings limit bridoc = preFilterLimit <$> rec bridoc
r <- rec bd
tellDebugMess $ "getSpacings: BDFDebug " ++ show s ++ " (node-id=" ++ show brDcId ++ "): vs=" ++ show (take 9 r)
return r
-#if INSERTTRACESGETSPACING
- case brdc of
- BDFAnnotationPrior{} -> return ()
- BDFAnnotationRest{} -> return ()
- _ -> mTell $ Seq.fromList ["getSpacings: visiting: "
- ++ show (toConstr $ brdc) -- (briDocToDoc $ unwrapBriDocNumbered (0, brdc))
- , " -> "
- ++ show (take 9 result)
- ]
-#endif
return result
maxVs :: [VerticalSpacing] -> VerticalSpacing
maxVs = foldl'
diff --git a/src/Language/Haskell/Brittany/Internal/Transformations/Columns.hs b/source/library/Language/Haskell/Brittany/Internal/Transformations/Columns.hs
similarity index 95%
rename from src/Language/Haskell/Brittany/Internal/Transformations/Columns.hs
rename to source/library/Language/Haskell/Brittany/Internal/Transformations/Columns.hs
index d652dda..3dcdb46 100644
--- a/src/Language/Haskell/Brittany/Internal/Transformations/Columns.hs
+++ b/source/library/Language/Haskell/Brittany/Internal/Transformations/Columns.hs
@@ -1,17 +1,12 @@
-module Language.Haskell.Brittany.Internal.Transformations.Columns
- ( transformSimplifyColumns
- )
-where
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NoImplicitPrelude #-}
-
-
-#include "prelude.inc"
-
-import Language.Haskell.Brittany.Internal.Utils
-import Language.Haskell.Brittany.Internal.Config.Types
-import Language.Haskell.Brittany.Internal.Types
+module Language.Haskell.Brittany.Internal.Transformations.Columns where
import qualified Data.Generics.Uniplate.Direct as Uniplate
+import qualified GHC.OldList as List
+import Language.Haskell.Brittany.Internal.Prelude
+import Language.Haskell.Brittany.Internal.Types
diff --git a/src/Language/Haskell/Brittany/Internal/Transformations/Floating.hs b/source/library/Language/Haskell/Brittany/Internal/Transformations/Floating.hs
similarity index 96%
rename from src/Language/Haskell/Brittany/Internal/Transformations/Floating.hs
rename to source/library/Language/Haskell/Brittany/Internal/Transformations/Floating.hs
index 4bb227b..5ba0ce5 100644
--- a/src/Language/Haskell/Brittany/Internal/Transformations/Floating.hs
+++ b/source/library/Language/Haskell/Brittany/Internal/Transformations/Floating.hs
@@ -1,17 +1,14 @@
-module Language.Haskell.Brittany.Internal.Transformations.Floating
- ( transformSimplifyFloating
- )
-where
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NoImplicitPrelude #-}
-
-
-#include "prelude.inc"
-
-import Language.Haskell.Brittany.Internal.Utils
-import Language.Haskell.Brittany.Internal.Config.Types
-import Language.Haskell.Brittany.Internal.Types
+module Language.Haskell.Brittany.Internal.Transformations.Floating where
import qualified Data.Generics.Uniplate.Direct as Uniplate
+import qualified GHC.OldList as List
+import Language.Haskell.Brittany.Internal.Prelude
+import Language.Haskell.Brittany.Internal.PreludeUtils
+import Language.Haskell.Brittany.Internal.Types
+import Language.Haskell.Brittany.Internal.Utils
diff --git a/src/Language/Haskell/Brittany/Internal/Transformations/Indent.hs b/source/library/Language/Haskell/Brittany/Internal/Transformations/Indent.hs
similarity index 87%
rename from src/Language/Haskell/Brittany/Internal/Transformations/Indent.hs
rename to source/library/Language/Haskell/Brittany/Internal/Transformations/Indent.hs
index b3d7709..648e7c7 100644
--- a/src/Language/Haskell/Brittany/Internal/Transformations/Indent.hs
+++ b/source/library/Language/Haskell/Brittany/Internal/Transformations/Indent.hs
@@ -1,17 +1,12 @@
-module Language.Haskell.Brittany.Internal.Transformations.Indent
- ( transformSimplifyIndent
- )
-where
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NoImplicitPrelude #-}
-
-
-#include "prelude.inc"
-
-import Language.Haskell.Brittany.Internal.Utils
-import Language.Haskell.Brittany.Internal.Config.Types
-import Language.Haskell.Brittany.Internal.Types
+module Language.Haskell.Brittany.Internal.Transformations.Indent where
import qualified Data.Generics.Uniplate.Direct as Uniplate
+import qualified GHC.OldList as List
+import Language.Haskell.Brittany.Internal.Prelude
+import Language.Haskell.Brittany.Internal.Types
diff --git a/src/Language/Haskell/Brittany/Internal/Transformations/Par.hs b/source/library/Language/Haskell/Brittany/Internal/Transformations/Par.hs
similarity index 78%
rename from src/Language/Haskell/Brittany/Internal/Transformations/Par.hs
rename to source/library/Language/Haskell/Brittany/Internal/Transformations/Par.hs
index e048584..2d1abf1 100644
--- a/src/Language/Haskell/Brittany/Internal/Transformations/Par.hs
+++ b/source/library/Language/Haskell/Brittany/Internal/Transformations/Par.hs
@@ -1,17 +1,11 @@
-module Language.Haskell.Brittany.Internal.Transformations.Par
- ( transformSimplifyPar
- )
-where
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+module Language.Haskell.Brittany.Internal.Transformations.Par where
-
-#include "prelude.inc"
-
-import Language.Haskell.Brittany.Internal.Utils
-import Language.Haskell.Brittany.Internal.Config.Types
-import Language.Haskell.Brittany.Internal.Types
-
-import qualified Data.Generics.Uniplate.Direct as Uniplate
+import Language.Haskell.Brittany.Internal.Prelude
+import Language.Haskell.Brittany.Internal.Types
+import Language.Haskell.Brittany.Internal.Utils
diff --git a/src/Language/Haskell/Brittany/Internal/Types.hs b/source/library/Language/Haskell/Brittany/Internal/Types.hs
similarity index 94%
rename from src/Language/Haskell/Brittany/Internal/Types.hs
rename to source/library/Language/Haskell/Brittany/Internal/Types.hs
index f402e56..6a2c8af 100644
--- a/src/Language/Haskell/Brittany/Internal/Types.hs
+++ b/source/library/Language/Haskell/Brittany/Internal/Types.hs
@@ -1,36 +1,36 @@
{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE PatternSynonyms #-}
-{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneDeriving #-}
-module Language.Haskell.Brittany.Internal.Types
-where
-
-
-
-#include "prelude.inc"
-
-import qualified Language.Haskell.GHC.ExactPrint as ExactPrint
-import qualified Language.Haskell.GHC.ExactPrint.Types as ExactPrint.Types
+module Language.Haskell.Brittany.Internal.Types where
+import qualified Control.Monad.Trans.MultiRWS.Strict as MultiRWSS
+import qualified Data.Data
+import Data.Generics.Uniplate.Direct as Uniplate
+import qualified Data.Kind as Kind
+import qualified Data.Strict.Maybe as Strict
import qualified Data.Text.Lazy.Builder as Text.Builder
-
-import GHC ( Located, runGhc, GenLocated(L), moduleNameString, AnnKeywordId, SrcSpan )
-
-import Language.Haskell.GHC.ExactPrint ( AnnKey, Comment )
-import Language.Haskell.GHC.ExactPrint.Types ( KeywordId, Anns, DeltaPos, mkAnnKey )
-
-import Language.Haskell.Brittany.Internal.Config.Types
-
-import Data.Generics.Uniplate.Direct as Uniplate
-
+import GHC (AnnKeywordId, GenLocated, Located, SrcSpan)
+import Language.Haskell.Brittany.Internal.Config.Types
+import Language.Haskell.Brittany.Internal.Prelude
+import qualified Language.Haskell.GHC.ExactPrint as ExactPrint
+import Language.Haskell.GHC.ExactPrint (AnnKey)
+import qualified Language.Haskell.GHC.ExactPrint.Types as ExactPrint.Types
+import Language.Haskell.GHC.ExactPrint.Types (Anns)
+import qualified Safe
data PerItemConfig = PerItemConfig
- { _icd_perBinding :: Map String (CConfig Option)
- , _icd_perKey :: Map ExactPrint.Types.AnnKey (CConfig Option)
+ { _icd_perBinding :: Map String (CConfig Maybe)
+ , _icd_perKey :: Map ExactPrint.Types.AnnKey (CConfig Maybe)
}
deriving Data.Data.Data
@@ -211,21 +211,21 @@ data ColSig
data BrIndent = BrIndentNone
| BrIndentRegular
| BrIndentSpecial Int
- deriving (Eq, Ord, Typeable, Data.Data.Data, Show)
+ deriving (Eq, Ord, Data.Data.Data, Show)
type ToBriDocM = MultiRWSS.MultiRWS
'[Config, Anns] -- reader
'[[BrittanyError], Seq String] -- writer
'[NodeAllocIndex] -- state
-type ToBriDoc (sym :: * -> *) = Located (sym GhcPs) -> ToBriDocM BriDocNumbered
+type ToBriDoc (sym :: Kind.Type -> Kind.Type) = Located (sym GhcPs) -> ToBriDocM BriDocNumbered
type ToBriDoc' sym = Located sym -> ToBriDocM BriDocNumbered
type ToBriDocC sym c = Located sym -> ToBriDocM c
data DocMultiLine
= MultiLineNo
| MultiLinePossible
- deriving (Eq, Typeable)
+ deriving (Eq)
-- isomorphic to BriDocF Identity. Provided for ease of use, as we do a lot
-- of transformations on `BriDocF Identity`s and it is really annoying to
@@ -412,7 +412,7 @@ briDocSeqSpine = \case
BDIndentLevelPushCur bd -> briDocSeqSpine bd
BDIndentLevelPop bd -> briDocSeqSpine bd
BDPar _ind line indented -> briDocSeqSpine line `seq` briDocSeqSpine indented
- BDAlt alts -> foldl' (\(!()) -> briDocSeqSpine) () alts
+ BDAlt alts -> foldl' (\() -> briDocSeqSpine) () alts
BDForwardLineMode bd -> briDocSeqSpine bd
BDExternal{} -> ()
BDPlain{} -> ()
@@ -420,7 +420,7 @@ briDocSeqSpine = \case
BDAnnotationKW _annKey _kw bd -> briDocSeqSpine bd
BDAnnotationRest _annKey bd -> briDocSeqSpine bd
BDMoveToKWDP _annKey _kw _b bd -> briDocSeqSpine bd
- BDLines lines -> foldl' (\(!()) -> briDocSeqSpine) () lines
+ BDLines lines -> foldl' (\() -> briDocSeqSpine) () lines
BDEnsureIndent _ind bd -> briDocSeqSpine bd
BDForceMultiline bd -> briDocSeqSpine bd
BDForceSingleline bd -> briDocSeqSpine bd
diff --git a/src/Language/Haskell/Brittany/Internal/Utils.hs b/source/library/Language/Haskell/Brittany/Internal/Utils.hs
similarity index 85%
rename from src/Language/Haskell/Brittany/Internal/Utils.hs
rename to source/library/Language/Haskell/Brittany/Internal/Utils.hs
index 5ee7ed2..38f9123 100644
--- a/src/Language/Haskell/Brittany/Internal/Utils.hs
+++ b/source/library/Language/Haskell/Brittany/Internal/Utils.hs
@@ -1,69 +1,34 @@
-{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE ScopedTypeVariables #-}
-module Language.Haskell.Brittany.Internal.Utils
- ( parDoc
- , parDocW
- , fromMaybeIdentity
- , fromOptionIdentity
- , traceIfDumpConf
- , mModify
- , customLayouterF
- , astToDoc
- , briDocToDoc
- -- , displayBriDocSimpleTree
- , annsDoc
- , Max (..)
- , tellDebugMess
- , tellDebugMessShow
- , briDocToDocWithAnns
- , breakEither
- , spanMaybe
- , transformUp
- , transformDownMay
- , FirstLastView(..)
- , splitFirstLast
- , lines'
- , showOutputable
- , absurdExt
- )
-where
+module Language.Haskell.Brittany.Internal.Utils where
-
-
-#include "prelude.inc"
-
-import qualified Language.Haskell.GHC.ExactPrint as ExactPrint
-import qualified Language.Haskell.GHC.ExactPrint.Annotate as ExactPrint.Annotate
+import qualified Data.ByteString as B
+import qualified Data.Coerce
+import Data.Data
+import Data.Generics.Aliases
+import qualified Data.Generics.Uniplate.Direct as Uniplate
+import qualified Data.Semigroup as Semigroup
+import qualified Data.Sequence as Seq
+import DataTreePrint
+import qualified GHC.Data.FastString as GHC
+import qualified GHC.Driver.Session as GHC
+import qualified GHC.Hs.Extension as HsExtension
+import qualified GHC.OldList as List
+import GHC.Types.Name.Occurrence as OccName (occNameString)
+import qualified GHC.Types.SrcLoc as GHC
+import qualified GHC.Utils.Outputable as GHC
+import Language.Haskell.Brittany.Internal.Config.Types
+import Language.Haskell.Brittany.Internal.Prelude
+import Language.Haskell.Brittany.Internal.PreludeUtils
+import Language.Haskell.Brittany.Internal.Types
import qualified Language.Haskell.GHC.ExactPrint.Types as ExactPrint.Types
import qualified Language.Haskell.GHC.ExactPrint.Utils as ExactPrint.Utils
-
-import Data.Data
-import Data.Generics.Schemes
-import Data.Generics.Aliases
-
import qualified Text.PrettyPrint as PP
-import Text.PrettyPrint ( ($+$), (<+>) )
-
-import qualified Outputable as GHC
-import qualified DynFlags as GHC
-import qualified FastString as GHC
-import qualified SrcLoc as GHC
-import OccName ( occNameString )
-import qualified Data.ByteString as B
-
-import DataTreePrint
-
-import Language.Haskell.Brittany.Internal.Config.Types
-import Language.Haskell.Brittany.Internal.Types
-
-import qualified Data.Generics.Uniplate.Direct as Uniplate
-#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
-import qualified GHC.Hs.Extension as HsExtension
-#else
-import qualified HsExtension
-#endif /* ghc-8.10.1 */
@@ -83,9 +48,9 @@ showOutputable = GHC.showPpr GHC.unsafeGlobalDynFlags
fromMaybeIdentity :: Identity a -> Maybe a -> Identity a
fromMaybeIdentity x y = Data.Coerce.coerce $ fromMaybe (Data.Coerce.coerce x) y
-fromOptionIdentity :: Identity a -> Option a -> Identity a
+fromOptionIdentity :: Identity a -> Maybe a -> Identity a
fromOptionIdentity x y =
- Data.Coerce.coerce $ fromMaybe (Data.Coerce.coerce x) $ getOption y
+ Data.Coerce.coerce $ fromMaybe (Data.Coerce.coerce x) y
-- maximum monoid over N+0
-- or more than N, because Num is allowed.
@@ -301,11 +266,5 @@ lines' s = case break (== '\n') s of
(s1, [_]) -> [s1, ""]
(s1, (_:r)) -> s1 : lines' r
-#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
absurdExt :: HsExtension.NoExtCon -> a
absurdExt = HsExtension.noExtCon
-#else
--- | A method to dismiss NoExt patterns for total matches
-absurdExt :: HsExtension.NoExt -> a
-absurdExt = error "cannot construct NoExt"
-#endif
diff --git a/src/Language/Haskell/Brittany/Main.hs b/source/library/Language/Haskell/Brittany/Main.hs
similarity index 86%
rename from src/Language/Haskell/Brittany/Main.hs
rename to source/library/Language/Haskell/Brittany/Main.hs
index c2f2254..ca9fc7b 100644
--- a/src/Language/Haskell/Brittany/Main.hs
+++ b/source/library/Language/Haskell/Brittany/Main.hs
@@ -1,55 +1,45 @@
-{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MultiWayIf #-}
+{-# LANGUAGE NoImplicitPrelude #-}
-module Language.Haskell.Brittany.Main (main) where
+module Language.Haskell.Brittany.Main where
-
-
-#include "prelude.inc"
-
--- brittany { lconfig_importAsColumn: 60, lconfig_importColumn: 60 }
-import qualified Language.Haskell.GHC.ExactPrint as ExactPrint
-import qualified Language.Haskell.GHC.ExactPrint.Annotate
- as ExactPrint.Annotate
-import qualified Language.Haskell.GHC.ExactPrint.Types as ExactPrint.Types
-import qualified Language.Haskell.GHC.ExactPrint.Parsers as ExactPrint.Parsers
-import qualified Data.Map as Map
+import Control.Monad (zipWithM)
+import qualified Control.Monad.Trans.Except as ExceptT
+import Data.CZipWith
+import qualified Data.Either
+import qualified Data.List.Extra
import qualified Data.Monoid
-
-import GHC ( GenLocated(L) )
-import Outputable ( Outputable(..)
- , showSDocUnsafe
- )
-
-import Text.Read ( Read(..) )
-import qualified Text.ParserCombinators.ReadP as ReadP
-import qualified Text.ParserCombinators.ReadPrec as ReadPrec
-import qualified Data.Text.Lazy.Builder as Text.Builder
-
-import Control.Monad ( zipWithM )
-import Data.CZipWith
-
-import qualified Debug.Trace as Trace
-
-import Language.Haskell.Brittany.Internal.Types
-import Language.Haskell.Brittany.Internal
-import Language.Haskell.Brittany.Internal.Config
-import Language.Haskell.Brittany.Internal.Config.Types
-import Language.Haskell.Brittany.Internal.Utils
-import Language.Haskell.Brittany.Internal.Obfuscation
-
-import qualified Text.PrettyPrint as PP
-
-import DataTreePrint
-import UI.Butcher.Monadic
-
+import qualified Data.Semigroup as Semigroup
+import qualified Data.Text as Text
+import qualified Data.Text.IO as Text.IO
+import qualified Data.Text.Lazy as TextL
+import DataTreePrint
+import GHC (GenLocated(L))
+import qualified GHC.Driver.Session as GHC
+import qualified GHC.LanguageExtensions.Type as GHC
+import qualified GHC.OldList as List
+import GHC.Utils.Outputable (Outputable(..), showSDocUnsafe)
+import Language.Haskell.Brittany.Internal
+import Language.Haskell.Brittany.Internal.Config
+import Language.Haskell.Brittany.Internal.Config.Types
+import Language.Haskell.Brittany.Internal.Obfuscation
+import Language.Haskell.Brittany.Internal.Prelude
+import Language.Haskell.Brittany.Internal.PreludeUtils
+import Language.Haskell.Brittany.Internal.Types
+import Language.Haskell.Brittany.Internal.Utils
+import qualified Language.Haskell.GHC.ExactPrint as ExactPrint
+import Paths_brittany
+import qualified System.Directory as Directory
+import qualified System.Environment as Environment
import qualified System.Exit
-import qualified System.Directory as Directory
-import qualified System.FilePath.Posix as FilePath
-
-import qualified DynFlags as GHC
-import qualified GHC.LanguageExtensions.Type as GHC
-
-import Paths_brittany
+import qualified System.FilePath.Posix as FilePath
+import qualified System.IO
+import qualified Text.ParserCombinators.ReadP as ReadP
+import qualified Text.ParserCombinators.ReadPrec as ReadPrec
+import qualified Text.PrettyPrint as PP
+import Text.Read (Read(..))
+import UI.Butcher.Monadic
@@ -65,7 +55,16 @@ instance Show WriteMode where
main :: IO ()
-main = mainFromCmdParserWithHelpDesc mainCmdParser
+main = do
+ progName <- Environment.getProgName
+ args <- Environment.getArgs
+ mainWith progName args
+
+mainWith :: String -> [String] -> IO ()
+mainWith progName args =
+ Environment.withProgName progName
+ . Environment.withArgs args
+ $ mainFromCmdParserWithHelpDesc mainCmdParser
helpDoc :: PP.Doc
helpDoc = PP.vcat $ List.intersperse
@@ -236,7 +235,7 @@ mainCmdParser helpDesc = do
outputPaths
if checkMode
- then when (any (== Changes) (Data.Either.rights results))
+ then when (Changes `elem` (Data.Either.rights results))
$ System.Exit.exitWith (System.Exit.ExitFailure 1)
else case results of
xs | all Data.Either.isRight xs -> pure ()
@@ -306,7 +305,7 @@ coreIO putErrorLnIO config suppressOutput checkMode inputPathM outputPathM =
let hackTransform = if hackAroundIncludes && not exactprintOnly
then List.intercalate "\n" . fmap hackF . lines'
else id
- inputString <- liftIO $ System.IO.hGetContents System.IO.stdin
+ inputString <- liftIO System.IO.getContents
parseRes <- liftIO $ parseModuleFromString ghcOptions
"stdin"
cppCheckFunc
@@ -372,8 +371,8 @@ coreIO putErrorLnIO config suppressOutput checkMode inputPathM outputPathM =
let out = TextL.toStrict $ if hackAroundIncludes
then
TextL.intercalate (TextL.pack "\n")
- $ fmap hackF
- $ TextL.splitOn (TextL.pack "\n") outRaw
+ $ hackF
+ <$> TextL.splitOn (TextL.pack "\n") outRaw
else outRaw
out' <- if moduleConf & _conf_obfuscate & confUnpack
then lift $ obfuscate out
@@ -385,7 +384,7 @@ coreIO putErrorLnIO config suppressOutput checkMode inputPathM outputPathM =
customErrOrder ErrorUnusedComment{} = 2
customErrOrder ErrorUnknownNode{} = -2 :: Int
customErrOrder ErrorMacroConfig{} = 5
- when (not $ null errsWarns) $ do
+ unless (null errsWarns) $ do
let groupedErrsWarns =
Data.List.Extra.groupOn customErrOrder
$ List.sortOn customErrOrder
@@ -438,9 +437,9 @@ coreIO putErrorLnIO config suppressOutput checkMode inputPathM outputPathM =
-- adds some override?
let
hasErrors =
- case config & _conf_errorHandling & _econf_Werror & confUnpack of
- False -> 0 < maximum (-1 : fmap customErrOrder errsWarns)
- True -> not $ null errsWarns
+ if config & _conf_errorHandling & _econf_Werror & confUnpack
+ then not $ null errsWarns
+ else 0 < maximum (-1 : fmap customErrOrder errsWarns)
outputOnErrs =
config
& _conf_errorHandling
diff --git a/source/test-suite/Main.hs b/source/test-suite/Main.hs
new file mode 100644
index 0000000..e48ec56
--- /dev/null
+++ b/source/test-suite/Main.hs
@@ -0,0 +1,37 @@
+import qualified Control.Monad as Monad
+import qualified Data.List as List
+import qualified Language.Haskell.Brittany.Main as Brittany
+import qualified System.Directory as Directory
+import qualified System.FilePath as FilePath
+import qualified Test.Hspec as Hspec
+
+main :: IO ()
+main = Hspec.hspec . Hspec.parallel $ do
+ let directory = "data"
+ entries <- Hspec.runIO $ Directory.listDirectory directory
+ Monad.forM_ (List.sort entries) $ \entry ->
+ case FilePath.stripExtension "hs" entry of
+ Nothing -> pure ()
+ Just slug -> Hspec.it slug $ do
+ let input = FilePath.combine directory entry
+ expected <- readFile input
+ let output = FilePath.combine "output" entry
+ Directory.copyFile input output
+ Brittany.mainWith
+ "brittany"
+ [ "--config-file"
+ , FilePath.combine directory "brittany.yaml"
+ , "--no-user-config"
+ , "--write-mode"
+ , "inplace"
+ , output
+ ]
+ actual <- readFile output
+ Literal actual `Hspec.shouldBe` Literal expected
+
+newtype Literal
+ = Literal String
+ deriving Eq
+
+instance Show Literal where
+ show (Literal x) = x
diff --git a/src-idemtests/.gitignore b/src-idemtests/.gitignore
deleted file mode 100644
index 4830bd8..0000000
--- a/src-idemtests/.gitignore
+++ /dev/null
@@ -1,4 +0,0 @@
-iterOne/
-iterTwo/
-brittany
-report.txt
diff --git a/src-idemtests/README b/src-idemtests/README
deleted file mode 100644
index 3560f17..0000000
--- a/src-idemtests/README
+++ /dev/null
@@ -1,17 +0,0 @@
-idempotency testing on real-life examples, i.e. checks that brittany(x) is
-equal to brittany(brittany(x)) for some x's. The idea is that these testcases
-are not yet transformed, i.e. that x is not brittany(x). This can capture
-certain bugs that are not detected by checking that brittany behaves as
-identity on "well-formed" input.
-
-to run:
-
-- put a "brittany" executable into this directory.
-- cd into this directory.
-- ./run.sh
-
-report.txt will contain the results.
-
-note that only the configuration in brittany.yaml is tested, which contains
-the default settings. ideally this would be managed in some other, more
-transparent fashion.
diff --git a/src-idemtests/brittany.yaml b/src-idemtests/brittany.yaml
deleted file mode 100644
index 6e5dcfb..0000000
--- a/src-idemtests/brittany.yaml
+++ /dev/null
@@ -1,29 +0,0 @@
-conf_errorHandling:
- econf_Werror: false
- econf_produceOutputOnErrors: false
- econf_CPPMode: CPPModeNowarn
-conf_layout:
- lconfig_indentPolicy: IndentPolicyFree
- lconfig_cols: 80
- lconfig_indentAmount: 2
- lconfig_importColumn: 60
- lconfig_altChooser:
- tag: AltChooserBoundedSearch
- contents: 3
- lconfig_indentWhereSpecial: true
- lconfig_indentListSpecial: true
-conf_forward:
- options_ghc: []
-conf_debug:
- dconf_dump_annotations: false
- dconf_dump_bridoc_simpl_par: false
- dconf_dump_bridoc_simpl_indent: false
- dconf_dump_bridoc_simpl_floating: false
- dconf_dump_ast_full: false
- dconf_dump_bridoc_simpl_columns: false
- dconf_dump_ast_unknown: false
- dconf_dump_bridoc_simpl_alt: false
- dconf_dump_bridoc_final: false
- dconf_dump_bridoc_raw: false
- dconf_dump_config: false
-
diff --git a/src-idemtests/cases/LayoutBasics.hs b/src-idemtests/cases/LayoutBasics.hs
deleted file mode 100644
index 3664d3e..0000000
--- a/src-idemtests/cases/LayoutBasics.hs
+++ /dev/null
@@ -1,747 +0,0 @@
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE DeriveDataTypeable #-}
-
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE GADTs #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE MonadComprehensions #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE MultiWayIf #-}
-{-# LANGUAGE KindSignatures #-}
-
-module Language.Haskell.Brittany.Internal.LayoutBasics
- ( processDefault
- , layoutByExact
- -- , layoutByExactR
- , descToBlockStart
- , descToBlockMinMax
- , descToMinMax
- , rdrNameToText
- , lrdrNameToText
- , lrdrNameToTextAnn
- , askIndent
- , calcLayoutMin
- , calcLayoutMax
- , getCurRemaining
- , layoutWriteAppend
- , layoutWriteAppendMultiline
- , layoutWriteNewline
- , layoutWriteNewlinePlain
- , layoutWriteEnsureNewline
- , layoutWriteEnsureBlock
- , layoutWriteEnsureBlockPlusN
- , layoutWithAddIndent
- , layoutWithAddIndentBlock
- , layoutWithAddIndentN
- , layoutWithAddIndentNBlock
- , layoutWithNonParamIndent
- , layoutWriteEnsureAbsoluteN
- , layoutAddSepSpace
- , moveToExactAnn
- , moveToExactAnn'
- , setOpIndent
- , stringLayouter
- , layoutWritePriorComments
- , layoutWritePostComments
- , layoutIndentRestorePostComment
- , layoutWritePriorCommentsRestore
- , layoutWritePostCommentsRestore
- , extractCommentsPrior
- , extractCommentsPost
- , applyLayouter
- , applyLayouterRestore
- , filterAnns
- , layouterFToLayouterM
- , ppmMoveToExactLoc
- , customLayouterF
- , docEmpty
- , docLit
- , docAlt
- , docSeq
- , docPar
- -- , docCols
- , docPostComment
- , docWrapNode
- , briDocByExact
- , fromMaybeIdentity
- , foldedAnnKeys
- )
-where
-
-
-
--- more imports here..
-
-import qualified Language.Haskell.GHC.ExactPrint as ExactPrint
-import qualified Language.Haskell.GHC.ExactPrint.Annotate as ExactPrint.Annotate
-import qualified Language.Haskell.GHC.ExactPrint.Types as ExactPrint.Types
-import qualified Language.Haskell.GHC.ExactPrint.Utils as ExactPrint.Utils
-
-import Language.Haskell.GHC.ExactPrint.Types ( AnnKey, Annotation )
-
-import qualified Data.Text.Lazy.Builder as Text.Builder
-
-import Language.Haskell.Brittany.Internal.Config.Types
-import Language.Haskell.Brittany.Internal.Types
-import Language.Haskell.Brittany.Internal.Utils
-
-import RdrName ( RdrName(..) )
-import GHC ( runGhc, GenLocated(L), moduleNameString )
-import qualified Outputable as GHC
-import qualified DynFlags as GHC
-import qualified FastString as GHC
-import qualified SrcLoc as GHC
-import SrcLoc ( SrcSpan )
-import OccName ( occNameString )
-import Name ( getOccString )
-import Module ( moduleName )
-import ApiAnnotation ( AnnKeywordId(..) )
-
-import Data.Data
-import Data.Generics.Schemes
-import Data.Generics.Aliases
-
-import DataTreePrint
-
-import qualified Text.PrettyPrint as PP
-
-import Data.Function ( fix )
-
-
-
-processDefault :: (ExactPrint.Annotate.Annotate ast, MonadMultiWriter
- Text.Builder.Builder m,
- MonadMultiReader ExactPrint.Types.Anns m)
- => GenLocated SrcSpan ast
- -> m ()
-processDefault x = do
- anns <- mAsk
- let str = ExactPrint.exactPrint x anns
- -- this hack is here so our print-empty-module trick does not add
- -- a newline at the start if there actually is no module header / imports
- -- / anything.
- -- TODO: instead the appropriate annotation could be removed when "cleaning"
- -- the module (header). This would remove the need for this hack!
- --test
- case str of
- "\n" -> return ()
- _ -> mTell $ Text.Builder.fromString $ str
-
-
-layoutByExact :: ( MonadMultiReader Config m
- , MonadMultiReader (ExactPrint.Types.Anns) m
- , ExactPrint.Annotate.Annotate ast
- )
- => GenLocated SrcSpan ast -> m Layouter
-layoutByExact x = do
- anns <- mAsk
- trace (showTreeWithCustom (customLayouterF anns) x) $ layoutByExactR x
- -- trace (ExactPrint.Utils.showAnnData anns 2 x) $ layoutByExactR x
-
-layoutByExactR :: (MonadMultiReader Config m
- , MonadMultiReader (ExactPrint.Types.Anns) m
- , ExactPrint.Annotate.Annotate ast)
- => GenLocated SrcSpan ast -> m Layouter
-layoutByExactR x = do
- indent <- askIndent
- anns <- mAsk
- let t = Text.pack $ ExactPrint.exactPrint x anns
- let tlines = Text.lines $ t <> Text.pack "\n"
- tlineCount = length tlines
- let len = indent + maximum (Text.length <$> tlines)
- return $ Layouter
- { _layouter_desc = LayoutDesc Nothing $ Just $ BlockDesc AllSameIndent len len Nothing
- , _layouter_func = \_ -> do
- -- layoutWriteEnsureBlock
- layoutWriteAppend $ Text.pack $ "{-" ++ show (ExactPrint.Types.mkAnnKey x, Map.lookup (ExactPrint.Types.mkAnnKey x) anns) ++ "-}"
- zip [1..] tlines `forM_` \(i, l) -> do
- layoutWriteAppend $ l
- unless (i==tlineCount) layoutWriteNewline
- do
- let subKeys = foldedAnnKeys x
- state <- mGet
- let filterF k _ = not $ k `Set.member` subKeys
- mSet $ state
- { _lstate_commentsPrior = Map.filterWithKey filterF
- $ _lstate_commentsPrior state
- , _lstate_commentsPost = Map.filterWithKey filterF
- $ _lstate_commentsPost state
- }
- , _layouter_ast = x
- }
-
-briDocByExact :: (ExactPrint.Annotate.Annotate ast,
- MonadMultiReader Config m,
- MonadMultiReader ExactPrint.Types.Anns m
- ) => GenLocated SrcSpan ast -> m BriDoc
-briDocByExact ast = do
- anns <- mAsk
- traceIfDumpConf "ast" _dconf_dump_ast_unknown
- (printTreeWithCustom 100 (customLayouterF anns) ast)
- return $ docExt ast anns
-
-descToBlockStart :: LayoutDesc -> Maybe BlockStart
-descToBlockStart (LayoutDesc _ (Just (BlockDesc bs _ _ _))) = Just bs
-descToBlockStart (LayoutDesc (Just line) _) = Just $ RestOfLine line
-descToBlockStart _ = Nothing
-
-descToBlockMinMax :: LayoutDesc -> Maybe (Int, Int)
-descToBlockMinMax (LayoutDesc _ (Just (BlockDesc _ bmin bmax _))) = Just (bmin, bmax)
-descToBlockMinMax _ = Nothing
-
-descToMinMax :: Int -> LayoutDesc -> Maybe (Int, Int)
-descToMinMax p (LayoutDesc _ (Just (BlockDesc start bmin bmax _))) =
- Just (max rolMin bmin, max rolMin bmax)
- where
- rolMin = case start of
- RestOfLine rol -> p + _lColumns_min rol
- AllSameIndent -> 0
-
-descToMinMax p (LayoutDesc (Just (LayoutColumns _ _ lmin)) _) =
- Just (len, len)
- where
- len = p + lmin
-descToMinMax _ _ =
- Nothing
-
-rdrNameToText :: RdrName -> Text
--- rdrNameToText = Text.pack . show . flip runSDoc unsafeGlobalDynFlags . ppr
-rdrNameToText ( Unqual occname ) = Text.pack $ occNameString occname
-rdrNameToText ( Qual mname occname ) = Text.pack $ moduleNameString mname
- ++ "."
- ++ occNameString occname
-rdrNameToText ( Orig modul occname ) = Text.pack $ moduleNameString (moduleName modul)
- ++ occNameString occname
-rdrNameToText ( Exact name ) = Text.pack $ getOccString name
-
-lrdrNameToText :: GenLocated l RdrName -> Text
-lrdrNameToText (L _ n) = rdrNameToText n
-
-lrdrNameToTextAnn :: ( MonadMultiReader Config m
- , MonadMultiReader (Map AnnKey Annotation) m
- )
- => GenLocated SrcSpan RdrName
- -> m Text
-lrdrNameToTextAnn ast@(L _ n) = do
- anns <- mAsk
- let t = rdrNameToText n
- let hasUni x (ExactPrint.Types.G y, _) = x==y
- hasUni _ _ = False
- -- TODO: in general: we should _always_ process all annotaiton stuff here.
- -- whatever we don't probably should have had some effect on the
- -- output. in such cases, resorting to byExact is probably the safe
- -- choice.
- return $ case Map.lookup (ExactPrint.Types.mkAnnKey ast) anns of
- Nothing -> traceShow "Nothing" t
- Just (ExactPrint.Types.Ann _ _ _ aks _ _) -> if
- | any (hasUni AnnBackquote) aks -> Text.pack "`" <> t <> Text.pack "`"
- | any (hasUni AnnOpenP) aks -> Text.pack "(" <> t <> Text.pack ")"
- | otherwise -> t
-
-
-askIndent :: (MonadMultiReader Config m) => m Int
-askIndent = runIdentity . _lconfig_indentAmount . _conf_layout <$> mAsk
-
--- minimum block width, judged from block info or line, whichever is
--- available.
--- example: calcLayoutMin doBlock ~~~ atomically $ do
--- foo
--- ## indent
--- ############# linepre
--- ############### result (in this case)
-calcLayoutMin :: Int -- basic indentation amount
- -> Int -- currently used width in current line (after indent)
- -- used to accurately calc placing of the current-line
- -- stuff ("do" in the above example) and its width.
- -> LayoutDesc
- -> Int
-calcLayoutMin indent linePre (LayoutDesc line block) = case (line, block) of
- (_, Just (BlockDesc AllSameIndent m _ _)) -> indent + m
- (_, Just (BlockDesc (RestOfLine inl) m _ _)) -> max (linePre + _lColumns_min inl) (indent + m)
- (Just s, _) -> indent + _lColumns_min s
- _ -> error "bad LayoutDesc mnasdoiucxvlkjasd"
-
--- see
-calcLayoutMax :: Int -- basic indentation amount
- -> Int -- currently used width in current line (after indent)
- -- used to accurately calc placing of the current-line
- -- stuff ("do" in the above example) and its width.
- -> LayoutDesc
- -> Int
-calcLayoutMax indent linePre (LayoutDesc line block) = case (line, block) of
- (Just s, _) -> linePre + _lColumns_min s
- (_, Just (BlockDesc AllSameIndent _ m _)) -> indent + m
- (_, Just (BlockDesc (RestOfLine inl) _ m _)) -> max (linePre + _lColumns_min inl) (indent + m)
- _ -> error "bad LayoutDesc msdnfgouvadnfoiu"
-
-getCurRemaining :: ( MonadMultiReader Config m
- , MonadMultiState LayoutState m
- )
- => m Int
-getCurRemaining = do
- cols <- mAsk <&> _conf_layout .> _lconfig_cols .> runIdentity
- clc <- _lstate_curLineCols <$> mGet
- return $ cols - clc
-
-layoutWriteAppend :: (MonadMultiWriter
- Text.Builder.Builder m,
- MonadMultiState LayoutState m)
- => Text
- -> m ()
-layoutWriteAppend t = do
- state <- mGet
- if _lstate_addSepSpace state
- then do
- mSet $ state { _lstate_curLineCols = _lstate_curLineCols state + Text.length t + 1
- , _lstate_addSepSpace = False
- }
- mTell $ Text.Builder.fromText $ Text.pack " " <> t
- else do
- mSet $ state { _lstate_curLineCols = _lstate_curLineCols state + Text.length t }
- mTell $ Text.Builder.fromText t
-
-layoutWriteAppendMultiline :: (MonadMultiWriter
- Text.Builder.Builder m,
- MonadMultiState LayoutState m)
- => Text
- -> m ()
-layoutWriteAppendMultiline t = case Text.lines t of
- [] -> return ()
- (l:lr) -> do
- layoutWriteAppend l
- lr `forM_` \x -> do
- layoutWriteNewlinePlain
- layoutWriteAppend x
-
--- adds a newline and adds spaces to reach the current indentation level.
--- TODO: rename newline -> newlineBlock and newlinePlain -> newline
-layoutWriteNewline :: (MonadMultiWriter
- Text.Builder.Builder m,
- MonadMultiState LayoutState m)
- => m ()
-layoutWriteNewline = do
- state <- mGet
- mSet $ state { _lstate_curLineCols = _lstate_indent state
- , _lstate_commentCol = Nothing
- , _lstate_addSepSpace = False
- }
- mTell $ Text.Builder.fromString $ "\n" ++ replicate (_lstate_indent state) ' '
-
--- | does _not_ add spaces to again reach the current indentation levels.
-layoutWriteNewlinePlain :: (MonadMultiWriter
- Text.Builder.Builder m,
- MonadMultiState LayoutState m)
- => m ()
-layoutWriteNewlinePlain = do
- state <- mGet
- mSet $ state { _lstate_curLineCols = 0
- , _lstate_commentCol = Nothing
- , _lstate_addSepSpace = False
- }
- mTell $ Text.Builder.fromString $ "\n"
-
-layoutWriteEnsureNewline :: (MonadMultiWriter
- Text.Builder.Builder m,
- MonadMultiState LayoutState m)
- => m ()
-layoutWriteEnsureNewline = do
- state <- mGet
- when (_lstate_curLineCols state /= _lstate_indent state)
- $ layoutWriteNewline
-
-layoutWriteEnsureBlock :: (MonadMultiWriter
- Text.Builder.Builder m,
- MonadMultiState LayoutState m)
- => m ()
-layoutWriteEnsureBlock = do
- state <- mGet
- let diff = _lstate_curLineCols state - _lstate_indent state
- if diff>0
- then layoutWriteNewline
- else if diff<0
- then do
- layoutWriteAppend $ Text.pack $ replicate (negate diff) ' '
- mSet $ state { _lstate_curLineCols = _lstate_indent state
- , _lstate_addSepSpace = False
- }
- else return ()
-
-layoutWriteEnsureAbsoluteN :: (MonadMultiWriter
- Text.Builder.Builder m,
- MonadMultiState LayoutState m)
- => Int -> m ()
-layoutWriteEnsureAbsoluteN n = do
- state <- mGet
- let diff = n - _lstate_curLineCols state
- if diff>0
- then do
- layoutWriteAppend $ Text.pack $ replicate diff ' '
- mSet $ state { _lstate_curLineCols = n
- , _lstate_addSepSpace = False
- }
- else return ()
-
-layoutWriteEnsureBlockPlusN :: (MonadMultiWriter
- Text.Builder.Builder m,
- MonadMultiState LayoutState m)
- => Int -> m ()
-layoutWriteEnsureBlockPlusN n = do
- state <- mGet
- let diff = _lstate_curLineCols state - _lstate_indent state - n
- if diff>0
- then layoutWriteNewline
- else if diff<0
- then do
- layoutWriteAppend $ Text.pack $ replicate (negate diff) ' '
- mSet $ state { _lstate_addSepSpace = False }
- else return ()
-
-layoutWithAddIndent :: (MonadMultiWriter
- Text.Builder.Builder m,
- MonadMultiState LayoutState m
- ,MonadMultiReader Config m)
- => m ()
- -> m ()
-layoutWithAddIndent m = do
- amount <- mAsk <&> _conf_layout .> _lconfig_indentAmount .> runIdentity
- state <- mGet
- mSet state { _lstate_indent = _lstate_indent state + amount }
- m
- do
- s <- mGet
- mSet $ s { _lstate_indent = _lstate_indent state }
-
-layoutWithAddIndentBlock :: (MonadMultiWriter
- Text.Builder.Builder m,
- MonadMultiState LayoutState m
- ,MonadMultiReader Config m)
- => m ()
- -> m ()
-layoutWithAddIndentBlock m = do
- amount <- mAsk <&> _conf_layout .> _lconfig_indentAmount .> runIdentity
- state <- mGet
- mSet state { _lstate_indent = _lstate_indent state + amount }
- layoutWriteEnsureBlock
- m
- do
- s <- mGet
- mSet $ s { _lstate_indent = _lstate_indent state }
-
-layoutWithAddIndentNBlock :: (MonadMultiWriter
- Text.Builder.Builder m,
- MonadMultiState LayoutState m)
- => Int
- -> m ()
- -> m ()
-layoutWithAddIndentNBlock amount m = do
- state <- mGet
- mSet state { _lstate_indent = _lstate_indent state + amount }
- layoutWriteEnsureBlock
- m
- do
- s <- mGet
- mSet $ s { _lstate_indent = _lstate_indent state }
-
-layoutWithAddIndentN :: (MonadMultiWriter
- Text.Builder.Builder m,
- MonadMultiState LayoutState m)
- => Int
- -> m ()
- -> m ()
-layoutWithAddIndentN amount m = do
- state <- mGet
- mSet state { _lstate_indent = _lstate_indent state + amount }
- m
- do
- s <- mGet
- mSet $ s { _lstate_indent = _lstate_indent state }
-
-layoutAddSepSpace :: MonadMultiState LayoutState m => m ()
-layoutAddSepSpace = do
- state <- mGet
- mSet $ state { _lstate_addSepSpace = True }
-
-moveToExactAnn :: (Data.Data.Data x,
- MonadMultiWriter Text.Builder.Builder m,
- MonadMultiState LayoutState m,
- MonadMultiReader (Map AnnKey Annotation) m) => GenLocated SrcSpan x -> m ()
-moveToExactAnn ast = do
- anns <- mAsk
- case Map.lookup (ExactPrint.Types.mkAnnKey ast) anns of
- Nothing -> return ()
- Just ann -> do
- let ExactPrint.Types.DP (x, _y) = ExactPrint.Types.annEntryDelta ann
- replicateM_ x $ layoutWriteNewline
-
--- TODO: when refactoring is complete, the other version of this method
--- can probably be removed.
-moveToExactAnn' :: (MonadMultiWriter Text.Builder.Builder m,
- MonadMultiState LayoutState m,
- MonadMultiReader (Map AnnKey Annotation) m) => AnnKey -> m ()
-moveToExactAnn' annKey = do
- anns <- mAsk
- case Map.lookup annKey anns of
- Nothing -> return ()
- Just ann -> do
- -- curY <- mGet <&> _lstate_curLineCols
- let ExactPrint.Types.DP (x, _y) = ExactPrint.Types.annEntryDelta ann
- replicateM_ x $ layoutWriteNewline
- -- when (x/=0) $ do
- -- replicateM_ x $ layoutWriteNewlinePlain
- -- mModify $ \s -> s { _lstate_curLineCols = curY }
- -- mTell $ Text.Builder.fromString $ replicate curY ' '
-
-ppmMoveToExactLoc :: MonadMultiWriter Text.Builder.Builder m
- => ExactPrint.Types.DeltaPos
- -> m ()
-ppmMoveToExactLoc (ExactPrint.Types.DP (x,y)) = do
- replicateM_ x $ mTell $ Text.Builder.fromString "\n"
- replicateM_ y $ mTell $ Text.Builder.fromString " "
-
-layoutWithNonParamIndent :: (MonadMultiWriter
- Text.Builder.Builder m,
- MonadMultiState LayoutState m)
- => LayoutFuncParams -> m () -> m ()
-layoutWithNonParamIndent params m = do
- case _params_opIndent params of
- Nothing -> m
- Just x -> layoutWithAddIndentN x m
-
-setOpIndent :: Int -> LayoutDesc -> LayoutFuncParams -> LayoutFuncParams
-setOpIndent i desc p = p
- { _params_opIndent = Just $ case _bdesc_opIndentFloatUp =<< _ldesc_block desc of
- Nothing -> i
- Just j -> max i j
- }
-
-stringLayouter :: Data.Data.Data ast
- => GenLocated SrcSpan ast -> Text -> Layouter
-stringLayouter ast t = Layouter
- { _layouter_desc = LayoutDesc
- { _ldesc_line = Just $ LayoutColumns
- { _lColumns_key = ColumnKeyUnique
- , _lColumns_lengths = [Text.length t]
- , _lColumns_min = Text.length t
- }
- , _ldesc_block = Nothing
- }
- , _layouter_func = \_ -> do
- layoutWritePriorCommentsRestore ast
- layoutWriteAppend t
- layoutWritePostComments ast
- , _layouter_ast = ast
- }
-
-layoutWritePriorComments :: (Data.Data.Data ast,
- MonadMultiWriter Text.Builder.Builder m,
- MonadMultiState LayoutState m)
- => GenLocated SrcSpan ast -> m ()
-layoutWritePriorComments ast = do
- mAnn <- do
- state <- mGet
- let key = ExactPrint.Types.mkAnnKey ast
- let m = _lstate_commentsPrior state
- let mAnn = Map.lookup key m
- mSet $ state { _lstate_commentsPrior = Map.delete key m }
- return mAnn
- case mAnn of
- Nothing -> return ()
- Just priors -> do
- when (not $ null priors) $ do
- state <- mGet
- mSet $ state { _lstate_commentCol = Just $ _lstate_curLineCols state }
- priors `forM_` \( ExactPrint.Types.Comment comment _ _
- , ExactPrint.Types.DP (x, y)
- ) -> do
- replicateM_ x layoutWriteNewlinePlain
- layoutWriteAppend $ Text.pack $ replicate y ' '
- layoutWriteAppendMultiline $ Text.pack $ comment
-
--- this currently only extracs from the `annsDP` field of Annotations.
--- per documentation, this seems sufficient, as the
--- "..`annFollowingComments` are only added by AST transformations ..".
-layoutWritePostComments :: (Data.Data.Data ast,
- MonadMultiWriter Text.Builder.Builder m,
- MonadMultiState LayoutState m)
- => GenLocated SrcSpan ast -> m ()
-layoutWritePostComments ast = do
- mAnn <- do
- state <- mGet
- let key = ExactPrint.Types.mkAnnKey ast
- let m = _lstate_commentsPost state
- let mAnn = Map.lookup key m
- mSet $ state { _lstate_commentsPost = Map.delete key m }
- return mAnn
- case mAnn of
- Nothing -> return ()
- Just posts -> do
- when (not $ null posts) $ do
- state <- mGet
- mSet $ state { _lstate_commentCol = Just $ _lstate_curLineCols state }
- posts `forM_` \( ExactPrint.Types.Comment comment _ _
- , ExactPrint.Types.DP (x, y)
- ) -> do
- replicateM_ x layoutWriteNewlinePlain
- layoutWriteAppend $ Text.pack $ replicate y ' '
- layoutWriteAppendMultiline $ Text.pack $ comment
-
-layoutIndentRestorePostComment :: ( Monad m
- , MonadMultiState LayoutState m
- , MonadMultiWriter Text.Builder.Builder m
- )
- => m ()
-layoutIndentRestorePostComment = do
- mCommentCol <- _lstate_commentCol <$> mGet
- case mCommentCol of
- Nothing -> return ()
- Just commentCol -> do
- layoutWriteNewlinePlain
- layoutWriteAppend $ Text.pack $ replicate commentCol ' '
-
-layoutWritePriorCommentsRestore :: (Data.Data.Data ast,
- MonadMultiWriter Text.Builder.Builder m,
- MonadMultiState LayoutState m)
- => GenLocated SrcSpan ast -> m ()
-layoutWritePriorCommentsRestore x = do
- layoutWritePriorComments x
- layoutIndentRestorePostComment
-
-layoutWritePostCommentsRestore :: (Data.Data.Data ast,
- MonadMultiWriter Text.Builder.Builder m,
- MonadMultiState LayoutState m)
- => GenLocated SrcSpan ast -> m ()
-layoutWritePostCommentsRestore x = do
- layoutWritePostComments x
- layoutIndentRestorePostComment
-
-extractCommentsPrior :: ExactPrint.Types.Anns -> PriorMap
-extractCommentsPrior anns = flip Map.mapMaybe anns $ \ann ->
- [r | let r = ExactPrint.Types.annPriorComments ann, not (null r)]
-extractCommentsPost :: ExactPrint.Types.Anns -> PostMap
-extractCommentsPost anns = flip Map.mapMaybe anns $ \ann ->
- [r
- | let
- r = ExactPrint.Types.annsDP ann
- >>= \case
- (ExactPrint.Types.AnnComment comment, dp) -> [(comment, dp)]
- _ -> []
- , not (null r)
- ]
-
-
-applyLayouter :: Layouter -> LayoutFuncParams -> LayoutM ()
-applyLayouter l@(Layouter _ _ ast) params = do
- -- (always) write the prior comments at this point.
- layoutWritePriorCommentsRestore ast
- -- run the real stuff.
- _layouter_func l params
- -- if the _layouter_func has not done so already at some point
- -- (there are nodes for which this makes sense),
- -- write the post comments.
- -- effect is `return ()` if there are no postComments.
- layoutWritePostComments ast
-
-applyLayouterRestore :: Layouter -> LayoutFuncParams -> LayoutM ()
-applyLayouterRestore l@(Layouter _ _ ast) params = do
- -- (always) write the prior comments at this point.
- layoutWritePriorCommentsRestore ast
- -- run the real stuff.
- _layouter_func l params
- -- if the _layouter_func has not done so already at some point
- -- (there are nodes for which this makes sense),
- -- write the post comments.
- -- effect is `return ()` if there are no postComments.
- layoutWritePostCommentsRestore ast
-
-foldedAnnKeys :: Data.Data.Data ast
- => ast
- -> Set ExactPrint.Types.AnnKey
-foldedAnnKeys ast = everything
- Set.union
- (\x -> maybe
- Set.empty
- Set.singleton
- [ gmapQi 1 (\t -> ExactPrint.Types.mkAnnKey $ L l t) x
- | typeRepTyCon (typeOf (L () ())) == (typeRepTyCon (typeOf x))
- , l <- gmapQi 0 cast x
- ]
- )
- ast
-
-filterAnns :: Data.Data.Data ast
- => ast
- -> ExactPrint.Types.Anns
- -> ExactPrint.Types.Anns
-filterAnns ast anns =
- Map.filterWithKey (\k _ -> k `Set.member` foldedAnnKeys ast) anns
-
-layouterFToLayouterM :: MultiReader '[Config, ExactPrint.Types.Anns] a -> LayoutM a
-layouterFToLayouterM m = do
- settings <- mAsk
- anns <- mAsk
- return $ runIdentity
- $ runMultiReaderTNil
- $ Control.Monad.Trans.MultiReader.Lazy.withMultiReader anns
- $ Control.Monad.Trans.MultiReader.Lazy.withMultiReader settings
- $ m
-
--- new BriDoc stuff
-
-docEmpty :: BriDoc
-docEmpty = BDEmpty
-
-docLit :: Text -> BriDoc
-docLit t = BDLit t
-
-docExt :: ExactPrint.Annotate.Annotate ast
- => GenLocated SrcSpan ast -> ExactPrint.Types.Anns -> BriDoc
-docExt x anns = BDExternal
- (ExactPrint.Types.mkAnnKey x)
- (foldedAnnKeys x)
- (Text.pack $ ExactPrint.exactPrint x anns)
-
-docAlt :: [BriDoc] -> BriDoc
-docAlt = BDAlt
-
-
-docSeq :: [BriDoc] -> BriDoc
-docSeq = BDSeq
-
-
-docPostComment :: Data.Data.Data ast
- => GenLocated SrcSpan ast
- -> BriDoc
- -> BriDoc
-docPostComment ast bd = BDAnnotationPost (ExactPrint.Types.mkAnnKey ast) bd
-
-docWrapNode :: Data.Data.Data ast
- => GenLocated SrcSpan ast
- -> BriDoc
- -> BriDoc
-docWrapNode ast bd = BDAnnotationPrior (ExactPrint.Types.mkAnnKey ast)
- $ BDAnnotationPost (ExactPrint.Types.mkAnnKey ast)
- $ bd
-
-docPar :: BriDoc
- -> BriDoc
- -> BriDoc
-docPar line indented = BDPar BrIndentNone line indented
-
--- docPar :: BriDoc
--- -> BrIndent
--- -> [BriDoc]
--- -> BriDoc
--- docPar = BDPar
-
--- docCols :: ColSig
--- -> [BriDoc]
--- -> BriDoc
--- docCols = BDCols
-
-
-fromMaybeIdentity :: Identity a -> Maybe a -> Identity a
-fromMaybeIdentity x y = Data.Coerce.coerce
- $ fromMaybe (Data.Coerce.coerce x) y
diff --git a/src-idemtests/run.sh b/src-idemtests/run.sh
deleted file mode 100755
index 298ecef..0000000
--- a/src-idemtests/run.sh
+++ /dev/null
@@ -1,36 +0,0 @@
-#!/bin/bash
-
-# set -x
-set -e
-
-rm report.txt &> /dev/null || true
-
-mkdir iterOne &> /dev/null || true
-mkdir iterTwo &> /dev/null || true
-
-for FILE in ./cases/*
-do
- NAME=$(basename "$FILE")
- ITERNAMEONE="./iterOne/$NAME"
- ITERNAMETWO="./iterTwo/$NAME"
- if ! ./brittany -i "$FILE" -o "$ITERNAMEONE"
- then
- echo "FAILED step 1 for $FILE" | tee -a report.txt
- continue
- fi
- if ! ./brittany -i "$ITERNAMEONE" -o "$ITERNAMETWO"
- then
- echo "FAILED step 2 for $FILE" | tee -a report.txt
- continue
- fi
- if ! diff "$ITERNAMEONE" "$ITERNAMETWO" > diff.temp
- then
- echo "FAILED diff for $FILE with diff:" | tee -a report.txt
- cat diff.temp | tee -a report.txt
- echo "# meld $(realpath $ITERNAMEONE) $(realpath $ITERNAMETWO)" | tee -a report.txt
- continue
- fi
- echo "success for $FILE" | tee -a report.txt
-done
-
-rm diff.temp &> /dev/null || true
diff --git a/src-libinterfacetests/Main.hs b/src-libinterfacetests/Main.hs
deleted file mode 100644
index 8334328..0000000
--- a/src-libinterfacetests/Main.hs
+++ /dev/null
@@ -1,32 +0,0 @@
-module Main where
-
-
-
-import Test.Hspec
-import Language.Haskell.Brittany
-import qualified Data.Text as Text
-import qualified System.Exit as Exit
-import Control.Monad.IO.Class
-
-
-
-main :: IO ()
-main = hspec $ do
- describe "library interface basic functionality" $ do
- it "gives properly formatted result for valid input" $ do
- let
- input = Text.pack $ unlines
- ["func = [00000000000000000000000, 00000000000000000000000, 00000000000000000000000, 00000000000000000000000]"]
- let expected = Text.pack $ unlines
- [ "func ="
- , " [ 00000000000000000000000"
- , " , 00000000000000000000000"
- , " , 00000000000000000000000"
- , " , 00000000000000000000000"
- , " ]"
- ]
- output <- liftIO $ parsePrintModule staticDefaultConfig input
- input `shouldSatisfy` \_ -> case output of
- Right x | x == expected -> True
- _ -> False
-
diff --git a/src-literatetests/10-tests.blt b/src-literatetests/10-tests.blt
deleted file mode 100644
index 806dd47..0000000
--- a/src-literatetests/10-tests.blt
+++ /dev/null
@@ -1,1630 +0,0 @@
-
-###############################################################################
-###############################################################################
-###############################################################################
-#group type signatures
-###############################################################################
-###############################################################################
-###############################################################################
-
-#test simple001
-func :: a -> a
-
-#test long typeVar
-func
- :: lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
- -> lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
-
-#test keep linebreak mode
-func
- :: lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
- -> lakjsdlkjasldkj
- -> lakjsdlkjasldkj
-
-#test simple parens 1
-func :: ((a))
-
-#test simple parens 2
-func :: (a -> a) -> a
-
-#test simple parens 3
-func :: a -> (a -> a)
-
-#test did anyone say parentheses?
-func :: (((((((((())))))))))
-
--- current output is.. funny. wonder if that can/needs to be improved..
-#test give me more!
-#pending
-func :: ((((((((((((((((((((((((((((((((((((((((((()))))))))))))))))))))))))))))))))))))))))))
-
-#test unit
-func :: ()
-
-
-###############################################################################
-
-#test paren'd func 1
-func
- :: ( lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
- -> lakjsdlkjasldkj
- -> lakjsdlkjasldkj
- )
-
-#test paren'd func 2
-func
- :: lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
- -> (lakjsdlkjasldkj -> lakjsdlkjasldkj)
-
-#test paren'd func 3
-func
- :: (lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd -> lakjsdlkjasldkj)
- -> lakjsdlkjasldkj
-
-#test paren'd func 4
-func
- :: ( lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
- -> lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
- )
- -> lakjsdlkjasldkj
-
-#test paren'd func 5
-func
- :: ( ( lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
- -> lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
- )
- )
-
-###############################################################################
-
-#test type application 1
-func :: asd -> Either a b
-
-#test type application 2
-func
- :: asd
- -> Either
- lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
- lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
-
-#test type application 3
-func
- :: asd
- -> Trither
- lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
- lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
- lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
-
-#test type application 4
-func
- :: Trither
- lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
- lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
- lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
- -> asd
-
-#test type application 5
-func
- :: Trither
- lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
- lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
- (lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd -> asd)
-
-#test type application 6
-func
- :: Trither
- asd
- lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
- ( lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
- -> lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
- )
-
-#test type application paren 1
-func
- :: asd
- -> ( Trither
- lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
- lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
- lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
- )
-
-#test type application paren 2
-func
- :: asd
- -> ( Trither
- lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
- lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
- )
- lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
-
-#test type application paren 3
-func
- :: ( Trither
- lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
- lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
- )
- lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
- -> asd
-
-###############################################################################
-
-#test list simple
-func :: [a -> b]
-
-#test list func
-func
- :: [ lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
- -> lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
- ]
-
-#test list paren
-func
- :: [ ( lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
- -> lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
- )
- ]
-
-################################################################## -- #############
-
-#test tuple type 1
-func :: (a, b, c)
-
-#test tuple type 2
-func :: ((a, b, c), (a, b, c), (a, b, c))
-
-#test tuple type long
-func
- :: ( lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
- , lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
- , lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
- )
-
-#test tuple type nested
-func
- :: ( ( lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
- , (lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd)
- , lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
- )
- )
-
-#test tuple type function
-func
- :: [ ( lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
- , lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
- , lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
- )
- ]
-###############################################################################
-#test type operator stuff
-#pending
-test050 :: a :+: b
-test051 :: lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
- :+: lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
-test052 :: lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
- -> lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
- :+: lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
- -> lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
-
-###############################################################################
-
-#test forall oneliner
-{-# LANGUAGE ScopedTypeVariables #-}
-func :: forall (a :: *) b . a -> b
-
-#test forall context multiline
-{-# LANGUAGE ScopedTypeVariables #-}
-func
- :: forall m
- . Foo
- => ColMap2
- -> ColInfo
- -> ColInfo
- -> ColInfo
- -> ColInfo
- -> m ()
-
-#test forall no-context multiline
-{-# LANGUAGE ScopedTypeVariables #-}
-func
- :: forall m
- . ColMap2
- -> ColInfo
- -> ColInfo
- -> ColInfo
- -> ColInfo
- -> ColInfo
- -> m ()
-
-#test forall context multiline with comments
-{-# LANGUAGE RankNTypes #-}
-addFlagStringParam
- :: forall f out
- . (Applicative f)
- => String -- ^ short flag chars, i.e. "v" for -v
- -> [String] -- ^ list of long names, i.e. ["verbose"]
- -> String -- ^ param name
- -> Flag String -- ^ properties
- -> CmdParser f out String
-
-#test language pragma issue
-{-# LANGUAGE ScopedTypeVariables #-}
-func :: forall (a :: *) b . a -> b
-
-#test comments 1
-func :: a -> b -- comment
-
-#test comments 2
-funcA :: a -> b -- comment A
-funcB :: a -> b -- comment B
-
-#test comments all
-#pending
--- a
-func -- b
- :: -- c
- a -- d
- -> -- e
- ( -- f
- c -- g
- , -- h
- d -- i
- ) -- j
--- k
-
-
-###############################################################################
-###############################################################################
-###############################################################################
-#group type signatures pragmas
-###############################################################################
-###############################################################################
-###############################################################################
-
-#test inline pragma 1
-func = f
- where
- {-# INLINE f #-}
- f = id
-
-#test inline pragma 2
-func = ($)
- where
- {-# INLINE ($) #-}
- ($) = id
-
-#test inline pragma 3
-func = f
- where
- {-# INLINE CONLIKE [1] f #-}
- f = id
-
-#test noinline pragma 1
-{-# NOINLINE func #-}
-func :: Int
-
-#test inline pragma 4
-#pending this does not work with the compiler version we currently use yet (i think). should work with ghc-8.0.2.
-func = f
- where
- {-# INLINE [~] f #-}
- f = id
-
-
-###############################################################################
-###############################################################################
-###############################################################################
-#group data type declarations
-###############################################################################
-###############################################################################
-###############################################################################
-
-#test nullary data type
-data Foo = Bar {}
-
-data Biz = Baz
-
-#test single record
-data Foo = Bar
- { foo :: Baz
- }
-
-#test record multiple names
-data Foo = Bar
- { foo, bar :: Baz
- }
-
-#test record multiple types
-data Foo = Bar
- { foo :: Baz
- , bars :: Bizzz
- }
-
-#test record multiple types and names
-data Foo = Bar
- { foo, biz :: Baz
- , bar :: Bizzz
- }
-
-#test record multiple types deriving
-data Foo = Bar
- { fooz :: Baz
- , bar :: Bizzz
- }
- deriving Show
-
-#test record long field names
-data MyRecord = MyConstructor
- { bar1, bar2
- :: Loooooooooooooooooooooooooooooooong
- -> Loooooooooooooooooooooooooooooooong
- , foo1, foo2
- :: Loooooooooooooooooooooooooooooooonger
- -> Loooooooooooooooooooooooooooooooonger
- }
-
-#test record with DataTypeContexts
-{-# LANGUAGE DatatypeContexts #-}
-data
- ( LooooooooooooooooooooongConstraint a
- , LooooooooooooooooooooongConstraint b
- ) =>
- MyRecord a b
- = MyConstructor
- { foo1, foo2
- :: loooooooooooooooooooooooooooooooong
- -> loooooooooooooooooooooooooooooooong
- , bar :: a
- , bazz :: b
- }
-
-#test record single line layout
-#pending config flag is disabled for now
-{-# LANGUAGE ScopedTypeVariables #-}
--- brittany { lconfig_allowSinglelineRecord: true }
-data MyRecord = forall a . Show a => MyCons { foo :: a -> a, i :: Int }
-
-#test record no matching single line layout
-{-# LANGUAGE ScopedTypeVariables #-}
--- brittany { lconfig_allowSinglelineRecord: true }
-data MyRecord = forall a . Show a => Bar
- { foo :: abittoolongbutnotvery -> abittoolongbutnotvery
- }
-
-#test record forall constraint multiline
-{-# LANGUAGE ScopedTypeVariables #-}
-data MyRecord
- = forall a
- . LooooooooooooooooooooongConstraint a =>
- LoooooooooooongConstructor
- { foo :: abittoolongbutnotvery -> abittoolongbutnotvery
- }
-
-#test record forall constraint multiline more
-{-# LANGUAGE ScopedTypeVariables #-}
-data MyRecord
- = forall a b
- . ( Loooooooooooooooooooooooooooooooong a
- , Loooooooooooooooooooooooooooooooong b
- ) =>
- MyConstructor
- { a :: a
- , b :: b
- }
-
-#test plain with forall and constraint
-{-# LANGUAGE ScopedTypeVariables #-}
-data MyStruct
- = forall a b
- . ( Loooooooooooooooooooooooooooooooong a
- , Loooooooooooooooooooooooooooooooong b
- ) =>
- MyConstructor (ToBriDocM BriDocNumbered)
- (ToBriDocM BriDocNumbered)
- (ToBriDocM BriDocNumbered)
-
-#test record with many features
-{-# LANGUAGE ScopedTypeVariables #-}
-data MyRecord
- = forall a b
- . ( Loooooooooooooooooooooooooooooooong a
- , Loooooooooooooooooooooooooooooooong b
- ) =>
- MyConstructor
- { foo, foo2
- :: loooooooooooooooooooooooooooooooong
- -> loooooooooooooooooooooooooooooooong
- , bar :: a
- , bazz :: b
- }
- deriving Show
-
-#test record multiple types deriving
-data Foo = Bar
- { foo :: Baz
- , bars :: Bizzz
- }
- deriving (Show, Eq, Monad, Functor, Traversable, Foldable)
-
-#test record multiple deriving strategies
-#min-ghc 8.2
-data Foo = Bar
- { foo :: Baz
- , bars :: Bizzz
- }
- deriving Show
- deriving (Eq, Ord)
- deriving stock Show
- deriving stock (Eq, Ord)
- deriving anyclass Show
- deriving anyclass (Show, Eq, Monad, Functor)
- deriving newtype Show
- deriving newtype (Traversable, Foldable)
-
-#test record deriving via
-#min-ghc 8.6
-data Foo = Bar
- { foo :: Baz
- , bars :: Bizzz
- }
- deriving ToJSON via (SomeType)
- deriving (ToJSON, FromJSON) via (SomeType)
-
-#test single record existential
-{-# LANGUAGE ExistentialQuantification #-}
-
-data Foo = forall a . Show a => Bar
- { foo :: a
- }
-
-#test record multiple types existential
-{-# LANGUAGE ExistentialQuantification #-}
-
-data Foo = forall a b . (Show a, Eq b) => Bar
- { foo :: a
- , bars :: b
- }
-
-#test plain comment simple
--- before
-data MyData = MyData Int
--- after
-
-#test record newline comment
-data MyRecord = MyRecord
- { a :: Int
- -- comment
- , b :: Int
- }
-
-#test record comments simple
-data Foo = Bar -- a
- { foo :: Baz -- b
- , bars :: Bizzz -- c
- } -- d
- deriving (Show, Eq, Monad, Functor, Traversable, Foldable) -- e
-
-#test record comments strange inline
-data Foo = Bar
- { -- a
- foo -- b
- :: -- c
- Baz -- d
- , -- e
- bars :: Bizzz
- }
- deriving (Show, Eq, Monad, Functor, Traversable, Foldable)
-
-#test record comments in deriving
-## maybe we want to switch to a differnt layout when there are such comments.
-## Don't hesitate to modify this testcase, it clearly is not the ideal layout
-## for this.
-
-data Foo = Bar
- { foo :: Baz
- , bars :: Bizzz
- }
- -- a
- deriving --b
- ( -- c
- ToJSON -- d
- , -- e
- FromJSON --f
- ) -- g
-
-#test record comments in deriving via
-## maybe we want to switch to a differnt layout when there are such comments.
-## Don't hesitate to modify this testcase, it clearly is not the ideal layout
-## for this.
-#min-ghc 8.6
-
-data Foo = Bar
- { foo :: Baz
- , bars :: Bizzz
- }
- -- a
- deriving --a
- ToJSON --b
- via -- c
- ( -- d
- SomeType --e
- , -- f
- ABC --g
- )
-
-#test comment before equal sign
-{-# LANGUAGE ExistentialQuantification #-}
-data MyRecord
- -- test comment
- = forall a b
- . ( Loooooooooooooooooooooooooooooooong a
- , Loooooooooooooooooooooooooooooooong b
- ) =>
- MyConstructor a b
-
-#test normal records on multi line indent policy left
--- brittany {lconfig_indentPolicy: IndentPolicyLeft }
-data EnterpriseGrantsForCompanyResponse = EnterpriseGrantsForCompanyResponse
- Types.Company
- [EnterpriseGrantResponse]
-
-#test normal records on multi line indent policy free
--- brittany {lconfig_indentPolicy: IndentPolicyFree }
-data GrantsForCompanyResp = GrantsForCompanyResp Types.Company
- [EnterpriseGrantResponse]
-
-#test normal records on multi line indent policy free 2
--- brittany {lconfig_indentPolicy: IndentPolicyFree }
-data EnterpriseGrantsForCompanyResponse = EnterpriseGrantsForCompanyResponse
- Types.Company
- [EnterpriseGrantResponse]
-
-#test normal records on multi line indent policy multiple
--- brittany {lconfig_indentPolicy: IndentPolicyMultiple }
-data GrantsForCompanyResp = GrantsForCompanyResp Types.Company
- [EnterpriseGrantResponse]
-
-#test large record with a comment
-data XIILqcacwiuNiu = XIILqcacwiuNiu
- { oyyFtvbepgbOge_pebzVmuftEijwuj :: Jgtoyuh HessJvNlo
- , wloQsiskdoxJop_xatiKrwedOxtu :: Jgtoyuh [Inotg]
- , mmmJjcqtemyIyo_ovosDoreKeeoyamvove :: Jgtoyuh Eujo
- , mbiIatelofxOzr_uluxNngiiMjah :: Jgtoyuh HessJvNlo
- , obxIskfcxpkIkb_uuviTuevcSkrgo :: Jgtoyuh Int
- , wqrAtuvuecoHwr_ilotNxbuPleo :: Jgtoyuh Ufaxdeq
- , lofAfuebdhpLuv_cnekPoyFxmg :: Jgtoyuh Ufaxdeq
- , ouoFugtawzvUpk_oupiLzptugy :: Jgtoyuh Eujo
- , iqiXjtziwogNsa_uiyvSunaTtgUsf3 :: Jgtoyuh Oaivn
- , odbIriaqnojUlz_onotoWuunehIpuy :: Jgtoyuh Eujo
- , opjUxtkxzkiKse_luqjuZazt
- :: Jgtoyuh [(Eujo, Int, Int, Int, Int, Int, NELUxro)]
- -- , jcqRaqznxfhIpa_ywevMezmoYkutuwa :: Jgtoyuh ()
- , vayOmuasyphOfd_bcsVljmvt :: Jgtoyuh Eujo
- , rifArahilooRax_ufikecqdImsv :: Jgtoyuh Oaivn
- , raqKtopcpszDwb_oqocubasZuqjcryoDojGkw :: Jgtoyuh Oaivn
- , mluJiilpcijUtt_gaisklifVekfeyagRmfbyzz :: Jgtoyuh Oaivn
- , oqhPaahjupaSmi_gamwwoovKyxznecvEayluc :: Jgtoyuh Oaivn
- , mazFubimwebZpa_itidehDodiDlboz :: Jgtoyuh Vrep
- , jeyOcuesexaYoy_vpqn :: Jgtoyuh ()
- }
-
-###############################################################################
-###############################################################################
-###############################################################################
-#group equation.basic
-###############################################################################
-###############################################################################
-###############################################################################
-## some basic testing of different kinds of equations.
-## some focus on column layouting for multiple-equation definitions.
-## (that part probably is not implemented in any way yet.)
-
-#test basic 1
-func x = x
-
-#test infix 1
-x *** y = x
-
-#test symbol prefix
-(***) x y = x
-
-#test infix more args simple
-(f >=> g) k = f k >>= g
-
-#test infix more args alignment
-(Left a <$$> Left dd) e f = True
-(Left a <$$> Right d ) e f = True
-(Right a <$$> Left d ) e f = False
-(Right a <$$> Right dd) e f = True
-
-
-###############################################################################
-###############################################################################
-###############################################################################
-#group equation.patterns
-###############################################################################
-###############################################################################
-###############################################################################
-
-#test wildcard
-func _ = x
-
-#test simple long pattern
-#pending
-func reallyreallyreallyreallyreallyreallyreallyreallyreallyreallylongvariable
- = x
-
-#test simple multiline pattern
-#pending
-func reallyreallyreallyreallyreallyreallyreallyreallyreallyreallylongvariable
- reallyreallyreallyreallyreallyreallyreallyreallyreallyreallylongvariable
- = x
-
-#test another multiline pattern
-#pending
-func reallyreallyreallyreallyreallyreallyreallyreallyreallyreallylongvariable
- a
- b
- = x
-
-#test simple constructor
-func (A a) = a
-
-#test list constructor
-func (x : xr) = x
-
-#test some other constructor symbol
-#pending
-func (x :+: xr) = x
-
-#test normal infix constructor
-func (x `Foo` xr) = x
-
-
-###############################################################################
-###############################################################################
-###############################################################################
-#group equation.guards
-###############################################################################
-###############################################################################
-###############################################################################
-#test simple guard
-func | True = x
-
-#test multiple-clauses-1
-func x | x = simple expression
- | otherwise = 0
-
-#test multiple-clauses-2
-func x
- | a somewhat longer guard x = "and a somewhat longer expession that does not"
- | otherwise = "fit without putting the guards in new lines"
-
-#test multiple-clauses-3
-func x
- | very long guard, another rather long guard that refers to x = nontrivial
- expression
- foo
- bar
- alsdkjlasdjlasj
- | otherwise = 0
-
-#test multiple-clauses-4
-func x
- | very long guard, another rather long guard that refers to x
- = nontrivialexpression foo bar alsdkjlasdjlasj
- | otherwise
- = 0
-
-#test multiple-clauses-5
-func x
- | very loooooooooooooooooooooooooooooong guard
- , another rather long guard that refers to x
- = nontrivial expression foo bar alsdkjlasdjlasj
- | otherwise
- = 0
-
-
-###############################################################################
-###############################################################################
-###############################################################################
-#group expression.basic
-###############################################################################
-###############################################################################
-###############################################################################
-
-#test var
-func = x
-
-describe "infix op" $ do
-#test 1
-func = x + x
-
-#test long
-#pending
-func = mweroiuxlskdfjlksjdflkjsdfljksldkjflkjsdflkj
- + mweroiuxlskdfjlksjdflkjsdfljksldkjflkjsdflkj
-
-#test long keep linemode 1
-#pending
-func = mweroiuxlskdfjlksjdflkjsdfljksldkjflkjsdflkj
- + mweroiuxlskdfjlksj
- + mweroiuxlskdfjlksj
-
-#test long keep linemode 2
-#pending
-func = mweroiuxlskdfjlksj
- + mweroiuxlskdfjlksj
- + mweroiuxlskdfjlksjdflkjsdfljksldkjflkjsdflkj
-
-#test literals
-func = 1
-func = "abc"
-func = 1.1e5
-func = 'x'
-func = 981409823458910394810928414192837123987123987123
-
-#test lambda
-func = \x -> abc
-
-describe "app" $ do
-#test 1
-func = klajsdas klajsdas klajsdas
-
-#test 2
-func = lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd
- lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd
- lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd
-
-#test 3
-func = lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd lakjsdlajsdljas
- lakjsdlajsdljas
- lakjsdlajsdljas
-
-###
-#group expression.basic.sections
-###
-
-#test left
-func = (1 +)
-
-#test right
-func = (+ 1)
-
-#test left inf
-func = (1 `abc`)
-
-#test right inf
-func = (`abc` 1)
-
-###
-#group tuples
-###
-
-#test pair
-func = (abc, def)
-
-#test pair section left
-func = (abc, )
-
-#test pair section right
-func = (, abc)
-
-#test quintuple section long
-myTupleSection =
- ( verylaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaargefirstelement
- ,
- , verylaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaargethirdelement
- ,
- )
-
-#test 2
-#pending
-func = (lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd
- , lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd)
-
-#test comment-after-then
-foo = if True
- then
- -- iiiiii
- "a "
- else
- "b "
-
-#test comment-after-if-else-do
-func = if cond
- then pure 42
- else do
- -- test
- abc
-
-#test nonempty-case-short
-func = case x of
- False -> False
- True -> True
-
-#test nonempty-case-long
-func =
- case
- lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd
- lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd
- of
- False -> False
- True -> True
-
-#test nonempty-case-long-do
-func = do
- case
- lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd
- lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd
- of
- False -> False
- True -> True
-
-#test empty-case-short
-func = case x of {}
-
-#test empty-case-long
-func =
- case
- lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd
- lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd
- of {}
-
-#test empty-case-long-do
-func = do
- case
- lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd
- lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd
- of {}
-
-###############################################################################
-###############################################################################
-###############################################################################
-#group expression.do statements
-###############################################################################
-###############################################################################
-###############################################################################
-
-#test simple
-func = do
- stmt
- stmt
-
-#test bind
-func = do
- x <- stmt
- stmt x
-
-#test let
-func = do
- let x = 13
- stmt x
-
-
-###############################################################################
-###############################################################################
-###############################################################################
-#group expression.lists
-###############################################################################
-###############################################################################
-###############################################################################
-
-#test monad-comprehension-case-of
-func =
- foooooo
- $ [ case
- foooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo
- of
- _ -> True
- ]
-
-###############################################################################
-###############################################################################
-###############################################################################
-#group expression.let
-###############################################################################
-###############################################################################
-###############################################################################
-
-#test single-bind-comment-long
-testMethod foo bar baz qux =
- let x = undefined foo bar baz qux qux baz bar :: String
- -- some comment explaining the in expression
- in undefined foo x :: String
-
-#test single-bind-comment-short
-testMethod foo bar baz qux =
- let x = undefined :: String
- -- some comment explaining the in expression
- in undefined :: String
-
-#test single-bind-comment-before
-testMethod foo bar baz qux =
- -- some comment explaining the in expression
- let x = undefined :: String in undefined :: String
-
-#test multiple-binds-comment
-foo foo bar baz qux =
- let a = 1
- b = 2
- c = 3
- -- some comment explaining the in expression
- in undefined :: String
-
-
-###############################################################################
-###############################################################################
-###############################################################################
-#group stylisticspecialcases
-###############################################################################
-###############################################################################
-###############################################################################
-
-#test operatorprefixalignment-even-with-multiline-alignbreak
-func =
- foo
- $ [ aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
- , bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb
- ]
- ++ [ccccccccccccccccccccccccccccccccccccccccccccccccccccccccc]
-
-
-###############################################################################
-###############################################################################
-###############################################################################
-#group module
-###############################################################################
-###############################################################################
-###############################################################################
-
-#test simple
-module Main where
-
-#test no-exports
-module Main () where
-
-#test one-export
-module Main (main) where
-
-#test several-exports
-module Main (main, test1, test2) where
-
-#test many-exports
-module Main
- ( main
- , test1
- , test2
- , test3
- , test4
- , test5
- , test6
- , test7
- , test8
- , test9
- ) where
-
-#test exports-with-comments
-module Main
- ( main
- -- main
- , test1
- , test2
- -- Test 3
- , test3
- , test4
- -- Test 5
- , test5
- -- Test 6
- ) where
-
-#test simple-export-with-things
-module Main (Test(..)) where
-
-#test simple-export-with-module-contents
-module Main (module Main) where
-
-#test export-with-things
-module Main (Test(Test, a, b)) where
-
-#test export-with-things-comment
--- comment1
-
-module Main
- ( Test(Test, a, b)
- , foo -- comment2
- ) -- comment3
- where
-
-#test export-with-empty-thing
-module Main (Test()) where
-
-#test empty-with-comment
--- Intentionally left empty
-
-###############################################################################
-###############################################################################
-###############################################################################
-#group module.import
-###############################################################################
-###############################################################################
-###############################################################################
-
-#test simple-import
-import Data.List
-
-#test simple-import-alias
-import Data.List as L
-
-#test simple-qualified-import
-import qualified Data.List
-
-#test simple-qualified-import-alias
-import qualified Data.List as L
-
-#test simple-safe
-import safe Data.List as L
-
-#test simple-source
-import {-# SOURCE #-} Data.List ( )
-
-#test simple-safe-qualified
-import safe qualified Data.List
-
-#test simple-safe-qualified-source
-import {-# SOURCE #-} safe qualified Data.List
-
-#test simple-qualified-package
-import qualified "base" Data.List
-
-#test qualifier-effect
-import {-# SOURCE #-} safe qualified "base" Data.List as L
-import {-# SOURCE #-} safe qualified "base" Data.List ( )
-import {-# SOURCE #-} safe qualified Data.List hiding ( )
-
-#test instances-only
-import qualified Data.List ( )
-
-#test one-element
-import Data.List ( nub )
-
-#test several-elements
-import Data.List ( foldl'
- , indexElem
- , nub
- )
-
-#test a-ridiculous-amount-of-elements
-import Test ( Long
- , anymore
- , fit
- , items
- , line
- , list
- , not
- , onA
- , quite
- , single
- , that
- , will
- , with
- )
-
-#test with-things
-import Test ( (+)
- , (:!)(..)
- , (:*)((:.), T7, t7)
- , (:.)
- , T
- , T2()
- , T3(..)
- , T4(T4)
- , T5(T5, t5)
- , T6((<|>))
- )
-
-#test hiding
-import Test hiding ( )
-import Test as T
- hiding ( )
-
-#test import-hiding-many
-import Prelude as X
- hiding ( head
- , init
- , last
- , maximum
- , minimum
- , pred
- , read
- , readFile
- , succ
- , tail
- , undefined
- )
-
-#test long-module-name-simple
-import TestJustAbitToLongModuleNameLikeThisOneIs
- ( )
-import TestJustShortEnoughModuleNameLikeThisOne ( )
-
-#test long-module-name-as
-import TestJustAbitToLongModuleNameLikeThisOneI
- as T
-import TestJustShortEnoughModuleNameLikeThisOn as T
-
-#test long-module-name-hiding
-import TestJustAbitToLongModuleNameLikeTh
- hiding ( )
-import TestJustShortEnoughModuleNameLike hiding ( )
-
-#test long-module-name-simple-items
-import MoreThanSufficientlyLongModuleNameWithSome
- ( compact
- , fit
- , inA
- , items
- , layout
- , not
- , that
- , will
- )
-
-#test long-module-name-hiding-items
-import TestJustAbitToLongModuleNameLikeTh
- hiding ( abc
- , def
- , ghci
- , jklm
- )
-import TestJustShortEnoughModuleNameLike hiding ( abc
- , def
- , ghci
- , jklm
- )
-
-#test long-module-name-other
-import {-# SOURCE #-} safe qualified "qualifier" A hiding ( )
-import {-# SOURCE #-} safe qualified "qualifiers" A
- hiding ( )
-import {-# SOURCE #-} safe qualified "qualifiers" AlsoAf as T
-import {-# SOURCE #-} safe qualified "qualifiers" AlsoAff ( )
-import {-# SOURCE #-} safe qualified "qualifiers" AlsoAff
- as T
-import {-# SOURCE #-} safe qualified "qualifiers" AlsoAffe
- ( )
-
-#test import-with-comments
--- Test
-import Data.List ( nub ) -- Test
-{- Test -}
-import qualified Data.List as L
- ( foldl' ) {- Test -}
-
--- Test
-import Test ( test )
-
-#test import-with-comments-2
-
-import Test ( abc
- , def
- -- comment
- )
-
-#test import-with-comments-3
-
-import Test ( abc
- -- comment
- )
-
-#test import-with-comments-4
-import Test ( abc
- -- comment
- , def
- , ghi
- {- comment -}
- , jkl
- -- comment
- )
-
-#test import-with-comments-5
-import Test ( -- comment
- )
-
-#test long-bindings
-import Test ( longbindingNameThatoverflowsColum
- )
-import Test ( Long
- ( List
- , Of
- , Things
- )
- )
-
-#test things-with-with-comments
-import Test ( Thing
- ( -- Comments
- )
- )
-import Test ( Thing
- ( Item
- -- and Comment
- )
- )
-import Test ( Thing
- ( With
- -- Comments
- , and
- -- also
- , items
- -- !
- )
- )
-#test prefer-dense-empty-list
-import VeryLongModuleNameThatCouldEvenCauseAnEmptyBindingListToExpandIntoMultipleLine
- ( )
-
-#test preamble full-preamble
-{-# LANGUAGE BangPatterns #-}
-
-{-
- - Test module
- -}
-module Test
- ( test1
- -- ^ test
- , test2
- -- | test
- , test3
- , test4
- , test5
- , test6
- , test7
- , test8
- , test9
- , test10
- -- Test 10
- ) where
-
--- Test
-import Data.List ( nub ) -- Test
-{- Test -}
-import qualified Data.List as L
- ( foldl' ) {- Test -}
-
--- Test
-import Test ( test )
-
-#test sorted-imports
-import Aaa
-import Baa
-
-#test sorted-import-groups
-import Zaa
-import Zab
-<BLANKLINE>
-import Aaa
-import Baa
-
-#test sorted-qualified-imports
-import Boo
-import qualified Zoo
-
-#test imports-groups-same-module
-import Boo ( a )
-<BLANKLINE>
-import Boo ( b )
-
-#test sorted-imports-nested
-import A.B.C
-import A.B.D
-
-###############################################################################
-###############################################################################
-###############################################################################
-#group type synonyms
-###############################################################################
-###############################################################################
-###############################################################################
-
-#test simple-synonym
-
-type MySynonym = String
-
-#test parameterised-synonym
-
-type MySynonym a = [a]
-
-#test long-function-synonym
-
--- | Important comment thrown in
-type MySynonym b a
- = MySynonym a b -> MySynonym a b -> MyParamType a b -> MyParamType a b
-
-#test overflowing-function-synonym
-
-type MySynonym3 b a
- = MySynonym a b
- -> MySynonym a b
- -- ^ RandomComment
- -> MyParamType a b
- -> MyParamType a b
- -> MySynonym2 b a
-
-#test synonym-with-kind-sig
-
-type MySynonym (a :: * -> *)
- = MySynonym a b
- -> MySynonym a b
- -> MyParamType a b
- -> MyParamType a b
- -> MySynonym2 b a
-
-#test synonym-with-constraint
-
-type MySynonym a = Num a => a -> Int
-
-#test synonym-overflowing-with-constraint
-
-type MySynonym a
- = Num a
- => AReallyLongTypeName
- -> AnotherReallyLongTypeName
- -> AThirdTypeNameToOverflow
-
-#test synonym-forall
-
-{-# LANGUAGE RankNTypes #-}
-
-type MySynonym = forall a . [a]
-
-#test synonym-operator
-
-type (:+:) a b = (a, b)
-
-#test synonym-infix
-
-type a `MySynonym` b = a -> b
-
-#test synonym-infix-operator
-
-type a :+: b = (a, b)
-
-#test synonym-infix-parens
-
-type (a `Foo` b) c = (a, b, c)
-
-#test synonym-comments
-
-type Foo a -- fancy type comment
- = -- strange comment
- Int
-
-#test synonym-type-operators
-#pending
-
-type (a :+: b) = (a, b)
-
-#test synonym-multi-parens
-#pending
-
-type ((a :+: b) c) = (a, c)
-
-#test synonym-tuple-type-many-comments
-
-type Foo
- = ( -- t1
- A -- t2
- , -- t3
- B -- t4
- ) -- t5
-
-###############################################################################
-###############################################################################
-###############################################################################
-#group class.instance
-###############################################################################
-###############################################################################
-###############################################################################
-
-#test simple-instance
-
-instance MyClass Int where
- myMethod x = x + 1
-
-#test simple-method-comment
-
-instance MyClass Int where
- myMethod x =
- -- insightful comment
- x + 1
-
-#test simple-method-signature
-
-instance MyClass Int where
- myMethod :: Int -> Int
- myMethod x = x + 1
-
-#test simple-long-method-signature
-
-instance MyClass Int where
- myMethod
- :: Int
- -> Int
- -> AReallyLongType
- -> AReallyLongType
- -> AReallyLongType
- -> Int
- myMethod x = x + 1
-
-#test simple-two-methods
-
-instance MyClass Int where
- myMethod x = x + 1
- myMethod2 x = x + 1
-
-#test simple-two-signatures
-
-instance MyClass Int where
- myMethod
- :: Int
- -> Int
- -> AReallyLongType
- -> AReallyLongType
- -> AReallyLongType
- -> Int
- myMethod x = x + 1
-
- myMethod2 :: Int -> Int
- myMethod2 x = x + 1
-
-#test simple-instance-comment
-
--- | This instance should be commented on
-instance MyClass Int where
-
- -- | This method is also comment-worthy
- myMethod x = x + 1
-
-#test instance-with-type-family
-
-instance MyClass Int where
- type MyType = Int
-
- myMethod :: MyType -> Int
- myMethod x = x + 1
-
-#test instance-with-type-family-below-method
-
-instance MyClass Int where
-
- type MyType = String
-
- myMethod :: MyType -> Int
- myMethod x = x + 1
-
- type MyType = Int
-
-#test instance-with-data-family
-
-instance MyClass Int where
-
- -- | This data is very important
- data MyData = IntData
- { intData :: String
- , intData2 :: Int
- }
-
- myMethod :: MyData -> Int
- myMethod = intData2
-
-#test instance-with-data-family-below-method
-
-instance MyClass Int where
- -- | This data is important
- data MyData = Test Int Int
-
- myMethod :: MyData -> Int
- myMethod = intData2
-
- -- | This data is also important
- data MyData2 = IntData
- { intData :: String
- -- ^ Interesting field
- , intData2 :: Int
- }
-
-#test instance-with-newtype-family-and-deriving
-
-{-# LANGUAGE TypeFamilies #-}
-
-module Lib where
-
-instance Foo () where
- newtype Bar () = Baz ()
- deriving (Eq, Ord, Show)
- bar = Baz
-
-#test instance-with-newtype-family-and-record
-
-instance Foo Int where
- newtype Bar Int = BarInt
- { unBarInt :: Int
- }
-
-
-###############################################################################
-###############################################################################
-###############################################################################
-#group whitespace-newlines
-###############################################################################
-###############################################################################
-###############################################################################
-
-#test module-import-newlines
-
-module Main where
-
-import Prelude
-
-firstDecl = True
-
-#test function-where-newlines
-
-func = do
-
- -- complex first step
- aaa
-
- -- complex second step
- bbb
-
- where
-
- helper :: Helper
- helper = helpful
-
- other :: Other
- other = True
-
-
-###############################################################################
-###############################################################################
-###############################################################################
-#group typefam.instance
-###############################################################################
-###############################################################################
-###############################################################################
-
-#test simple-typefam-instance
-
-type instance MyFam Bool = String
-
-#test simple-typefam-instance-param-type
-
-type instance MyFam (Maybe a) = a -> Bool
-
-#test simple-typefam-instance-parens
-#pending the parens cause problems since ghc-8.8
-
-type instance (MyFam (String -> Int)) = String
-
-#test simple-typefam-instance-overflow
-
-type instance MyFam ALongishType
- = AMuchLongerTypeThanThat
- -> AnEvenLongerTypeThanTheLastOne
- -> ShouldDefinitelyOverflow
-
-#test simple-typefam-instance-comments
-
--- | A happy family
-type instance MyFam Bool -- This is an odd one
- = AnotherType -- Here's another
-
-#test simple-typefam-instance-parens-comment
-#pending the parens cause problems since ghc-8.8
-
--- | A happy family
-type instance (MyFam Bool) -- This is an odd one
- = -- Here's another
- AnotherType
diff --git a/src-literatetests/14-extensions.blt b/src-literatetests/14-extensions.blt
deleted file mode 100644
index d794e9c..0000000
--- a/src-literatetests/14-extensions.blt
+++ /dev/null
@@ -1,242 +0,0 @@
-###############################################################################
-###############################################################################
-###############################################################################
-#group extensions
-###############################################################################
-###############################################################################
-###############################################################################
-
-###############################################################################
-## MultiWayIf
-#test multiwayif 1
-{-# LANGUAGE MultiWayIf #-}
-func = if
- | cond1 -> loooooooooooooooooooooooooooooong expr1
- | cond2 -> loooooooooooooooooooooooooooooong expr2
-
-#test multiwayif 2
-{-# LANGUAGE MultiWayIf #-}
-func = do
- foo
- bar $ if
- | cond1 -> loooooooooooooooooooooooooooooong expr1
- | cond2 -> loooooooooooooooooooooooooooooong expr2
-
-
-###############################################################################
-## LambdaCase
-#test lambdacase 1
-{-# LANGUAGE LambdaCase #-}
-func = \case
- FooBar -> x
- Baz -> y
-
-
-
-###############################################################################
-## ImplicitParams
-#test ImplicitParams 1
-{-# LANGUAGE ImplicitParams #-}
-func :: (?asd::Int) -> ()
-
-#test ImplicitParams 2
-{-# LANGUAGE ImplicitParams #-}
-func
- :: ( ?asd
- :: lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
- -> lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
- )
- -> ()
-
-
-###############################################################################
-## RecursiveDo
-#test recursivedo 1
-{-# LANGUAGE RecursiveDo #-}
-foo = do
- rec a <- f b
- b <- g a
- return (a, b)
-
-#test recursivedo 2
-{-# LANGUAGE RecursiveDo #-}
-foo = do
- rec -- comment
- a <- f b
- b <- g a
- return (a, b)
-
-###############################################################################
-## ExplicitNamespaces + PatternSynonyms
-#test explicitnamespaces_patternsynonyms export
-{-# LANGUAGE ExplicitNamespaces #-}
-{-# LANGUAGE PatternSynonyms #-}
-module Test (type (++), (++), pattern Foo) where
-
-#test explicitnamespaces_patternsynonyms import
-{-# LANGUAGE ExplicitNamespaces #-}
-{-# LANGUAGE PatternSynonyms #-}
-import Test ( type (++)
- , (++)
- , pattern (:.)
- , pattern Foo
- )
-
-###############################################################################
-## PatternSynonyms
-#test bidirectional pattern
-{-# LANGUAGE PatternSynonyms #-}
-pattern J x = Just x
-
-#test unidirection pattern
-{-# LANGUAGE PatternSynonyms #-}
-pattern F x <- (x, _)
-
-#test explicitly bidirectional pattern
-{-# LANGUAGE PatternSynonyms #-}
-pattern HeadC x <- x : xs where
- HeadC x = [x]
-
-#test Multiple arguments
-{-# LANGUAGE PatternSynonyms #-}
-pattern Head2 x y <- x : y : xs where
- Head2 x y = [x, y]
-
-#test Infix argument
-{-# LANGUAGE PatternSynonyms #-}
-pattern x :> y = [x, y]
-
-#test Record argument
-{-# LANGUAGE PatternSynonyms #-}
-pattern MyData { a, b, c } = [a, b, c]
-
-#test long pattern match
-{-# LANGUAGE PatternSynonyms #-}
-pattern myLongLeftVariableName `MyLongInfixPatternMatcher` myLongRightVariableName =
- [myLongLeftVariableName, myLongRightVariableName]
-
-#test long explicitly bidirectional match
-{-# LANGUAGE PatternSynonyms #-}
-pattern myLeftVariableName `MyInfixPatternMatcher` myRightVariableName <-
- [myLongLeftVariableName, myLongRightVariableName] where
- MyInfixPatternMatcher x y = [x, x, y]
-
-#test Pattern synonym types
-{-# LANGUAGE PatternSynonyms #-}
-pattern J :: a -> Maybe a
-pattern J x = Just x
-
-#test pattern synonym bidirectional multiple cases
-{-# LANGUAGE PatternSynonyms #-}
-{-# LANGUAGE ViewPatterns #-}
-pattern Signed x <- (asSigned -> x) where
- Signed (Neg x) = -x
- Signed Zero = 0
- Signed (Pos x) = x
-
-#test pattern synonym bidirectional multiple cases long
-{-# LANGUAGE PatternSynonyms #-}
-{-# LANGUAGE ViewPatterns #-}
-pattern Signed xxxxxxxxxxxxxxxxxxxxxxxx <-
- (asSigned -> xxxxxxxxxxxxxxxxxxxxxxxx) where
- Signed (Neg x) = -x
- Signed Zero = 0
- Signed (Pos x) = x
-
-#test pattern synonym bidirectional multiple cases with comments
-{-# LANGUAGE PatternSynonyms #-}
-{-# LANGUAGE ViewPatterns #-}
-pattern Signed x <- (asSigned -> x) where
- Signed (Neg x) = -x -- negative comment
- Signed Zero = 0 -- zero comment
- Signed (Pos x) = x -- positive comment
-
-#test Pattern synonym types multiple names
-#min-ghc 8.2
-{-# LANGUAGE PatternSynonyms #-}
-pattern J, K :: a -> Maybe a
-
-#test Pattern synonym type sig wrapped
-{-# LANGUAGE PatternSynonyms #-}
-pattern LongMatcher
- :: longlongtypevar
- -> longlongtypevar
- -> longlongtypevar
- -> Maybe [longlongtypevar]
-pattern LongMatcher x y z = Just [x, y, z]
-
-
-###############################################################################
-## UnboxedTuples + MagicHash
-#test unboxed-tuple and vanilla names
-{-# LANGUAGE UnboxedTuples #-}
-spanKey :: (# Int, Int #) -> (# Int, Int #)
-spanKey = case foo of
- (# bar, baz #) -> (# baz, bar #)
-
-#test unboxed-tuple and hashed name
-{-# LANGUAGE MagicHash, UnboxedTuples #-}
-spanKey :: (# Int#, Int# #) -> (# Int#, Int# #)
-spanKey = case foo of
- (# bar#, baz# #) -> (# baz# +# bar#, bar# #)
-
-
-###############################################################################
-## QuasiQuotes
-#test quasi-quotes simple 1
-{-# LANGUAGE QuasiQuotes #-}
-func = [blub|
- asd
- qwe
- |]
-
-#test quasi-quotes simple 2
-{-# LANGUAGE QuasiQuotes #-}
-func = [blub|
- asd
- qwe|]
-
-#test quasi-quotes ignoring layouting
-{-# LANGUAGE QuasiQuotes #-}
-func = do
- let body = [json|
- hello
- |]
- pure True
-
-#test quasi-quotes ignoring layouting, strict mode
--- brittany { lconfig_allowHangingQuasiQuotes: False }
-{-# LANGUAGE QuasiQuotes #-}
-func = do
- let
- body =
- [json|
- hello
- |]
- pure True
-
-###############################################################################
-## OverloadedLabels
-#test bare label
-{-# LANGUAGE OverloadedLabels #-}
-foo = #bar
-
-#test applied and composed label
-{-# LANGUAGE OverloadedLabels #-}
-foo = #bar . #baz $ fmap #foo xs
-
-###############################################################################
-## ImplicitParams
-
-#test IP usage
-{-# LANGUAGE ImplicitParams #-}
-foo = ?bar
-
-#test IP binding
-{-# LANGUAGE ImplicitParams #-}
-foo = let ?bar = Foo in value
-
-#test IP type signature
-{-# LANGUAGE ImplicitParams #-}
-foo :: (?bar::Bool) => ()
-foo = ()
\ No newline at end of file
diff --git a/src-literatetests/15-regressions.blt b/src-literatetests/15-regressions.blt
deleted file mode 100644
index e288114..0000000
--- a/src-literatetests/15-regressions.blt
+++ /dev/null
@@ -1,878 +0,0 @@
-###############################################################################
-###############################################################################
-###############################################################################
-#group regression
-###############################################################################
-###############################################################################
-###############################################################################
-
-#test newlines-comment
-func = do
- abc <- foo
-
---abc
-return ()
-
-#test parenthesis-around-unit
-func = (())
-
-#test let-defs indentation
-func = do
- let foo True = True
- foo _ = False
- return ()
-
-#test record update indentation 1
-func = do
- s <- mGet
- mSet $ s { _lstate_indent = _lstate_indent state }
-
-#test record update indentation 2
-func = do
- s <- mGet
- mSet $ s { _lstate_indent = _lstate_indent state
- , _lstate_foo = _lstate_foo state
- }
-
-#test record update indentation 3
-func = do
- s <- mGet
- mSet $ s
- { _lstate_indent = _lstate_indent lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
- , _lstate_foo = _lstate_foo lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
- }
-
-#test record construction 1
-func = Foo { _lstate_indent = _lstate_indent state }
-
-#test record construction 2
-func = Foo
- { _lstate_indent = _lstate_indent lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
- , _lstate_fooo = _lstate_foo lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
- }
-
-#test record construction 3
-func = do
- Foo { _lstate_indent = _lstate_indent lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
- , _lstate_foo = _lstate_foo lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
- }
-
-#test post-indent comment
-func = do
--- abc
- -- def
- return ()
-
-#test post-unindent comment
-func = do
- do
- return ()
- -- abc
- -- def
- return ()
-
-#test CPP empty comment case
-#pending CPP parsing needs fixing for roundTripEqual
-{-# LANGUAGE CPP #-}
-module Test where
-func = do
-#if FOO
- let x = 13
-#endif
- stmt x
-
-## really, the following should be handled by forcing the Alt to multiline
-## because there are comments. as long as this is not implemented though,
-## we should ensure the trivial solution works.
-#test comment inline placement (temporary)
-func
- :: Int -- basic indentation amount
- -> Int -- currently used width in current line (after indent)
- -- used to accurately calc placing of the current-line
- -> LayoutDesc
- -> Int
-
-#test some indentation thingy
-func =
- ( lkjadljasldjalskdjaldjalsdjkalsdjlaksdjlasjdlajsaldskj
- $ abc
- $ def
- $ ghi
- $ jkl
- )
-
-#test parenthesized operator
-buildG bounds0 edges0 = accumArray (flip (:)) [] bounds0 (map reassoc edges0)
- where reassoc (v, e, w) = (v, (e, w))
-
-#test record pattern matching stuff
-downloadRepoPackage = case repo of
- RepoLocal {..} -> return ()
- RepoLocal { abc } -> return ()
- RepoLocal{} -> return ()
-
-#test do let comment indentation level problem
-func = do
- let (primaryPkg, otherPkgs) = selectPrimaryLocalPackage pwd pkgs'
- (bproblems, x) = resolveBuildTargets primaryPkg otherPkgs utargets''
- -- default local dir target if there's no given target
- utargets'' = "foo"
- return ()
-
-#test list comprehension comment placement
-func =
- [ (thing, take 10 alts) --TODO: select best ones
- | (thing, _got, alts@(_ : _)) <- nosuchFooThing
- , gast <- award
- ]
-
-#test if-then-else comment placement
-func = if x
- then if y -- y is important
- then foo
- else bar
- else Nothing
-
-#test qualified infix pattern
-#pending "TODO"
-wrapPatPrepend pat prepElem = do
- patDocs <- layoutPat pat
- case Seq.viewl patDocs of
- Seq.EmptyL -> return $ Seq.empty
- x1 Seq.:< xR -> do
- x1' <- docSeq [prepElem, return x1]
- return $ x1' Seq.<| xR
-
-#test type signature multiline forcing issue
-layoutWriteNewlineBlock
- :: ( MonadMultiWriter Text.Builder.Builder m
- , MonadMultiState LayoutState m
- , MonadMultiWriter (Seq String) m
- )
- => m ()
-
-#test multiwayif proper indentation
-{-# LANGUAGE MultiWayIf #-}
-readMergePersConfig path shouldCreate conf = do
- exists <- liftIO $ System.Directory.doesFileExist path
- if
- | exists -> do
- contents <- liftIO $ ByteString.readFile path -- no lazy IO, tyvm.
- fileConf <- case Data.Yaml.decodeEither contents of
- Left e -> do
- liftIO
- $ putStrErrLn
- $ "error reading in brittany config from "
- ++ path
- ++ ":"
- liftIO $ putStrErrLn e
- mzero
- Right x -> return x
- return $ fileConf Semigroup.<> conf
- | shouldCreate -> do
- liftIO $ ByteString.writeFile path $ Data.Yaml.encode $ cMap
- (Option . Just . runIdentity)
- staticDefaultConfig
- return $ conf
- | otherwise -> do
- return conf
-
-#test nested pattern alignment issue"
-func = BuildReport
- where
- convertInstallOutcome = case result of
- Left BR.PlanningFailed -> PlanningFailed
- Left (BR.DependentFailed p) -> DependencyFailed p
- Left (BR.DownloadFailed _) -> DownloadFailed
- Left (BR.UnpackFailed _) -> UnpackFailed
- Left (BR.ConfigureFailed _) -> ConfigureFailed
- Left (BR.BuildFailed _) -> BuildFailed
- Left (BR.TestsFailed _) -> TestsFailed
- Left (BR.InstallFailed _) -> InstallFailed
- Right (BR.BuildOk _ _ _ ) -> InstallOk
-
-#test nested pattern alignment issue"
-func = BuildReport
- where
- convertInstallOutcome = case result of
- Left BR.PlanningFailed -> PlanningFailed
- Left (BR.DependentFailed p) -> DependencyFailed p
- Left (BR.DownloadFailed _) -> DownloadFailed
- Left (BR.UnpackFailed _) -> UnpackFailed
- Left (BR.ConfigureFailed _) -> ConfigureFailed
- Left (BR.BuildFailed _) -> BuildFailed
- Left (BR.TestsFailed _) -> TestsFailed
- Left (BR.InstallFailed _) -> InstallFailed
- Right (BR.BuildOk _ _ _ ) -> InstallOk
-
-#test partially overflowing alignment issue"
-showPackageDetailedInfo pkginfo =
- renderStyle (style { lineLength = 80, ribbonsPerLine = 1 })
- $ char '*'
- $+$ something
- [ entry "Synopsis" synopsis hideIfNull reflowParagraphs
- , entry "Versions available"
- sourceVersions
- (altText null "[ Not available from server ]")
- (dispTopVersions 9 (preferredVersions pkginfo))
- , entry
- "Versions installed"
- installedVersions
- (altText
- null
- (if hasLib pkginfo then "[ Not installed ]" else "[ Unknown ]")
- )
- (dispTopVersions 4 (preferredVersions pkginfo))
- , entry "Homepage" homepage orNotSpecified text
- , entry "Bug reports" bugReports orNotSpecified text
- , entry "Description" description hideIfNull reflowParagraphs
- , entry "Category" category hideIfNull text
- , entry "License" license alwaysShow disp
- , entry "Author" author hideIfNull reflowLines
- , entry "Maintainer" maintainer hideIfNull reflowLines
- , entry "Source repo" sourceRepo orNotSpecified text
- , entry "Executables" executables hideIfNull (commaSep text)
- , entry "Flags" flags hideIfNull (commaSep dispFlag)
- , entry "Dependencies" dependencies hideIfNull (commaSep dispExtDep)
- , entry "Documentation" haddockHtml showIfInstalled text
- , entry "Cached" haveTarball alwaysShow dispYesNo
- , if not (hasLib pkginfo)
- then empty
- else text "Modules:"
- $+$ nest 4 (vcat (map disp . sort . modules $ pkginfo))
- ]
-
-#test issue 7a
-isValidPosition position | validX && validY = Just position
- | otherwise = Nothing
-
-#test issue-6-pattern-linebreak-validity
-## this is ugly, but at least syntactically valid.
-foo = Reflex.runSpiderHost $ ReflexHost.hostApp $ do
- (inputEvent :: Reflex.Event Reflex.Spider String, inputFire :: String
- -> IO Bool ) <-
- ReflexHost.newExternalEvent
- liftIO . forkIO . forever $ getLine >>= inputFire
- ReflexHost.performEvent_ $ fmap (liftIO . putStrLn) inputEvent
-
-#test issue 16
-foldrDesc f z = unSwitchQueue $ \q ->
- switch (Min.foldrDesc (f unTaggedF) z q) (Min.foldrAsc (f unTaggedF) z q)
-
-#test issue 18
-autocheckCases =
- [ ("Never Deadlocks" , representative deadlocksNever)
- , ("No Exceptions" , representative exceptionsNever)
- , ("Consistent Result", alwaysSame) -- already representative
- ]
-
-#test issue 18b
-autocheckCases =
- [ ("Never Deadlocks", representative deadlocksNever)
- , ("No Exceptions" , representative exceptionsNever)
- , ( "Consistent Result"
- , alwaysSame -- already representative
- )
- ]
-
-#test issue 18c
-func =
- [ (abc, (1111, 1111))
- , (def, (2, 2))
- , foo -- comment
- ]
-
-#test issue 26
-foo a b = g a b -- fooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo
- where g a b = b + b * a
-
-#test issue 26b
-foo a b = g a b where g a b = b + b * a -- fooooooooooooooooooooooooooooooooooo
-
-#test aggressive alignment 1
-func = do
- abc <- expr
- abcccccccccccccccccc <- expr
- abcccccccccccccccccccccccccccccccccccccccccc <- expr
- abccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc <- expr
-
-#test example alignment 1
-func (MyLongFoo abc def) = 1
-func (Bar a d ) = 2
-func _ = 3
-
-#test listcomprehension-case-of
-parserCompactLocation =
- [ try
- $ [ ParseRelAbs (Text.Read.read digits) _ _
- | digits <- many1 digit
- , rel1 :: Maybe (Either Int (Ratio Int)) <- optionMaybe
- [ case divPart of
- Nothing -> Left $ Text.Read.read digits
- Just ddigits ->
- Right $ Text.Read.read digits % Text.Read.read ddigits
- | digits <- many1 digit
- , divPart <- optionMaybe (string "/" *> many1 digit)
- ]
- ]
- ]
-
-#test opapp-specialcasing-1
-func = fooooooooooooooooooooooooooooooooo $ foooooooooooooooooooooooooooooooo
- foooooooooooooooooooooooooooooooo
- foooooooooooooooooooooooooooooooo
-
-#test opapp-specialcasing-2
-func =
- fooooooooooooooooooooooooooooooooo
- + foooooooooooooooooooooooooooooooo foooooooooooooooooooooooooooooooo
- foooooooooooooooooooooooooooooooo
-
-#test opapp-specialcasing-3
-func = fooooooooooooooooooooooooooooooooo + foooooooooooooooooooooooooooooooo
- [ foooooooooooooooooooooooooooooooo
- , foooooooooooooooooooooooooooooooo
- , foooooooooooooooooooooooooooooooo
- ]
-
-#test opapp-indenting
-parserPrim =
- [ r
- | r <-
- [ SGPPrimFloat $ bool id (0 -) minus $ readGnok "parserPrim"
- (d1 ++ d2 ++ d3 ++ d4)
- | d2 <- string "."
- , d3 <- many1 (oneOf "0123456789")
- , _ <- string "f"
- ]
- <|> [ SGPPrimFloat $ bool id (0 -) minus $ fromIntegral
- (readGnok "parserPrim" d1 :: Integer)
- | _ <- string "f"
- ]
- <|> [ SGPPrimInt $ bool id (0 -) minus $ fromIntegral
- (readGnok "parserPrim" d1 :: Integer)
- | _ <- string "i"
- ]
- ]
-
-#test another-parspacing-testcase
-
-samples = (SV.unpackaaaaadat) <&> \f ->
- aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
-
-#test recordupd-singleline-bug
-
-runBrittany tabSize text = do
- let config' = staticDefaultConfig
- config = config'
- { _conf_layout = (_conf_layout config')
- { _lconfig_indentAmount = coerce tabSize
- }
- , _conf_forward = forwardOptionsSyntaxExtsEnabled
- }
- parsePrintModule config text
-
-#test recordupd-singleline-bug-left
-
--- brittany { lconfig_indentPolicy: IndentPolicyLeft }
-runBrittany tabSize text = do
- let
- config' = staticDefaultConfig
- config = config'
- { _conf_layout = (_conf_layout config')
- { _lconfig_indentAmount = coerce tabSize
- }
- , _conf_forward = forwardOptionsSyntaxExtsEnabled
- }
- parsePrintModule config text
-
-#test issue 37
-
-foo =
- ( a
- , -- comment1
- b
- -- comment2
- , c
- )
-
-#test issue 38
-
-{-# LANGUAGE TypeApplications #-}
-foo = bar @Baz
-
-#test comment-before-BDCols
-{-# LANGUAGE TypeApplications #-}
-layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs = do
- docAlt
- $ -- one-line solution
- [ docCols
- (ColBindingLine alignmentToken)
- [ docSeq (patPartInline ++ [guardPart])
- , docSeq
- [ appSep $ return binderDoc
- , docForceSingleline $ return body
- , wherePart
- ]
- ]
- | not hasComments
- , [(guards, body, _bodyRaw)] <- [clauseDocs]
- , let guardPart = singleLineGuardsDoc guards
- , wherePart <- case mWhereDocs of
- Nothing -> return @[] $ docEmpty
- Just [w] -> return @[] $ docSeq
- [ docSeparator
- , appSep $ docLit $ Text.pack "where"
- , docSetIndentLevel $ docForceSingleline $ return w
- ]
- _ -> []
- ]
- ++ -- one-line solution + where in next line(s)
- [ docLines
- $ [ docCols
- (ColBindingLine alignmentToken)
- [ docSeq (patPartInline ++ [guardPart])
- , docSeq
- [appSep $ return binderDoc, docForceParSpacing $ return body]
- ]
- ]
- ++ wherePartMultiLine
- | [(guards, body, _bodyRaw)] <- [clauseDocs]
- , let guardPart = singleLineGuardsDoc guards
- , Data.Maybe.isJust mWhereDocs
- ]
- ++ -- two-line solution + where in next line(s)
- [ docLines
- $ [ docForceSingleline
- $ docSeq (patPartInline ++ [guardPart, return binderDoc])
- , docEnsureIndent BrIndentRegular $ docForceSingleline $ return
- body
- ]
- ++ wherePartMultiLine
- | [(guards, body, _bodyRaw)] <- [clauseDocs]
- , let guardPart = singleLineGuardsDoc guards
- ]
-
-#test comment-testcase-17
-{-# LANGUAGE MultiWayIf #-}
-func = do
- let foo = if
- | Constuctoooooooooooooooooooooooooooooooooooor `elem` artics -- TODO
- -> max
- (defLen - 0.2) -- TODO
- (defLen * 0.8)
- | otherwise -> max (defLen - 0.05) (defLen * 0.95) -- TODO
- return True
-
-#test issue 49
-
-foo n = case n of
- 1 -> True
- -1 -> False
-
-bar n = case n of
- (-2, -2) -> (-2, -2)
-
-#test issue 48 b
-
-{-# LANGUAGE TypeApplications #-}
-foo =
- let a = b @1
- cccc = ()
- in foo
-
-#test issue 52 a
-
-{-# LANGUAGE RecordWildCards #-}
-v = A { a = 1, .. } where b = 2
-
-#test issue 52 b
-
-{-# LANGUAGE RecordWildCards #-}
-v = A { .. } where b = 2
-
-#test issue 52 c
-
-{-# LANGUAGE RecordWildCards #-}
-v = A { a = 1, b = 2, c = 3 }
-
-#test issue 63 a
-#pending fix does not work on 8.0.2
-test :: Proxy 'Int
-
-#test issue 63 b
-#pending fix does not work on 8.0.2
-test :: Proxy '[ 'True]
-
-#test issue 63 c
-#pending fix does not work on 8.0.2
-test :: Proxy '[Bool]
-
-#test issue 64
-{-# LANGUAGE RankNTypes, KindSignatures #-}
-func
- :: forall m str
- . (Str str, Monad m)
- => Int
- -> Proxy (str :: [*])
- -> m (Tagged str String)
-
-#test issue 65
-widgetsDyn =
- [ [ vBox
- [ padTop Max outputLinesWidget
- , padRight Max wid1 <+> flowWidget -- alignment here is strange/buggy
- , padBottom (Pad 5) help
- ]
- ]
- | wid1 <- promptDyn
- , (flowWidget, _) <- flowResultD
- , outputLinesWidget <- outputLinesWidgetD
- , help <- suggestionHelpBox
- , parser <- cmdParserD
- ]
-
-#test issue 67
-fmapuv :: U.Unbox a => (a -> b) -> U.Vector a -> V.Vector b
-fmapuv f xs = G.generate (G.length xs) (f . (xs G.!))
-
-
-#test parallellistcomp-workaround
-cs0 = 0 : [ c / Interval n | c <- cs | n <- [1..] ]
-
-#test issue 70
-{-# LANGUAGE TemplateHaskell #-}
-deriveFromJSON (unPrefix "assignPost") ''AssignmentPost
-
-#test issue 110
-main = -- a
- let --b
- x = 1 -- x
- y = 2 -- y
- in do
- print x
- print y
-
-#test issue 111
-alternatives :: Parser (Maybe Text)
-alternatives =
- alternativeOne -- first try this one
- <|> alterantiveTwo -- then this one
- <|> alternativeThree -- then this one
- where
- alternativeOne = purer "one"
- alternativeTwo = purer "two"
- alterantiveThree = purer "three"
-
-#test issue 116
-{-# LANGUAGE BangPatterns #-}
-func = do
- let !forced = some
- pure ()
-
-#test let-in-hanging
-spanKey p q = case minViewWithKey q of
- Just ((k, _), q') | p k ->
- let (kas, q'') = spanKey p q' in ((k, a) : kas, q'')
- _ -> ([], q)
-
-#test issue 125
-a :: () ':- ()
-
-#test issue 128
-func = do
- createDirectoryIfMissing True path
- openFile fileName AppendMode
-
-#test hspar-comments
-
-alternatives :: Parser (Maybe Text)
-alternatives = -- a
- ( -- b
- alternativeOne -- c
- <|> alterantiveTwo -- d
- <|> alternativeThree -- e
- ) -- f
-
-#test issue 133
-{-# LANGUAGE ScopedTypeVariables #-}
-func
- :: forall a
- . ()
- => aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
- -> aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
-func
- :: ()
- => aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
- -> aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
-
-#test alignment-potential-overflow
-go l [] = Right l
-go l ((IRType, _a) : eqr) = go l eqr
-go l ((_, IRType) : eqr) = go l eqr
-go _ ((IRTypeError ps t1 t2, _) : _) = Left $ makeError ps t1 t2
-go _ ((_, IRTypeError ps t1 t2) : _) = Left $ makeError ps t1 t2
-
-#test issue 89 - type-family-instance
-type instance XPure StageParse = ()
-type Pair a = (a, a)
-
-#test issue 144
--- brittany { lconfig_indentAmount: 4, lconfig_indentPolicy: IndentPolicyMultiple }
-dsfnjKeekbwwbosbOfakxqRsiyix cnehokzozwbVaguvu migbnaRwutbz =
- let
- eyuAfrarIso'
- :: (RveoexdxunuAafalm -> Axlau (Axlau (a, OinejrdCplle)))
- -> Gbodoy
- -> Axlau (Axlau OinejrdCplle, Gbodoy)
- eyuAfrarIso' = ulcPaaekBst cnehokzozwbVaguvu
- amkgoxEhalazJjxunecCuIfaw
- :: Axlau (Axlau OinejrdCplle, Gbodoy) -> Axlau RqlnrluYqednbCiggxi
- amkgoxEhalazJjxunecCuIfaw uKqviuBisjtn = do
- (sEmo, quc) <- uKqviuBisjtn
- pure (xoheccewfWoeyiagOkfodiq sEmo quc)
- xoheccewfWoeyiagOkfodiq
- :: Axlau OinejrdCplle -> Gbodoy -> RqlnrluYqednbCiggxi
- xoheccewfWoeyiagOkfodiq sEmo quc = case migbnaRwutbz of
- Afogmf -> xgeqe (OfBkkuih quc) (Ciitog quc) sEmo
- in QabqyilexuiNizzhsQuxxac migbnaRwutbz (hwaTihhjt lhowvscIiozgqe)
-
-#test issue 159
-spec = do
- it "creates a snapshot at the given level" . withGraph runDB $ do
- lift $ do
- studentDiagnosticReadingLevel updatedStudent `shouldBe` Just 10 -- x
- elaSnapshotReadingLevel snapshot `shouldBe` 12
-
-#test non-bottom-specialcase-altsearch
-jaicyhHumzo btrKpeyiFej mava = do
- m :: VtohxeRgpmgsu <- qloxIfiq mava
- case m of
- ZumnaoFujayerIswadabo kkecm chlixxag -> do
- imomue <- ozisduRaqiseSBAob btrKpeyiFej $ \s ->
- case MizA.pigevo kkecm (_tc_gulawulu s) of
- Ebocaba ->
- ( s { _tc_gulawulu = MizA.jxariu kkecm rwuRqxzhjo (_tc_gulawulu s) }
- , Gtzvonm
- )
- Xcde{} -> (s, Pioemav)
- pure imomue
-
-#test issue 214
--- brittany { lconfig_indentPolicy: IndentPolicyMultiple }
-foo = bar
- arg1 -- this is the first argument
- arg2 -- this is the second argument
- arg3 -- this is the third argument, now I'll skip one comment
- arg4
- arg5 -- this is the fifth argument
- arg6 -- this is the sixth argument
-
-#test issue 234
-
-True `nand` True = False
-nand _ _ = True
-
-nor False False = True
-_ `nor` _ = False
-
-#test issue 256 prefix operator match
-
-f ((:) a as) = undefined
-
-#test issue 228 lambda plus lazy or bang pattern
-
-{-# LANGUAGE BangPatterns #-}
-a = \x -> x
-b = \ ~x -> x
-c = \ !x -> x
-d = \(~x) -> x
-
-#test type signature with forall and constraint
-{-# LANGUAGE RankNTypes #-}
-func :: forall b . Show b => b -> String
-
-#test issue 267
-
-{-# LANGUAGE TypeFamilies #-}
-f :: ((~) a b) => a -> b
-f = id
-
-#test large record update
--- brittany { lconfig_indentPolicy: IndentPolicyLeft }
-vakjkeSulxudbFokvir = Duotpo
- { _ekku_gcrpbze = xgonae (1 :: Int)
- , _oola_louwu = FoqsiYcuidx
- { _xxagu_umea_iaztoj = xgonae False
- , _tuktg_tizo_kfikacygsqf = xgonae False
- , _ahzbo_xpow_otq_nzeyufq = xgonae False
- , _uagpi_lzps_luy_xcjn = xgonae False
- , _dxono_qjef_aqtafq_bes = xgonae False
- , _yzuaf_nviy_vuhwxe_ihnbo_uhw = xgonae False
- , _iwcit_fzjs_yerakt_dicox_mtryitko = xgonae False
- , _ehjim_ucfe_dewarp_newrt_gso = xgonae False
- , _ogtxb_ivoj_amqgai_rttui_xuwhetb = xgonae False
- , _bhycb_iexz_megaug_qunoa_ohaked = xgonae False
- , _nnmbe_uqgt_ewsuga_vaiis = xgonae False
- , _otzil_ucvugaiyj_aosoiatunx_asir = xgonae False
- }
- , _iwsc_lalojz = XqspaiDainqw
- { _uajznac_ugah = xgonae (80 :: Int)
- , _qayziku_gazibzDejipj = xgonae DewizeCxwgyiKjig
- , _auhebll_fiqjxyArfxia = xgonae (2 :: Int)
- , _zubfuhq_dupiwnIoophXameeet = xgonae True
- , _oavnuqg_opkreyOufuIkifiin = xgonae True
- , _ufojfwy_fhuzcePeqwfu = xgonae (50 :: Int)
- , _mlosikq_zajdxxSeRoelpf = xgonae (50 :: Int)
- , _heemavf_fjgOfoaikh = xgonae (FyoVfvdygaZuzuvbeWarwuq 3)
- , _ohxmeoq_ogtbfoPtqezVseu = xgonae (EdjotoLcbapUdiuMmytwoig 0.7)
- , _omupuiu_ituamexjuLccwu = xgonae (30 :: Int)
- , _xoseksf_atvwwdwaoHanofMyUvujjopoz = xgonae True
- , _umuuuat_nuamezwWeqfUqzrnaxwp = xgonae False
- , _uuriguz_wixhutbuKecigaFiwosret = xgonae True
- , _betohxp_scixaLsvcesErtwItxrnaJmuz = xgonae False
- , _lchxgee_olaetGcqzuqxVujenCzexub = xgonae True
- , _egeibao_imamkuigqikhZdcbpidokVcixiqew = xgonae False
- }
- , _nloo_cfmrgZcisiugk = YuwodSavxwnicBekuel
- { _oebew_rrtpvthUzlizjAqIwesly = xgonae False
- , _blkff_Acxoid = xgonae False
- , _datei_YewolAowoqOpunvpgu = xgonae BeekgUzojaPnixxaruJehyPmnnfu
- , _ejfrj_eheb_justvh_pumcp_ismya = xgonae False
- }
- , _kena_uzeddovosoki = NyoRvshullezUpauud
- { _mtfuwi_TUVEmoi = xgonae RZXKoytUtogx
- , _larqam_adaxPehaylZafeqgpc = xgonae False
- }
- , _spob_qipaarx = KaxavsmOtoyeaq { _rusrirw_okx = Tajemkix [] }
- , _vmah_uivucnfka_ikaquebxay_gzcm = xgonae False
- , _qaqb_eykzuyuwi = xgonae False
- -- test comment
- }
-
-#test large record wildcard comment
-
--- brittany { lconfig_indentPolicy: IndentPolicyLeft }
-vakjkeSulxudbFokvir = Duotpo
- { _ekku_gcrpbze = xgonae (1 :: Int)
- , _spob_qipaarx = KaxavsmOtoyeaq { _rusrirw_okx = Tajemkix [] }
- , _vmah_uivucnfka_ikaquebxay_gzcm = xgonae False
- , _qaqb_eykzuyuwi = xgonae False
- -- test comment
- , -- N.B.
- .. -- x
- }
-
-#test issue 263
-
-func = abc + def
- -- a
- -- b
-
- -- comment
-
- where
- abc = 13
- def = 1
-
-#test AddBaseY/EnsureIndent float in effect
-
-zItazySunefp twgq nlyo lwojjoBiecao =
- let mhIarjyai =
- ukwAausnfcn
- $ XojlsTOSR.vuwOvuvdAZUOJaa
- $ XojlsTOSR.vkesForanLiufjeDI
- $ XojlsTOSR.vkesForanLiufjeDI
- $ XojlsTOSR.popjAyijoWarueeP
- $ XojlsTOSR.jpwuPmafuDqlbkt nlyo
- $ XojlsTOSR.jpwuPmafuDqlbkt xxneswWhxwng
- $ XojlsTOSR.jpwuPmafuDqlbkt oloCuxeDdow
- $ XojlsTOSR.jpwuPmafuDqlbkt (uwurrvoNnukzefuDjeh lwojjoBiecao nlyo)
- $ etOslnoz lwojjoBiecao
- in kucotg $ (bbbr, Yoxe.Dwzbuzi.zrLokoTnuy piv)
-
-#test module initial comment
--- test
-module MyModule where
-
-#test issue 231
-
-foo =
- [ ("xxx", "xx")
- , --
- ("xx" , "xx")
- --
- , ("xx" , "xxxxx")
- , ("xx" , "xx")
- ]
-
-#test issue 231 not
-
-foo =
- [ ("xx", "xx")
- , ( "xx" --
- , "xx"
- )
- , ("xx", "xxxxx")
- , ("xx", "xx")
- ]
-
-#test issue 281
-
-module Main
- ( DataTypeI
- , DataTypeII(DataConstructor)
- -- * Haddock heading
- , name
- ) where
-
-#test type level list
-
-xeoeqibIaib
- :: ( KqujhIsaus m
- , XivuvIpoboi Droqifim m
- , IgorvOtowtf m
- , RyagaYaqac m
- , QouruDU m
- )
- => MaptAdfuxgu
- -> Zcnxg NsxayqmvIjsezea -- ^ if Lvqucoo, opsip jl reyoyhk lfil qaculxgd
- -> QNOZqwuzg
- -> Eoattuq
- '[ XkatytdWdquraosu -- test comment
- , KyezKijim -- another test comment
- , DjmioeePuoeg
- , NinrxoiOwezc
- , QATAlrijacpk
- , TrutvotwIwifiqOjdtu
- , CoMmuatjwr
- , BoZckzqyodseZole
- , VagfwoXaeChfqe
- ]
- m
- ()
-
-#test recordupd-overflow-bad-multiline-spacing
-
-createRedirectedProcess processConfig = do
- let redirectedProc = (_processConfig_inner processConfig)
- { std_in = CreatePipe
- , std_out = CreatePipe
- , std_err = CreatePipe
- }
- foo
-
-#test issue 282
-
-instance HasDependencies SomeDataModel where
- -- N.B. Here is a bunch of explanatory context about the relationship
- -- between these data models or whatever.
- type Dependencies SomeDataModel
- = (SomeOtherDataModelId, SomeOtherOtherDataModelId)
-
-#test stupid-do-operator-combination
-
-func =
- do
- y
- >>= x
diff --git a/src-literatetests/16-pending.blt b/src-literatetests/16-pending.blt
deleted file mode 100644
index c8147d8..0000000
--- a/src-literatetests/16-pending.blt
+++ /dev/null
@@ -1,35 +0,0 @@
-###############################################################################
-###############################################################################
-###############################################################################
-#group pending
-###############################################################################
-###############################################################################
-###############################################################################
-
-
-
-## this testcase is not about idempotency, but about _how_ the output differs
-## from the input; i cannot really express this yet with the current
-## test-suite.
-## #test ayaz
-##
-## myManageHook =
-## composeOne [isFullscreen -?> doFullFloat, isDialog -?> doFloat, transience]
-## <+> composeAll
-## [ className =? "Pidgin" --> doFloat
-## , className =? "XCalc" --> doFloat
-## -- plan9port's acme
-## , className =? "acme" --> doFloat
-## -- Acme with Vi bindings editor
-## , title =? "ED" --> doFloat
-## , title =? "wlc-x11" --> doFloat
-## , className =? "Skype" --> doFloat
-## , className =? "ffplay" --> doFloat
-## , className =? "mpv" --> doFloat
-## , className =? "Plugin-container" --> doFloat -- Firefox flash, etc.
-## -- Firefox works well tiled, but it has dialog windows we want to float.
-## , appName =? "Browser" --> doFloat
-## ]
-## where
-## role = stringProperty "WM_WINDOW_ROLE"
-
diff --git a/src-literatetests/30-tests-context-free.blt b/src-literatetests/30-tests-context-free.blt
deleted file mode 100644
index 003a23d..0000000
--- a/src-literatetests/30-tests-context-free.blt
+++ /dev/null
@@ -1,1471 +0,0 @@
-
-###############################################################################
-###############################################################################
-###############################################################################
-#group type signatures
-###############################################################################
-###############################################################################
-###############################################################################
-
-#test simple001
-func :: a -> a
-
-#test long typeVar
-func
- :: lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
- -> lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
-
-#test keep linebreak mode
-func
- :: lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
- -> lakjsdlkjasldkj
- -> lakjsdlkjasldkj
-
-#test simple parens 1
-func :: ((a))
-
-#test simple parens 2
-func :: (a -> a) -> a
-
-#test simple parens 3
-func :: a -> (a -> a)
-
-#test did anyone say parentheses?
-func :: (((((((((())))))))))
-
--- current output is.. funny. wonder if that can/needs to be improved..
-#test give me more!
-#pending
-func :: ((((((((((((((((((((((((((((((((((((((((((()))))))))))))))))))))))))))))))))))))))))))
-
-#test unit
-func :: ()
-
-
-###############################################################################
-
-#test paren'd func 1
-func
- :: ( lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
- -> lakjsdlkjasldkj
- -> lakjsdlkjasldkj
- )
-
-#test paren'd func 2
-func
- :: lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
- -> (lakjsdlkjasldkj -> lakjsdlkjasldkj)
-
-#test paren'd func 3
-func
- :: (lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd -> lakjsdlkjasldkj)
- -> lakjsdlkjasldkj
-
-#test paren'd func 4
-func
- :: ( lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
- -> lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
- )
- -> lakjsdlkjasldkj
-
-#test paren'd func 5
-func
- :: ( ( lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
- -> lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
- )
- )
-
-###############################################################################
-
-#test type application 1
-func :: asd -> Either a b
-
-#test type application 2
-func
- :: asd
- -> Either
- lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
- lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
-
-#test type application 3
-func
- :: asd
- -> Trither
- lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
- lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
- lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
-
-#test type application 4
-func
- :: Trither
- lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
- lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
- lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
- -> asd
-
-#test type application 5
-func
- :: Trither
- lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
- lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
- (lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd -> asd)
-
-#test type application 6
-func
- :: Trither
- asd
- lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
- ( lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
- -> lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
- )
-
-#test type application paren 1
-func
- :: asd
- -> ( Trither
- lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
- lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
- lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
- )
-
-#test type application paren 2
-func
- :: asd
- -> ( Trither
- lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
- lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
- )
- lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
-
-#test type application paren 3
-func
- :: ( Trither
- lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
- lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
- )
- lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
- -> asd
-
-###############################################################################
-
-#test list simple
-func :: [a -> b]
-
-#test list func
-func
- :: [ lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
- -> lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
- ]
-
-#test list paren
-func
- :: [ ( lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
- -> lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
- )
- ]
-
-################################################################## -- #############
-
-#test tuple type 1
-func :: (a, b, c)
-
-#test tuple type 2
-func :: ((a, b, c), (a, b, c), (a, b, c))
-
-#test tuple type long
-func
- :: ( lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
- , lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
- , lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
- )
-
-#test tuple type nested
-func
- :: ( ( lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
- , (lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd)
- , lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
- )
- )
-
-#test tuple type function
-func
- :: [ ( lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
- , lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
- , lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
- )
- ]
-###############################################################################
-#test type operator stuff
-#pending
-test050 :: a :+: b
-test051
- :: lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
- :+: lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
-test052
- :: lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
- -> lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
- :+: lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
- -> lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
-
-###############################################################################
-
-#test forall oneliner
-{-# LANGUAGE ScopedTypeVariables #-}
-func :: forall (a :: *) b . a -> b
-
-#test forall context multiline
-{-# LANGUAGE ScopedTypeVariables #-}
-func
- :: forall m
- . Foo
- => ColMap2
- -> ColInfo
- -> ColInfo
- -> ColInfo
- -> ColInfo
- -> m ()
-
-#test forall no-context multiline
-{-# LANGUAGE ScopedTypeVariables #-}
-func
- :: forall m
- . ColMap2
- -> ColInfo
- -> ColInfo
- -> ColInfo
- -> ColInfo
- -> ColInfo
- -> m ()
-
-#test language pragma issue
-{-# LANGUAGE ScopedTypeVariables #-}
-func :: forall (a :: *) b . a -> b
-
-#test comments 1
-func :: a -> b -- comment
-
-#test comments 2
-funcA :: a -> b -- comment A
-funcB :: a -> b -- comment B
-
-#test comments all
-#pending
--- a
-func -- b
- :: -- c
- a -- d
- -> -- e
- ( -- f
- c -- g
- , -- h
- d -- i
- ) -- j
--- k
-
-###############################################################################
-
-#test ImplicitParams 1
-{-# LANGUAGE ImplicitParams #-}
-func :: (?asd::Int) -> ()
-
-#test ImplicitParams 2
-{-# LANGUAGE ImplicitParams #-}
-func
- :: ( ?asd
- :: lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
- -> lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
- )
- -> ()
-
-
-###############################################################################
-###############################################################################
-###############################################################################
-#group type signatures pragmas
-###############################################################################
-###############################################################################
-###############################################################################
-
-#test inline pragma 1
-func = f
- where
- {-# INLINE f #-}
- f = id
-
-#test inline pragma 2
-func = ($)
- where
- {-# INLINE ($) #-}
- ($) = id
-
-#test inline pragma 3
-func = f
- where
- {-# INLINE CONLIKE [1] f #-}
- f = id
-
-#test inline pragma 4
-#pending this does not work with the compiler version we currently use yet (i think). should work with ghc-8.0.2.
-func = f
- where
- {-# INLINE [~] f #-}
- f = id
-
-
-###############################################################################
-###############################################################################
-###############################################################################
-#group data type declarations
-###############################################################################
-###############################################################################
-###############################################################################
-
-#test single record
-data Foo = Bar
- { foo :: Baz
- }
-
-#test record multiple names
-data Foo = Bar
- { foo, bar :: Baz
- }
-
-#test record multiple types
-data Foo = Bar
- { foo :: Baz
- , bar :: Bizzz
- }
-
-#test record multiple types and names
-data Foo = Bar
- { foo, biz :: Baz
- , bar :: Bizzz
- }
-
-#test record multiple types deriving
-data Foo = Bar
- { foo :: Baz
- , bar :: Bizzz
- }
- deriving Show
-
-#test record multiple types deriving
-data Foo = Bar
- { foo :: Baz
- , bar :: Bizzz
- }
- deriving (Show, Eq, Monad, Functor, Traversable, Foldable)
-
-
-###############################################################################
-###############################################################################
-###############################################################################
-#group equation.basic
-###############################################################################
-###############################################################################
-###############################################################################
-## some basic testing of different kinds of equations.
-## some focus on column layouting for multiple-equation definitions.
-## (that part probably is not implemented in any way yet.)
-
-#test basic 1
-func x = x
-
-#test infix 1
-x *** y = x
-
-#test symbol prefix
-(***) x y = x
-
-
-###############################################################################
-###############################################################################
-###############################################################################
-#group equation.patterns
-###############################################################################
-###############################################################################
-###############################################################################
-
-#test wildcard
-func _ = x
-
-#test simple long pattern
-#pending
-func reallyreallyreallyreallyreallyreallyreallyreallyreallyreallylongvariable
- = x
-
-#test simple multiline pattern
-#pending
-func reallyreallyreallyreallyreallyreallyreallyreallyreallyreallylongvariable
- reallyreallyreallyreallyreallyreallyreallyreallyreallyreallylongvariable
- = x
-
-#test another multiline pattern
-#pending
-func reallyreallyreallyreallyreallyreallyreallyreallyreallyreallylongvariable
- a
- b
- = x
-
-#test simple constructor
-func (A a) = a
-
-#test list constructor
-func (x : xr) = x
-
-#test some other constructor symbol
-#pending
-func (x :+: xr) = x
-
-
-###############################################################################
-###############################################################################
-###############################################################################
-#group equation.guards
-###############################################################################
-###############################################################################
-###############################################################################
-#test simple guard
-func | True = x
-
-#test multiple-clauses-1
-func x
- | x = simple expression
- | otherwise = 0
-
-#test multiple-clauses-2
-func x
- | a somewhat longer guard x = "and a somewhat longer expession that does not"
- | otherwise = "fit without putting the guards in new lines"
-
-#test multiple-clauses-3
-func x
- | very long guard, another rather long guard that refers to x = nontrivial
- expression
- foo
- bar
- alsdkjlasdjlasj
- | otherwise = 0
-
-#test multiple-clauses-4
-func x
- | very long guard, another rather long guard that refers to x
- = nontrivialexpression foo bar alsdkjlasdjlasj
- | otherwise
- = 0
-
-#test multiple-clauses-5
-func x
- | very loooooooooooooooooooooooooooooong guard
- , another rather long guard that refers to x
- = nontrivial expression foo bar alsdkjlasdjlasj
- | otherwise
- = 0
-
-
-###############################################################################
-###############################################################################
-###############################################################################
-#group expression.basic
-###############################################################################
-###############################################################################
-###############################################################################
-
-#test var
-func = x
-
-describe "infix op" $ do
-#test 1
-func = x + x
-
-#test long
-#pending
-func = mweroiuxlskdfjlksjdflkjsdfljksldkjflkjsdflkj
- + mweroiuxlskdfjlksjdflkjsdfljksldkjflkjsdflkj
-
-#test long keep linemode 1
-#pending
-func = mweroiuxlskdfjlksjdflkjsdfljksldkjflkjsdflkj
- + mweroiuxlskdfjlksj
- + mweroiuxlskdfjlksj
-
-#test long keep linemode 2
-#pending
-func = mweroiuxlskdfjlksj
- + mweroiuxlskdfjlksj
- + mweroiuxlskdfjlksjdflkjsdfljksldkjflkjsdflkj
-
-#test literals
-func = 1
-func = "abc"
-func = 1.1e5
-func = 'x'
-func = 981409823458910394810928414192837123987123987123
-
-#test lambdacase
-{-# LANGUAGE LambdaCase #-}
-func = \case
- FooBar -> x
- Baz -> y
-
-#test lambda
-func = \x -> abc
-
-describe "app" $ do
-#test 1
-func = klajsdas klajsdas klajsdas
-
-#test 2
-func = lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd
- lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd
- lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd
-
-#test 3
-func = lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd
- lakjsdlajsdljas
- lakjsdlajsdljas
- lakjsdlajsdljas
-
-###
-#group expression.basic.sections
-###
-
-#test left
-func = (1 +)
-
-#test right
-func = (+ 1)
-
-#test left inf
-## TODO: this could be improved..
-func = (1 `abc`)
-
-#test right inf
-func = (`abc` 1)
-
-###
-#group tuples
-###
-
-#test 1
-func = (abc, def)
-
-#test 2
-#pending
-func = (lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd
- , lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd)
-
-#test let in on single line
-foo =
- let longIdentifierForShortValue = 1
- in longIdentifierForShortValue + longIdentifierForShortValue
-
-
-
-###############################################################################
-###############################################################################
-###############################################################################
-#group expression.do statements
-###############################################################################
-###############################################################################
-###############################################################################
-
-#test simple
-func = do
- stmt
- stmt
-
-#test bind
-func = do
- x <- stmt
- stmt x
-
-#test let
-func = do
- let x = 13
- stmt x
-
-
-###############################################################################
-###############################################################################
-###############################################################################
-#group expression.lists
-###############################################################################
-###############################################################################
-###############################################################################
-
-#test monad-comprehension-case-of
-func =
- foooooo
- $ [ case
- foooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo
- of
- _ -> True
- ]
-
-
-###############################################################################
-###############################################################################
-###############################################################################
-#group expression.multiwayif
-###############################################################################
-###############################################################################
-###############################################################################
-
-#test simple
-{-# LANGUAGE MultiWayIf #-}
-func = if
- | cond1 -> loooooooooooooooooooooooooooooong expr1
- | cond2 -> loooooooooooooooooooooooooooooong expr2
-
-#test simplenested
-{-# LANGUAGE MultiWayIf #-}
-func = do
- foo
- bar $ if
- | cond1 -> loooooooooooooooooooooooooooooong expr1
- | cond2 -> loooooooooooooooooooooooooooooong expr2
-
-
-###############################################################################
-###############################################################################
-###############################################################################
-#group stylisticspecialcases
-###############################################################################
-###############################################################################
-###############################################################################
-
-#test operatorprefixalignment-even-with-multiline-alignbreak
-func =
- foo
- $ [ aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
- , bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb
- ]
- ++ [ccccccccccccccccccccccccccccccccccccccccccccccccccccccccc]
-
-###############################################################################
-###############################################################################
-###############################################################################
-#group module
-###############################################################################
-###############################################################################
-###############################################################################
-
-#test simple
-module Main where
-
-#test no-exports
-module Main () where
-
-#test one-export
-module Main (main) where
-
-#test several-exports
-module Main (main, test1, test2) where
-
-#test many-exports
-module Main
- ( main
- , test1
- , test2
- , test3
- , test4
- , test5
- , test6
- , test7
- , test8
- , test9
- ) where
-
-#test exports-with-comments
-module Main
- ( main
- -- main
- , test1
- , test2
- -- Test 3
- , test3
- , test4
- -- Test 5
- , test5
- -- Test 6
- ) where
-
-#test simple-export-with-things
-module Main (Test(..)) where
-
-#test simple-export-with-module-contents
-module Main (module Main) where
-
-#test export-with-things
-module Main (Test(Test, a, b)) where
-
-#test export-with-empty-thing
-module Main (Test()) where
-
-#test empty-with-comment
--- Intentionally left empty
-
-###############################################################################
-###############################################################################
-###############################################################################
-#group import
-###############################################################################
-###############################################################################
-###############################################################################
-
-#test simple-import
-import Data.List
-
-#test simple-import-alias
-import Data.List as L
-
-#test simple-qualified-import
-import qualified Data.List
-
-#test simple-qualified-import-alias
-import qualified Data.List as L
-
-#test simple-safe
-import safe Data.List as L
-
-#test simple-source
-import {-# SOURCE #-} Data.List ()
-
-#test simple-safe-qualified
-import safe qualified Data.List hiding (nub)
-
-#test simple-safe-qualified-source
-import {-# SOURCE #-} safe qualified Data.List
-
-#test simple-qualified-package
-import qualified "base" Data.List
-
-#test qualifier-effect
-import {-# SOURCE #-} safe qualified "base" Data.List as L
-import {-# SOURCE #-} safe qualified "base" Data.List ()
-import {-# SOURCE #-} safe qualified Data.List hiding ()
-
-#test instances-only
-import qualified Data.List ()
-
-#test one-element
-import Data.List (nub)
-
-#test several-elements
-import Data.List (foldl', indexElem, nub)
-
-#test a-ridiculous-amount-of-elements
-import Test
- ( Long
- , anymore
- , fit
- , items
- , line
- , list
- , not
- , onA
- , quite
- , single
- , that
- , will
- , with
- )
-
-#test with-things
-import Test ((+), T, T2(), T3(..), T4(T4), T5(T5, t5), T6((<|>)))
-
-#test hiding
-import Test hiding ()
-import Test as T hiding ()
-
-#test import-hiding-many
-import Prelude as X
- hiding
- ( head
- , init
- , last
- , maximum
- , minimum
- , pred
- , read
- , readFile
- , succ
- , tail
- , undefined
- )
-
-#test long-module-name-simple
-import MoreThanSufficientlyLongModuleNameWithSome
- (compact, fit, inA, items, layout, not, that, will)
-import TestJustAbitToLongModuleNameLikeThisOneIs ()
-import TestJustShortEnoughModuleNameLikeThisOne ()
-
-#test long-module-name-as
-import TestJustAbitToLongModuleNameLikeThisOneI as T
-import TestJustShortEnoughModuleNameLikeThisOn as T
-
-#test long-module-name-hiding
-import TestJustAbitToLongModuleNameLikeTh hiding ()
-import TestJustShortEnoughModuleNameLike hiding ()
-
-#test long-module-name-simple-items
-import MoreThanSufficientlyLongModuleNameWithSome
- (compact, fit, inA, items, layout, not, that, will)
-
-#test long-module-name-hiding-items
-import TestJustShortEnoughModuleNameLike hiding (abc, def, ghci, jklm)
-
-#test import-with-comments
--- Test
-import Data.List (nub) -- Test
-{- Test -}
-import qualified Data.List as L (foldl') {- Test -}
-
-#test import-with-comments-2
-
-import Test
- ( abc
- , def
- -- comment
- )
-
-#test import-with-comments-3
-
-import Test
- ( abc
- -- comment
- )
-
-#test import-with-comments-4
-import Test
- ( abc
- -- comment
- , def
- , ghi
- {- comment -}
- , jkl
- -- comment
- )
-
--- Test
-import Test (test)
-
-#test import-with-comments-5
-import Test
- ( -- comment
- )
-
-#test long-bindings
-import Test (longbindingNameThatoverflowsColum)
-import Test (Long(List, Of, Things))
-
-#test things-with-with-comments
-import Test
- ( Thing
- ( With
- -- Comments
- , and
- -- also
- , items
- -- !
- )
- )
-import Test
- ( Thing
- ( Item
- -- and Comment
- )
- )
-import Test
- ( Thing
- ( With
- -- Comments
- , and
- -- also
- , items
- -- !
- )
- )
-
-#test prefer-dense-empty-list
-import VeryLongModuleNameThatCouldEvenCauseAnEmptyBindingListToExpandIntoMultipleLine
- ()
-
-#test preamble full-preamble
-{-# LANGUAGE BangPatterns #-}
-
-{-
- - Test module
- -}
-module Test
- ( test1
- -- ^ test
- , test2
- -- | test
- , test3
- , test4
- , test5
- , test6
- , test7
- , test8
- , test9
- , test10
- ) where
-
--- Test
-import Data.List (nub) -- Test
-{- Test -}
-import qualified Data.List as L (foldl') {- Test -}
-
--- Test
-import Test (test)
-
-###############################################################################
-###############################################################################
-###############################################################################
-#group regression
-###############################################################################
-###############################################################################
-###############################################################################
-
-#test newlines-comment
-func = do
- abc <- foo
-
---abc
-return ()
-
-#test parenthesis-around-unit
-func = (())
-
-#test let-defs indentation
-func = do
- let
- foo True = True
- foo _ = False
- return ()
-
-#test let-defs no indent
-func = do
- let
- foo True = True
- foo _ = False
- return ()
-
-#test let-defs no indent
-func = do
- let
- foo = True
- b = False
- return ()
-
-#test let-defs no indent
-func =
- let
- foo = True
- b = False
- in return ()
-
-#test record update indentation 1
-func = do
- s <- mGet
- mSet $ s { _lstate_indent = _lstate_indent state }
-
-#test record update indentation 2
-func = do
- s <- mGet
- mSet $ s
- { _lstate_indent = _lstate_indent state
- , _lstate_foo = _lstate_foo state
- }
-
-#test record update indentation 3
-func = do
- s <- mGet
- mSet $ s
- { _lstate_indent = _lstate_indent lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
- , _lstate_foo = _lstate_foo kasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
- }
-
-#test record construction 1
-func = Foo { _lstate_indent = _lstate_indent state }
-
-#test record construction 2
-func = Foo
- { _lstate_indent = _lstate_indent lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
- , _lstate_foo = _lstate_foo lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
- }
-
-#test record construction 3
-func = do
- Foo
- { _lstate_indent = _lstate_indent lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
- , _lstate_foo = _lstate_foo lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
- }
-
-#test post-indent comment
-func = do
--- abc
- -- def
- return ()
-
-#test post-unindent comment
-func = do
- do
- return ()
- -- abc
- -- def
- return ()
-
-#test CPP empty comment case
-#pending CPP parsing needs fixing for roundTripEqual
-{-# LANGUAGE CPP #-}
-module Test where
-func = do
-#if FOO
- let x = 13
-#endif
- stmt x
-
-## really, the following should be handled by forcing the Alt to multiline
-## because there are comments. as long as this is not implemented though,
-## we should ensure the trivial solution works.
-#test comment inline placement (temporary)
-func
- :: Int -- basic indentation amount
- -> Int -- currently used width in current line (after indent)
- -- used to accurately calc placing of the current-line
- -> LayoutDesc
- -> Int
-
-#test some indentation thingy
-func =
- (lkjadljasldjalskdjaldjalsdjkalsdjlaksdjlasjdlajsaldskj
- $ abc
- $ def
- $ ghi
- $ jkl
- )
-
-#test parenthesized operator
-buildG bounds0 edges0 = accumArray (flip (:)) [] bounds0 (map reassoc edges0)
- where reassoc (v, e, w) = (v, (e, w))
-
-#test record pattern matching stuff
-downloadRepoPackage = case repo of
- RepoLocal {..} -> return ()
- RepoLocal { abc } -> return ()
- RepoLocal{} -> return ()
-
-#test do let comment indentation level problem
-func = do
- let
- (primaryPkg, otherPkgs) = selectPrimaryLocalPackage pwd pkgs'
- (bproblems, x) = resolveBuildTargets primaryPkg otherPkgs utargets''
- -- default local dir target if there's no given target
- utargets'' = "foo"
- return ()
-
-#test list comprehension comment placement
-func =
- [ (thing, take 10 alts) --TODO: select best ones
- | (thing, _got, alts@(_ : _)) <- nosuchFooThing
- , gast <- award
- ]
-
-#test if-then-else comment placement
-func = if x
- then if y -- y is important
- then foo
- else bar
- else Nothing
-
-#test qualified infix pattern
-#pending "TODO"
-wrapPatPrepend pat prepElem = do
- patDocs <- layoutPat pat
- case Seq.viewl patDocs of
- Seq.EmptyL -> return $ Seq.empty
- x1 Seq.:< xR -> do
- x1' <- docSeq [prepElem, return x1]
- return $ x1' Seq.<| xR
-
-#test type signature multiline forcing issue
-layoutWriteNewlineBlock
- :: ( MonadMultiWriter Text.Builder.Builder m
- , MonadMultiState LayoutState m
- , MonadMultiWriter (Seq String) m
- )
- => m ()
-
-#test multiwayif proper indentation
-{-# LANGUAGE MultiWayIf #-}
-readMergePersConfig path shouldCreate conf = do
- exists <- liftIO $ System.Directory.doesFileExist path
- if
- | exists -> do
- contents <- liftIO $ ByteString.readFile path -- no lazy IO, tyvm.
- fileConf <- case Data.Yaml.decodeEither contents of
- Left e -> do
- liftIO
- $ putStrErrLn
- $ "error reading in brittany config from "
- ++ path
- ++ ":"
- liftIO $ putStrErrLn e
- mzero
- Right x -> return x
- return $ fileConf Semigroup.<> conf
- | shouldCreate -> do
- liftIO $ ByteString.writeFile path $ Data.Yaml.encode $ cMap
- (Option . Just . runIdentity)
- staticDefaultConfig
- return $ conf
- | otherwise -> do
- return conf
-
-#test nested pattern alignment issue"
-func = BuildReport
- where
- convertInstallOutcome = case result of
- Left BR.PlanningFailed -> PlanningFailed
- Left (BR.DependentFailed p) -> DependencyFailed p
- Left (BR.DownloadFailed _) -> DownloadFailed
- Left (BR.UnpackFailed _) -> UnpackFailed
- Left (BR.ConfigureFailed _) -> ConfigureFailed
- Left (BR.BuildFailed _) -> BuildFailed
- Left (BR.TestsFailed _) -> TestsFailed
- Left (BR.InstallFailed _) -> InstallFailed
- Right (BR.BuildOk _ _ _) -> InstallOk
-
-#test nested pattern alignment issue"
-func = BuildReport
- where
- convertInstallOutcome = case result of
- Left BR.PlanningFailed -> PlanningFailed
- Left (BR.DependentFailed p) -> DependencyFailed p
- Left (BR.DownloadFailed _) -> DownloadFailed
- Left (BR.UnpackFailed _) -> UnpackFailed
- Left (BR.ConfigureFailed _) -> ConfigureFailed
- Left (BR.BuildFailed _) -> BuildFailed
- Left (BR.TestsFailed _) -> TestsFailed
- Left (BR.InstallFailed _) -> InstallFailed
- Right (BR.BuildOk _ _ _) -> InstallOk
-
-#test partially overflowing alignment issue"
-showPackageDetailedInfo pkginfo =
- renderStyle (style { lineLength = 80, ribbonsPerLine = 1 })
- $ char '*'
- $+$ something
- [ entry "Synopsis" synopsis hideIfNull reflowParagraphs
- , entry
- "Versions available"
- sourceVersions
- (altText null "[ Not available from server ]")
- (dispTopVersions 9 (preferredVersions pkginfo))
- , entry
- "Versions installed"
- installedVersions
- (altText
- null
- (if hasLib pkginfo then "[ Not installed ]" else "[ Unknown ]")
- )
- (dispTopVersions 4 (preferredVersions pkginfo))
- , entry "Homepage" homepage orNotSpecified text
- , entry "Bug reports" bugReports orNotSpecified text
- , entry "Description" description hideIfNull reflowParagraphs
- , entry "Category" category hideIfNull text
- , entry "License" license alwaysShow disp
- , entry "Author" author hideIfNull reflowLines
- , entry "Maintainer" maintainer hideIfNull reflowLines
- , entry "Source repo" sourceRepo orNotSpecified text
- , entry "Executables" executables hideIfNull (commaSep text)
- , entry "Flags" flags hideIfNull (commaSep dispFlag)
- , entry "Dependencies" dependencies hideIfNull (commaSep dispExtDep)
- , entry "Documentation" haddockHtml showIfInstalled text
- , entry "Cached" haveTarball alwaysShow dispYesNo
- , if not (hasLib pkginfo)
- then empty
- else text "Modules:"
- $+$ nest 4 (vcat (map disp . sort . modules $ pkginfo))
- ]
-
-#test issue 7a
-isValidPosition position
- | validX && validY = Just position
- | otherwise = Nothing
-
-#test issue-6-pattern-linebreak-validity
-## this is ugly, but at least syntactically valid.
-foo = Reflex.runSpiderHost $ ReflexHost.hostApp $ do
- (inputEvent :: Reflex.Event Reflex.Spider String, inputFire :: String
- -> IO Bool) <-
- ReflexHost.newExternalEvent
- liftIO . forkIO . forever $ getLine >>= inputFire
- ReflexHost.performEvent_ $ fmap (liftIO . putStrLn) inputEvent
-
-#test issue 15
--- Test.hs
-module Test where
-
-data X = X
-
-#test issue 16
-foldrDesc f z = unSwitchQueue $ \q ->
- switch (Min.foldrDesc (f unTaggedF) z q) (Min.foldrAsc (f unTaggedF) z q)
-
-#test issue 18
-autocheckCases =
- [ ("Never Deadlocks", representative deadlocksNever)
- , ("No Exceptions", representative exceptionsNever)
- , ("Consistent Result", alwaysSame) -- already representative
- ]
-
-#test issue 18b
-autocheckCases =
- [ ("Never Deadlocks", representative deadlocksNever)
- , ("No Exceptions", representative exceptionsNever)
- , ( "Consistent Result"
- , alwaysSame -- already representative
- )
- ]
-
-#test issue 18c
-func =
- [ (abc, (1111, 1111))
- , (def, (2, 2))
- , foo -- comment
- ]
-
-#test issue 26
-foo a b = g a b -- fooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo
- where g a b = b + b * a
-
-#test issue 26b
-foo a b = g a b where g a b = b + b * a -- fooooooooooooooooooooooooooooooooooo
-
-#test aggressive alignment 1
-func = do
- abc <- expr
- abcccccccccccccccccc <- expr
- abcccccccccccccccccccccccccccccccccccccccccc <- expr
- abccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc <- expr
-
-#test example alignment 1
-func (MyLongFoo abc def) = 1
-func (Bar a d) = 2
-func _ = 3
-
-#test listcomprehension-case-of
-parserCompactLocation =
- [ try
- $ [ ParseRelAbs (Text.Read.read digits) _ _
- | digits <- many1 digit
- , rel1 :: Maybe (Either Int (Ratio Int)) <- optionMaybe
- [ case divPart of
- Nothing -> Left $ Text.Read.read digits
- Just ddigits ->
- Right $ Text.Read.read digits % Text.Read.read ddigits
- | digits <- many1 digit
- , divPart <- optionMaybe (string "/" *> many1 digit)
- ]
- ]
- ]
-
-#test opapp-specialcasing-1
-func = fooooooooooooooooooooooooooooooooo $ foooooooooooooooooooooooooooooooo
- foooooooooooooooooooooooooooooooo
- foooooooooooooooooooooooooooooooo
-
-#test opapp-specialcasing-2
-func =
- fooooooooooooooooooooooooooooooooo
- + foooooooooooooooooooooooooooooooo
- foooooooooooooooooooooooooooooooo
- foooooooooooooooooooooooooooooooo
-
-#test opapp-specialcasing-3
-func = fooooooooooooooooooooooooooooooooo + foooooooooooooooooooooooooooooooo
- [ foooooooooooooooooooooooooooooooo
- , foooooooooooooooooooooooooooooooo
- , foooooooooooooooooooooooooooooooo
- ]
-
-#test opapp-indenting
-parserPrim =
- [ r
- | r <-
- [ SGPPrimFloat $ bool id (0 -) minus $ readGnok
- "parserPrim"
- (d1 ++ d2 ++ d3 ++ d4)
- | d2 <- string "."
- , d3 <- many1 (oneOf "0123456789")
- , _ <- string "f"
- ]
- <|> [ SGPPrimFloat $ bool id (0 -) minus $ fromIntegral
- (readGnok "parserPrim" d1 :: Integer)
- | _ <- string "f"
- ]
- <|> [ SGPPrimInt $ bool id (0 -) minus $ fromIntegral
- (readGnok "parserPrim" d1 :: Integer)
- | _ <- string "i"
- ]
- ]
-
-#test another-parspacing-testcase
-
-samples = (SV.unpackaaaaadat) <&> \f ->
- aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
-
-#test recordupd-singleline-bug
-
-runBrittany tabSize text = do
- let
- config' = staticDefaultConfig
- config = config'
- { _conf_layout = (_conf_layout config')
- { _lconfig_indentAmount = coerce tabSize
- }
- , _conf_forward = forwardOptionsSyntaxExtsEnabled
- }
- parsePrintModule config text
-
-#test issue 38
-
-{-# LANGUAGE TypeApplications #-}
-foo = bar @Baz
-
-#test comment-before-BDCols
-{-# LANGUAGE TypeApplications #-}
-layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs = do
- docAlt
- $ -- one-line solution
- [ docCols
- (ColBindingLine alignmentToken)
- [ docSeq (patPartInline ++ [guardPart])
- , docSeq
- [ appSep $ return binderDoc
- , docForceSingleline $ return body
- , wherePart
- ]
- ]
- | not hasComments
- , [(guards, body, _bodyRaw)] <- [clauseDocs]
- , let guardPart = singleLineGuardsDoc guards
- , wherePart <- case mWhereDocs of
- Nothing -> return @[] $ docEmpty
- Just [w] -> return @[] $ docSeq
- [ docSeparator
- , appSep $ docLit $ Text.pack "where"
- , docSetIndentLevel $ docForceSingleline $ return w
- ]
- _ -> []
- ]
- ++ -- one-line solution + where in next line(s)
- [ docLines
- $ [ docCols
- (ColBindingLine alignmentToken)
- [ docSeq (patPartInline ++ [guardPart])
- , docSeq
- [appSep $ return binderDoc, docForceParSpacing $ return body]
- ]
- ]
- ++ wherePartMultiLine
- | [(guards, body, _bodyRaw)] <- [clauseDocs]
- , let guardPart = singleLineGuardsDoc guards
- , Data.Maybe.isJust mWhereDocs
- ]
- ++ -- two-line solution + where in next line(s)
- [ docLines
- $ [ docForceSingleline
- $ docSeq (patPartInline ++ [guardPart, return binderDoc])
- , docEnsureIndent BrIndentRegular $ docForceSingleline $ return
- body
- ]
- ++ wherePartMultiLine
- | [(guards, body, _bodyRaw)] <- [clauseDocs]
- , let guardPart = singleLineGuardsDoc guards
- ]
-
-#test comment-testcase-17
-{-# LANGUAGE MultiWayIf #-}
-func = do
- let
- foo = if
- | Constuctoooooooooooooooooooooooooooooooooooor `elem` artics -- TODO
- -> max
- (defLen - 0.2) -- TODO
- (defLen * 0.8)
- | otherwise -> max (defLen - 0.05) (defLen * 0.95) -- TODO
- return True
-
-#test issue 49
-
-foo n = case n of
- 1 -> True
- -1 -> False
-
-bar n = case n of
- (-2, -2) -> (-2, -2)
-
-#test issue 48 b
-
-{-# LANGUAGE TypeApplications #-}
-foo =
- let
- a = b @1
- cccc = ()
- in foo
-
-#test issue 176
-
-record :: Record
-record = Record
- { rProperties =
- [ "foo" .= "bar"
- , "foo" .= "bar"
- , "foo" .= "bar"
- , "foo" .= "bar"
- , "foo" .= "bar"
- , "foo" .= "bar"
- , "foo" .= "bar"
- , "foo" .= "bar"
- ]
- }
-
-
-###############################################################################
-###############################################################################
-###############################################################################
-#group pending
-###############################################################################
-###############################################################################
-###############################################################################
-
-
-
-## this testcase is not about idempotency, but about _how_ the output differs
-## from the input; i cannot really express this yet with the current
-## test-suite.
-## #test ayaz
-##
-## myManageHook =
-## composeOne [isFullscreen -?> doFullFloat, isDialog -?> doFloat, transience]
-## <+> composeAll
-## [ className =? "Pidgin" --> doFloat
-## , className =? "XCalc" --> doFloat
-## -- plan9port's acme
-## , className =? "acme" --> doFloat
-## -- Acme with Vi bindings editor
-## , title =? "ED" --> doFloat
-## , title =? "wlc-x11" --> doFloat
-## , className =? "Skype" --> doFloat
-## , className =? "ffplay" --> doFloat
-## , className =? "mpv" --> doFloat
-## , className =? "Plugin-container" --> doFloat -- Firefox flash, etc.
-## -- Firefox works well tiled, but it has dialog windows we want to float.
-## , appName =? "Browser" --> doFloat
-## ]
-## where
-## role = stringProperty "WM_WINDOW_ROLE"
diff --git a/src-literatetests/40-indent-policy-multiple.blt b/src-literatetests/40-indent-policy-multiple.blt
deleted file mode 100644
index b75c726..0000000
--- a/src-literatetests/40-indent-policy-multiple.blt
+++ /dev/null
@@ -1,42 +0,0 @@
-###############################################################################
-###############################################################################
-###############################################################################
-#group indent-policy-multiple
-###############################################################################
-###############################################################################
-###############################################################################
-
-#test long
--- brittany { lconfig_indentAmount: 4, lconfig_indentPolicy: IndentPolicyMultiple }
-func =
- mweroiuxlskdfjlksjdflkjsdfljksldkjflkjsdflkj
- + mweroiuxlskdfjlksjdflkjsdfljksldkjflkjsdflkj
-
-#test let indAmount=4
--- brittany { lconfig_indentAmount: 4, lconfig_indentPolicy: IndentPolicyMultiple }
-foo = do
- let aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa =
- aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa + aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
- foo
-
-#test let indAmount=8
--- brittany { lconfig_indentAmount: 8, lconfig_indentPolicy: IndentPolicyMultiple }
-foo = do
- let aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa =
- aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa + aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
- foo
-foo = do
- let aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa =
- aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
- + aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
- + aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
- foo
-
-#test nested do-block
--- brittany { lconfig_indentAmount: 4, lconfig_indentPolicy: IndentPolicyMultiple }
-foo = asdyf8asdf
- "ajsdfas"
- [ asjdf asyhf $ do
- aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
- aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
- ]
diff --git a/src-literatetests/Main.hs b/src-literatetests/Main.hs
deleted file mode 100644
index ae469e3..0000000
--- a/src-literatetests/Main.hs
+++ /dev/null
@@ -1,236 +0,0 @@
-{-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE CPP #-}
-
-module Main
- ( main
- )
-where
-
-
-
-#include "prelude.inc"
-
-import Test.Hspec
-import Test.Hspec.Runner ( hspecWith
- , defaultConfig
- , configConcurrentJobs
- )
-
-import qualified Text.Parsec as Parsec
-import Text.Parsec.Text ( Parser )
-
-import Data.Char ( isSpace )
-import Data.List ( groupBy )
-
-import Language.Haskell.Brittany.Internal
-
-import Language.Haskell.Brittany.Internal.Config.Types
-import Language.Haskell.Brittany.Internal.Config
-
-import Data.Coerce ( coerce )
-
-import qualified Data.Text.IO as Text.IO
-import System.FilePath ( (</>) )
-
-
-
-data InputLine
- = GroupLine Text
- | HeaderLine Text
- | GhcVersionGuardLine Text
- | PendingLine
- | NormalLine Text
- | CommentLine
- deriving Show
-
-data TestCase = TestCase
- { testName :: Text
- , isPending :: Bool
- , minGHCVersion :: Maybe Text
- , content :: Text
- }
-
-main :: IO ()
-main = do
- files <- System.Directory.listDirectory "src-literatetests/"
- let blts =
- List.sort
- $ filter (\x -> not ("tests-context-free.blt" `isSuffixOf` x))
- $ filter (".blt" `isSuffixOf`) files
- inputs <- blts `forM` \blt -> Text.IO.readFile ("src-literatetests" </> blt)
- let groups = createChunks =<< inputs
- inputCtxFree <- Text.IO.readFile "src-literatetests/30-tests-context-free.blt"
- let groupsCtxFree = createChunks inputCtxFree
- let parseVersion :: Text -> Maybe [Int]
- parseVersion =
- mapM (readMaybe . Text.unpack) . Text.splitOn (Text.pack ".")
- let ghcVersion = Data.Maybe.fromJust $ parseVersion $ Text.pack VERSION_ghc
- let checkVersion = \case
- Nothing -> True -- no version constraint
- Just s -> case parseVersion s of
- Nothing -> error $ "could not parse version " ++ Text.unpack s
- Just v -> v <= ghcVersion
- hspec $ do
- groups `forM_` \(groupname, tests) -> do
- describe (Text.unpack groupname) $ do
- tests `forM_` \test -> when (checkVersion $ minGHCVersion test) $ do
- (if isPending test then before_ pending else id)
- $ it (Text.unpack $ testName test)
- $ roundTripEqual defaultTestConfig
- $ content test
- groupsCtxFree `forM_` \(groupname, tests) -> do
- describe ("context free: " ++ Text.unpack groupname) $ do
- tests `forM_` \test -> when (checkVersion $ minGHCVersion test) $ do
- (if isPending test then before_ pending else id)
- $ it (Text.unpack $ testName test)
- $ roundTripEqual contextFreeTestConfig
- $ content test
- where
- -- this function might be implemented in a weirdly complex fashion; the
- -- reason being that it was copied from a somewhat more complex variant.
- createChunks :: Text -> [(Text, [TestCase])]
- createChunks input =
--- fmap (\case
--- HeaderLine n:PendingLine:rest | Just rlines <- mapM extractNormal rest -> (n, True, Text.unlines rlines)
--- HeaderLine n:rest | Just rlines <- mapM extractNormal rest -> (n, False, Text.unlines rlines)
--- l -> error $ "first non-empty line must start with #test footest\n" ++ show l
--- )
--- $ fmap (groupBy grouperT)
- fmap groupProcessor
- $ groupBy grouperG
- $ filter (not . lineIsSpace)
- $ fmap lineMapper
- $ Text.lines input
- where
- groupProcessor :: [InputLine] -> (Text, [TestCase])
- groupProcessor = \case
- GroupLine g : grouprest ->
- (,) g
- $ fmap testProcessor
- $ groupBy grouperT
- $ filter (not . lineIsSpace)
- $ grouprest
- l -> error $ "first non-empty line must be a #group\n" ++ show l
- testProcessor :: [InputLine] -> TestCase
- testProcessor = \case
- HeaderLine n : rest ->
- let normalLines = Data.Maybe.mapMaybe extractNormal rest
- in TestCase
- { testName = n
- , isPending = any isPendingLine rest
- , minGHCVersion = Data.List.Extra.firstJust extractMinGhc rest
- , content = Text.unlines normalLines
- }
- l ->
- error $ "first non-empty line must start with #test footest\n" ++ show l
- extractNormal (NormalLine l) = Just l
- extractNormal _ = Nothing
- extractMinGhc (GhcVersionGuardLine v) = Just v
- extractMinGhc _ = Nothing
- isPendingLine PendingLine{} = True
- isPendingLine _ = False
- specialLineParser :: Parser InputLine
- specialLineParser = Parsec.choice
- [ [ GroupLine $ Text.pack name
- | _ <- Parsec.try $ Parsec.string "#group"
- , _ <- Parsec.many1 $ Parsec.oneOf " \t"
- , name <- Parsec.many1 $ Parsec.noneOf "\r\n:"
- , _ <- Parsec.eof
- ]
- , [ HeaderLine $ Text.pack name
- | _ <- Parsec.try $ Parsec.string "#test"
- , _ <- Parsec.many1 $ Parsec.oneOf " \t"
- , name <- Parsec.many1 $ Parsec.noneOf "\r\n:"
- , _ <- Parsec.eof
- ]
- , [ GhcVersionGuardLine $ Text.pack version
- | _ <- Parsec.try $ Parsec.string "#min-ghc"
- , _ <- Parsec.many1 $ Parsec.oneOf " \t"
- , version <- Parsec.many1 $ Parsec.noneOf "\r\n:"
- ]
- , [ PendingLine
- | _ <- Parsec.try $ Parsec.string "#pending"
- , _ <- Parsec.optional $ many (Parsec.noneOf "\r\n")
- , _ <- Parsec.eof
- ]
- , [ CommentLine
- | _ <- Parsec.many $ Parsec.oneOf " \t"
- , _ <- Parsec.optional $ Parsec.string "##" <* many
- (Parsec.noneOf "\r\n")
- , _ <- Parsec.eof
- ]
- , [ NormalLine mempty
- | _ <- Parsec.try $ Parsec.string "<BLANKLINE>"
- , _ <- Parsec.eof
- ]
- ]
- lineMapper :: Text -> InputLine
- lineMapper line = case Parsec.runParser specialLineParser () "" line of
- Left _e -> NormalLine line
- Right l -> l
- lineIsSpace :: InputLine -> Bool
- lineIsSpace CommentLine = True
- lineIsSpace _ = False
- grouperG :: InputLine -> InputLine -> Bool
- grouperG _ GroupLine{} = False
- grouperG _ _ = True
- grouperT :: InputLine -> InputLine -> Bool
- grouperT _ HeaderLine{} = False
- grouperT _ _ = True
-
-
---------------------
--- past this line: copy-pasta from other test (meh..)
---------------------
-roundTripEqual :: Config -> Text -> Expectation
-roundTripEqual c t =
- fmap (fmap PPTextWrapper) (parsePrintModuleTests c "TestFakeFileName.hs" t)
- `shouldReturn` Right (PPTextWrapper t)
-
-newtype PPTextWrapper = PPTextWrapper Text
- deriving Eq
-
-instance Show PPTextWrapper where
- show (PPTextWrapper t) = "\n" ++ Text.unpack t
-
--- brittany-next-binding --columns 160
--- brittany-next-binding { lconfig_indentPolicy: IndentPolicyLeft }
-defaultTestConfig :: Config
-defaultTestConfig = Config
- { _conf_version = _conf_version staticDefaultConfig
- , _conf_debug = _conf_debug staticDefaultConfig
- , _conf_layout = LayoutConfig
- { _lconfig_cols = coerce (80 :: Int)
- , _lconfig_indentPolicy = coerce IndentPolicyFree
- , _lconfig_indentAmount = coerce (2 :: Int)
- , _lconfig_indentWhereSpecial = coerce True
- , _lconfig_indentListSpecial = coerce True
- , _lconfig_importColumn = coerce (60 :: Int)
- , _lconfig_importAsColumn = coerce (60 :: Int)
- , _lconfig_altChooser = coerce $ AltChooserBoundedSearch 3
- , _lconfig_columnAlignMode = coerce (ColumnAlignModeMajority 0.7)
- , _lconfig_alignmentLimit = coerce (30 :: Int)
- , _lconfig_alignmentBreakOnMultiline = coerce True
- , _lconfig_hangingTypeSignature = coerce False
- , _lconfig_reformatModulePreamble = coerce True
- , _lconfig_allowSingleLineExportList = coerce True
- , _lconfig_allowHangingQuasiQuotes = coerce True
- , _lconfig_experimentalSemicolonNewlines = coerce False
- -- , _lconfig_allowSinglelineRecord = coerce False
- }
- , _conf_errorHandling = (_conf_errorHandling staticDefaultConfig) { _econf_omit_output_valid_check = coerce True }
- , _conf_preprocessor = _conf_preprocessor staticDefaultConfig
- , _conf_forward = ForwardOptions { _options_ghc = Identity [] }
- , _conf_roundtrip_exactprint_only = coerce False
- , _conf_disable_formatting = coerce False
- , _conf_obfuscate = coerce False
- }
-
-contextFreeTestConfig :: Config
-contextFreeTestConfig = defaultTestConfig
- { _conf_layout = (_conf_layout defaultTestConfig)
- { _lconfig_indentPolicy = coerce IndentPolicyLeft
- , _lconfig_alignmentLimit = coerce (1 :: Int)
- , _lconfig_columnAlignMode = coerce ColumnAlignModeDisabled
- }
- }
diff --git a/src-unittests/AsymptoticPerfTests.hs b/src-unittests/AsymptoticPerfTests.hs
deleted file mode 100644
index f3f35ba..0000000
--- a/src-unittests/AsymptoticPerfTests.hs
+++ /dev/null
@@ -1,41 +0,0 @@
-{-# LANGUAGE QuasiQuotes #-}
-
-module AsymptoticPerfTests
- ( asymptoticPerfTest
- )
-where
-
-
-
-#include "prelude.inc"
-
-import Test.Hspec
-
-import Language.Haskell.Brittany.Internal
-
-import TestUtils
-
-
-
-asymptoticPerfTest :: Spec
-asymptoticPerfTest = do
- it "1000 do statements"
- $ roundTripEqualWithTimeout 1500000
- $ (Text.pack "func = do\n")
- <> Text.replicate 1000 (Text.pack " statement\n")
- it "1000 do nestings"
- $ roundTripEqualWithTimeout 4000000
- $ (Text.pack "func = ")
- <> mconcat
- ( [0 .. 999]
- <&> \(i :: Int) ->
- (Text.replicate (2 * i) (Text.pack " ") <> Text.pack "do\n")
- )
- <> Text.replicate 2000 (Text.pack " ")
- <> Text.pack "return\n"
- <> Text.replicate 2002 (Text.pack " ")
- <> Text.pack "()"
- it "1000 AppOps"
- $ roundTripEqualWithTimeout 1000000
- $ (Text.pack "func = expr")
- <> Text.replicate 200 (Text.pack "\n . expr") --TODO
diff --git a/src-unittests/TestMain.hs b/src-unittests/TestMain.hs
deleted file mode 100644
index ca6dbb5..0000000
--- a/src-unittests/TestMain.hs
+++ /dev/null
@@ -1,22 +0,0 @@
-{-# LANGUAGE QuasiQuotes #-}
-
-module Main where
-
-
-
-#include "prelude.inc"
-
-import Test.Hspec
-
-import Language.Haskell.Brittany.Internal
-
-import AsymptoticPerfTests
-
-
-
-main :: IO ()
-main = hspec $ tests
-
-tests :: Spec
-tests = do
- describe "asymptotic perf roundtrips" $ asymptoticPerfTest
diff --git a/src-unittests/TestUtils.hs b/src-unittests/TestUtils.hs
deleted file mode 100644
index 052ade6..0000000
--- a/src-unittests/TestUtils.hs
+++ /dev/null
@@ -1,74 +0,0 @@
-{-# LANGUAGE QuasiQuotes #-}
-
-module TestUtils where
-
-
-
-#include "prelude.inc"
-
-import Test.Hspec
-
--- import NeatInterpolation
-
-import Language.Haskell.Brittany.Internal
-
-import Language.Haskell.Brittany.Internal.Config.Types
-import Language.Haskell.Brittany.Internal.Config
-
-import System.Timeout ( timeout )
-
-import Data.Coerce ( coerce )
-
-
-
-roundTripEqual :: Text -> Expectation
-roundTripEqual t =
- fmap (fmap PPTextWrapper)
- (parsePrintModuleTests defaultTestConfig "TestFakeFileName.hs" t)
- `shouldReturn` Right (PPTextWrapper t)
-
-roundTripEqualWithTimeout :: Int -> Text -> Expectation
-roundTripEqualWithTimeout time t =
- timeout time (action >>= evaluate) >>= (`shouldSatisfy`Data.Maybe.isJust)
- where
- action = fmap (fmap PPTextWrapper)
- (parsePrintModuleTests defaultTestConfig "TestFakeFileName.hs" t)
-
-newtype PPTextWrapper = PPTextWrapper Text
- deriving Eq
-
-instance Show PPTextWrapper where
- show (PPTextWrapper t) = "\n" ++ Text.unpack t
-
-defaultTestConfig :: Config
-defaultTestConfig = Config
- { _conf_version = _conf_version staticDefaultConfig
- , _conf_debug = _conf_debug staticDefaultConfig
- , _conf_layout = LayoutConfig
- { _lconfig_cols = coerce (80 :: Int)
- , _lconfig_indentPolicy = coerce IndentPolicyFree
- , _lconfig_indentAmount = coerce (2 :: Int)
- , _lconfig_indentWhereSpecial = coerce True
- , _lconfig_indentListSpecial = coerce True
- , _lconfig_importColumn = coerce (60 :: Int)
- , _lconfig_importAsColumn = coerce (60 :: Int)
- , _lconfig_altChooser = coerce $ AltChooserBoundedSearch 3
- , _lconfig_columnAlignMode = coerce (ColumnAlignModeMajority 0.7)
- , _lconfig_alignmentLimit = coerce (30 :: Int)
- , _lconfig_alignmentBreakOnMultiline = coerce True
- , _lconfig_hangingTypeSignature = coerce False
- , _lconfig_reformatModulePreamble = coerce True
- , _lconfig_allowSingleLineExportList = coerce True
- , _lconfig_allowHangingQuasiQuotes = coerce True
- , _lconfig_experimentalSemicolonNewlines = coerce False
- -- , _lconfig_allowSinglelineRecord = coerce False
- }
- , _conf_errorHandling = (_conf_errorHandling staticDefaultConfig)
- { _econf_ExactPrintFallback = coerce ExactPrintFallbackModeNever
- }
- , _conf_preprocessor = (_conf_preprocessor staticDefaultConfig)
- , _conf_forward = ForwardOptions {_options_ghc = Identity []}
- , _conf_roundtrip_exactprint_only = coerce False
- , _conf_disable_formatting = coerce False
- , _conf_obfuscate = coerce False
- }
diff --git a/src/Language/Haskell/Brittany/Internal/Config/Types/Instances.hs b/src/Language/Haskell/Brittany/Internal/Config/Types/Instances.hs
deleted file mode 100644
index 74dfe0e..0000000
--- a/src/Language/Haskell/Brittany/Internal/Config/Types/Instances.hs
+++ /dev/null
@@ -1,130 +0,0 @@
-{-# OPTIONS_GHC -fno-warn-orphans #-}
--- These optimizations are disabled to improve compile times (and compilation
--- memory usage). When we do not disable them, the CI servers take more than
--- 10 minutes to compile this module alone.
--- Having looked into aeson and how the instances are written, I still do
--- not understand what makes GHC choke so much here. The size of the raw
--- expressions below looks fairly negligible, so there must be some expansion
--- due to inlining going on. But even disabling INLINE pragmas in aeson did
--- not seem to change anything.
--- Nonetheless, this solution works and has no downsides because the
--- instances defined here are not in any way performance-critical.
-{-# OPTIONS_GHC -fno-pre-inlining #-}
-{-# OPTIONS_GHC -fno-specialise #-}
-{-# OPTIONS_GHC -fignore-interface-pragmas #-}
-
-module Language.Haskell.Brittany.Internal.Config.Types.Instances
-where
-
-
-
-#include "prelude.inc"
-
-import Data.Yaml
-import qualified Data.Aeson.Types as Aeson
-
-import Language.Haskell.Brittany.Internal.Config.Types
-
-import GHC.Generics
-
-
-
-aesonDecodeOptionsBrittany :: Aeson.Options
-aesonDecodeOptionsBrittany = Aeson.defaultOptions
- { Aeson.omitNothingFields = True
- , Aeson.fieldLabelModifier = dropWhile (=='_')
- }
-
-#define makeFromJSON(type)\
- instance FromJSON (type) where\
- parseJSON = Aeson.genericParseJSON aesonDecodeOptionsBrittany;\
- {-# NOINLINE parseJSON #-}
-#define makeToJSON(type)\
- instance ToJSON (type) where\
- toJSON = Aeson.genericToJSON aesonDecodeOptionsBrittany;\
- {-# NOINLINE toJSON #-};\
- toEncoding = Aeson.genericToEncoding aesonDecodeOptionsBrittany;\
- {-# NOINLINE toEncoding #-}
-
-#define makeFromJSONMaybe(type)\
- instance FromJSON (type Maybe) where\
- parseJSON = Aeson.genericParseJSON aesonDecodeOptionsBrittany;\
- {-# NOINLINE parseJSON #-}
-#define makeFromJSONOption(type)\
- instance FromJSON (type Option) where\
- parseJSON = fmap (cMap Option) . parseJSON;\
- {-# NOINLINE parseJSON #-}
-#define makeToJSONMaybe(type)\
- instance ToJSON (type Maybe) where\
- toJSON = Aeson.genericToJSON aesonDecodeOptionsBrittany;\
- {-# NOINLINE toJSON #-};\
- toEncoding = Aeson.genericToEncoding aesonDecodeOptionsBrittany;\
- {-# NOINLINE toEncoding #-}
-#define makeToJSONOption(type)\
- instance ToJSON (type Option) where\
- toJSON = toJSON . cMap getOption;\
- {-# NOINLINE toJSON #-};\
- toEncoding = toEncoding . cMap getOption;\
- {-# NOINLINE toEncoding #-}
-
-
-makeFromJSONOption(CDebugConfig)
-makeFromJSONMaybe(CDebugConfig)
-makeToJSONOption(CDebugConfig)
-makeToJSONMaybe(CDebugConfig)
-
-makeFromJSON(IndentPolicy)
-makeToJSON(IndentPolicy)
-makeFromJSON(AltChooser)
-makeToJSON(AltChooser)
-makeFromJSON(ColumnAlignMode)
-makeToJSON(ColumnAlignMode)
-makeFromJSON(CPPMode)
-makeToJSON(CPPMode)
-makeFromJSON(ExactPrintFallbackMode)
-makeToJSON(ExactPrintFallbackMode)
-
-makeFromJSONOption(CLayoutConfig)
-makeFromJSONMaybe(CLayoutConfig)
-makeToJSONOption(CLayoutConfig)
-makeToJSONMaybe(CLayoutConfig)
-
-makeFromJSONOption(CErrorHandlingConfig)
-makeFromJSONMaybe(CErrorHandlingConfig)
-makeToJSONOption(CErrorHandlingConfig)
-makeToJSONMaybe(CErrorHandlingConfig)
-
-makeFromJSONOption(CForwardOptions)
-makeFromJSONMaybe(CForwardOptions)
-makeToJSONOption(CForwardOptions)
-makeToJSONMaybe(CForwardOptions)
-
-makeFromJSONOption(CPreProcessorConfig)
-makeFromJSONMaybe(CPreProcessorConfig)
-makeToJSONOption(CPreProcessorConfig)
-makeToJSONMaybe(CPreProcessorConfig)
-
-makeFromJSONOption(CConfig)
-makeToJSONOption(CConfig)
-makeToJSONMaybe(CConfig)
-
--- This custom instance ensures the "omitNothingFields" behaviour not only for
--- leafs, but for nodes of the config as well. This way e.g. "{}" is valid
--- config file content.
-instance FromJSON (CConfig Maybe) where
- parseJSON (Object v) = Config
- <$> v .:? Text.pack "conf_version"
- <*> v .:?= Text.pack "conf_debug"
- <*> v .:?= Text.pack "conf_layout"
- <*> v .:?= Text.pack "conf_errorHandling"
- <*> v .:?= Text.pack "conf_forward"
- <*> v .:?= Text.pack "conf_preprocessor"
- <*> v .:? Text.pack "conf_roundtrip_exactprint_only"
- <*> v .:? Text.pack "conf_disable_formatting"
- <*> v .:? Text.pack "conf_obfuscate"
- parseJSON invalid = Aeson.typeMismatch "Config" invalid
-
--- Pretends that the value is {} when the key is not present.
-(.:?=) :: FromJSON a => Object -> Text -> Parser a
-o .:?= k = o .:? k >>= maybe (parseJSON (Aeson.object [])) pure
-
diff --git a/src/Language/Haskell/Brittany/Internal/ExactPrintUtils.hs b/src/Language/Haskell/Brittany/Internal/ExactPrintUtils.hs
deleted file mode 100644
index 9992dfd..0000000
--- a/src/Language/Haskell/Brittany/Internal/ExactPrintUtils.hs
+++ /dev/null
@@ -1,338 +0,0 @@
-{-# LANGUAGE DataKinds #-}
-
-module Language.Haskell.Brittany.Internal.ExactPrintUtils
- ( parseModule
- , parseModuleFromString
- , commentAnnFixTransformGlob
- , extractToplevelAnns
- , foldedAnnKeys
- , withTransformedAnns
- )
-where
-
-
-
-#include "prelude.inc"
-
-import Language.Haskell.Brittany.Internal.Types
-import Language.Haskell.Brittany.Internal.Config.Types
-import Language.Haskell.Brittany.Internal.Utils
-import Data.Data
-import Data.HList.HList
-
-import DynFlags ( getDynFlags )
-import GHC ( runGhc, GenLocated(L), moduleNameString )
-import qualified DynFlags as GHC
-import qualified GHC as GHC hiding (parseModule)
-import qualified Parser as GHC
-import qualified SrcLoc as GHC
-import qualified FastString as GHC
-import qualified GHC as GHC hiding (parseModule)
-import qualified Lexer as GHC
-import qualified StringBuffer as GHC
-import qualified Outputable as GHC
-import qualified CmdLineParser as GHC
-
-#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
-import GHC.Hs
-import Bag
-#else
-import HsSyn
-#endif
-
-import SrcLoc ( SrcSpan, Located )
-
-
-import qualified Language.Haskell.GHC.ExactPrint as ExactPrint
-import qualified Language.Haskell.GHC.ExactPrint.Annotate as ExactPrint
-import qualified Language.Haskell.GHC.ExactPrint.Types as ExactPrint
-import qualified Language.Haskell.GHC.ExactPrint.Parsers as ExactPrint
-import qualified Language.Haskell.GHC.ExactPrint.Preprocess as ExactPrint
-import qualified Language.Haskell.GHC.ExactPrint.Delta as ExactPrint
-
-import qualified Data.Generics as SYB
-
-import Control.Exception
--- import Data.Generics.Schemes
-
-
-
-parseModule
- :: [String]
- -> System.IO.FilePath
- -> (GHC.DynFlags -> IO (Either String a))
- -> IO (Either String (ExactPrint.Anns, GHC.ParsedSource, a))
-parseModule =
- parseModuleWithCpp ExactPrint.defaultCppOptions ExactPrint.normalLayout
-
--- | Parse a module with specific instructions for the C pre-processor.
-parseModuleWithCpp
- :: ExactPrint.CppOptions
- -> ExactPrint.DeltaOptions
- -> [String]
- -> System.IO.FilePath
- -> (GHC.DynFlags -> IO (Either String a))
- -> IO (Either String (ExactPrint.Anns, GHC.ParsedSource, a))
-parseModuleWithCpp cpp opts args fp dynCheck =
- ExactPrint.ghcWrapper $ ExceptT.runExceptT $ do
- dflags0 <- lift $ GHC.getSessionDynFlags
- (dflags1, leftover, warnings) <- lift $ GHC.parseDynamicFlagsCmdLine
- dflags0
- (GHC.noLoc <$> ("-hide-all-packages" : args))
- -- that we pass -hide-all-packages here is a duplication, because
- -- ExactPrint.initDynFlags also does it, but necessary because of
- -- stupid and careless GHC API design. We explicitly want to pass
- -- our args before calling that, so this is what we do. Should be
- -- harmless. See commit 1b7576dcd1823e1c685a44927b1fcaade1319063.
- void $ lift $ GHC.setSessionDynFlags dflags1
- dflags2 <- lift $ ExactPrint.initDynFlags fp
- when (not $ null leftover)
- $ ExceptT.throwE
- $ "when parsing ghc flags: leftover flags: "
- ++ show (leftover <&> \(L _ s) -> s)
- when (not $ null warnings)
- $ ExceptT.throwE
- $ "when parsing ghc flags: encountered warnings: "
- ++ show (warnings <&> warnExtractorCompat)
- x <- ExceptT.ExceptT $ liftIO $ dynCheck dflags2
- res <- lift $ ExactPrint.parseModuleApiAnnsWithCppInternal cpp dflags2 fp
-#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
- either (\err -> ExceptT.throwE $ "transform error: " ++ show (bagToList (show <$> err)))
-#else
- either (\(span, err) -> ExceptT.throwE $ show span ++ ": " ++ err)
-#endif
- (\(a, m) -> pure (a, m, x))
- $ ExactPrint.postParseTransform res opts
-
-parseModuleFromString
- :: [String]
- -> System.IO.FilePath
- -> (GHC.DynFlags -> IO (Either String a))
- -> String
- -> IO (Either String (ExactPrint.Anns, GHC.ParsedSource, a))
-parseModuleFromString args fp dynCheck str =
- -- We mask here because otherwise using `throwTo` (i.e. for a timeout) will
- -- produce nasty looking errors ("ghc panic"). The `mask_` makes it so we
- -- cannot kill the parsing thread - not very nice. But i'll
- -- optimistically assume that most of the time brittany uses noticable or
- -- longer time, the majority of the time is not spend in parsing, but in
- -- bridoc transformation stuff.
- -- (reminder to update note on `parsePrintModule` if this changes.)
- mask_ $ ExactPrint.ghcWrapper $ ExceptT.runExceptT $ do
- dflags0 <- lift $ ExactPrint.initDynFlagsPure fp str
- (dflags1, leftover, warnings) <- lift
- $ GHC.parseDynamicFlagsCmdLine dflags0 (GHC.noLoc <$> args)
- when (not $ null leftover)
- $ ExceptT.throwE
- $ "when parsing ghc flags: leftover flags: "
- ++ show (leftover <&> \(L _ s) -> s)
- when (not $ null warnings)
- $ ExceptT.throwE
- $ "when parsing ghc flags: encountered warnings: "
- ++ show (warnings <&> warnExtractorCompat)
- dynCheckRes <- ExceptT.ExceptT $ liftIO $ dynCheck dflags1
- let res = ExactPrint.parseModuleFromStringInternal dflags1 fp str
- case res of
-#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
- Left err -> ExceptT.throwE $ "parse error: " ++ show (bagToList (show <$> err))
-#else
- Left (span, err) -> ExceptT.throwE $ showOutputable span ++ ": " ++ err
-#endif
- Right (a , m ) -> pure (a, m, dynCheckRes)
-
-
-commentAnnFixTransformGlob :: SYB.Data ast => ast -> ExactPrint.Transform ()
-commentAnnFixTransformGlob ast = do
- let extract :: forall a . SYB.Data a => a -> Seq (SrcSpan, ExactPrint.AnnKey)
- extract = -- traceFunctionWith "extract" (show . SYB.typeOf) show $
- const Seq.empty
- `SYB.ext1Q`
- (\l@(L span _) -> Seq.singleton (span, ExactPrint.mkAnnKey l))
- let nodes = SYB.everything (<>) extract ast
- let annsMap :: Map GHC.RealSrcLoc ExactPrint.AnnKey
- annsMap = Map.fromListWith
- (flip const)
- [ (GHC.realSrcSpanEnd span, annKey)
- | (GHC.RealSrcSpan span, annKey) <- Foldable.toList nodes
- ]
- nodes `forM_` (snd .> processComs annsMap)
- where
- processComs annsMap annKey1 = do
- mAnn <- State.Class.gets fst <&> Map.lookup annKey1
- mAnn `forM_` \ann1 -> do
- let priors = ExactPrint.annPriorComments ann1
- follows = ExactPrint.annFollowingComments ann1
- assocs = ExactPrint.annsDP ann1
- let
- processCom
- :: (ExactPrint.Comment, ExactPrint.DeltaPos)
- -> ExactPrint.TransformT Identity Bool
- processCom comPair@(com, _) =
- case GHC.srcSpanStart $ ExactPrint.commentIdentifier com of
- GHC.UnhelpfulLoc{} -> return True -- retain comment at current node.
- GHC.RealSrcLoc comLoc -> case Map.lookupLE comLoc annsMap of
- Just (_, annKey2) | loc1 /= loc2 -> case (con1, con2) of
- (ExactPrint.CN "RecordCon", ExactPrint.CN "HsRecField") ->
- move $> False
- (x, y) | x == y -> move $> False
- _ -> return True
- where
- ExactPrint.AnnKey annKeyLoc1 con1 = annKey1
- ExactPrint.AnnKey annKeyLoc2 con2 = annKey2
- loc1 = GHC.srcSpanStart annKeyLoc1
- loc2 = GHC.srcSpanStart annKeyLoc2
- move = ExactPrint.modifyAnnsT $ \anns ->
- let
- ann2 = Data.Maybe.fromJust $ Map.lookup annKey2 anns
- ann2' = ann2
- { ExactPrint.annFollowingComments =
- ExactPrint.annFollowingComments ann2 ++ [comPair]
- }
- in
- Map.insert annKey2 ann2' anns
- _ -> return True -- retain comment at current node.
- priors' <- flip filterM priors processCom
- follows' <- flip filterM follows $ processCom
- assocs' <- flip filterM assocs $ \case
- (ExactPrint.AnnComment com, dp) -> processCom (com, dp)
- _ -> return True
- let ann1' = ann1 { ExactPrint.annPriorComments = priors'
- , ExactPrint.annFollowingComments = follows'
- , ExactPrint.annsDP = assocs'
- }
- ExactPrint.modifyAnnsT $ \anns -> Map.insert annKey1 ann1' anns
-
-
--- TODO: this is unused by now, but it contains one detail that
--- commentAnnFixTransformGlob does not include: Moving of comments for
--- "RecordUpd"s.
--- commentAnnFixTransform :: GHC.ParsedSource -> ExactPrint.Transform ()
--- commentAnnFixTransform modul = SYB.everything (>>) genF modul
--- where
--- genF :: Data.Data.Data a => a -> ExactPrint.Transform ()
--- genF = (\_ -> return ()) `SYB.extQ` exprF
--- exprF :: Located (HsExpr GhcPs) -> ExactPrint.Transform ()
--- exprF lexpr@(L _ expr) = case expr of
--- #if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
--- RecordCon _ _ (HsRecFields fs@(_:_) Nothing) ->
--- #else
--- RecordCon _ _ _ (HsRecFields fs@(_:_) Nothing) ->
--- #endif
--- moveTrailingComments lexpr (List.last fs)
--- #if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
--- RecordUpd _ _e fs@(_:_) ->
--- #else
--- RecordUpd _e fs@(_:_) _cons _ _ _ ->
--- #endif
--- moveTrailingComments lexpr (List.last fs)
--- _ -> return ()
-
-commentAnnFixTransform :: GHC.ParsedSource -> ExactPrint.Transform ()
-commentAnnFixTransform modul = SYB.everything (>>) genF modul
- where
- genF :: Data.Data.Data a => a -> ExactPrint.Transform ()
- genF = (\_ -> return ()) `SYB.extQ` exprF
- exprF :: Located (HsExpr GhcPs) -> ExactPrint.Transform ()
- exprF lexpr@(L _ expr) = case expr of
- RecordCon _ _ (HsRecFields fs@(_:_) Nothing) ->
- moveTrailingComments lexpr (List.last fs)
- RecordUpd _ _e fs@(_:_) ->
- moveTrailingComments lexpr (List.last fs)
- _ -> return ()
-
-moveTrailingComments :: (Data.Data.Data a,Data.Data.Data b)
- => GHC.Located a -> GHC.Located b -> ExactPrint.Transform ()
-moveTrailingComments astFrom astTo = do
- let
- k1 = ExactPrint.mkAnnKey astFrom
- k2 = ExactPrint.mkAnnKey astTo
- moveComments ans = ans'
- where
- an1 = Data.Maybe.fromJust $ Map.lookup k1 ans
- an2 = Data.Maybe.fromJust $ Map.lookup k2 ans
- cs1f = ExactPrint.annFollowingComments an1
- cs2f = ExactPrint.annFollowingComments an2
- (comments, nonComments) = flip breakEither (ExactPrint.annsDP an1)
- $ \case
- (ExactPrint.AnnComment com, dp) -> Left (com, dp)
- x -> Right x
- an1' = an1
- { ExactPrint.annsDP = nonComments
- , ExactPrint.annFollowingComments = []
- }
- an2' = an2
- { ExactPrint.annFollowingComments = cs1f ++ cs2f ++ comments
- }
- ans' = Map.insert k1 an1' $ Map.insert k2 an2' ans
-
- ExactPrint.modifyAnnsT moveComments
-
--- | split a set of annotations in a module into a map from top-level module
--- elements to the relevant annotations. Avoids quadratic behaviour a trivial
--- implementation would have.
-extractToplevelAnns
- :: Located (HsModule GhcPs)
- -> ExactPrint.Anns
- -> Map ExactPrint.AnnKey ExactPrint.Anns
-extractToplevelAnns lmod anns = output
- where
- (L _ (HsModule _ _ _ ldecls _ _)) = lmod
- declMap1 :: Map ExactPrint.AnnKey ExactPrint.AnnKey
- declMap1 = Map.unions $ ldecls <&> \ldecl ->
- Map.fromSet (const (ExactPrint.mkAnnKey ldecl)) (foldedAnnKeys ldecl)
- declMap2 :: Map ExactPrint.AnnKey ExactPrint.AnnKey
- declMap2 =
- Map.fromList
- $ [ (captured, declMap1 Map.! k)
- | (k, ExactPrint.Ann _ _ _ _ _ (Just captured)) <- Map.toList anns
- ]
- declMap = declMap1 `Map.union` declMap2
- modKey = ExactPrint.mkAnnKey lmod
- output = groupMap (\k _ -> Map.findWithDefault modKey k declMap) anns
-
-groupMap :: (Ord k, Ord l) => (k -> a -> l) -> Map k a -> Map l (Map k a)
-groupMap f = Map.foldlWithKey' (\m k a -> Map.alter (insert k a) (f k a) m)
- Map.empty
- where
- insert k a Nothing = Just (Map.singleton k a)
- insert k a (Just m) = Just (Map.insert k a m)
-
-foldedAnnKeys :: Data.Data.Data ast => ast -> Set ExactPrint.AnnKey
-foldedAnnKeys ast = SYB.everything
- Set.union
- ( \x -> maybe
- Set.empty
- Set.singleton
- [ SYB.gmapQi 1 (\t -> ExactPrint.mkAnnKey $ L l t) x
- | locTyCon == SYB.typeRepTyCon (SYB.typeOf x)
- , l :: SrcSpan <- SYB.gmapQi 0 SYB.cast x
- -- for some reason, ghc-8.8 has forgotten how to infer the type of l,
- -- even though it is passed to mkAnnKey above, which only accepts
- -- SrcSpan.
- ]
- )
- ast
- where locTyCon = SYB.typeRepTyCon (SYB.typeOf (L () ()))
-
-
-withTransformedAnns
- :: Data ast
- => ast
- -> MultiRWSS.MultiRWS '[Config, ExactPrint.Anns] w s a
- -> MultiRWSS.MultiRWS '[Config, ExactPrint.Anns] w s a
-withTransformedAnns ast m = MultiRWSS.mGetRawR >>= \case
- readers@(conf :+: anns :+: HNil) -> do
- -- TODO: implement `local` for MultiReader/MultiRWS
- MultiRWSS.mPutRawR (conf :+: f anns :+: HNil)
- x <- m
- MultiRWSS.mPutRawR readers
- pure x
- where
- f anns =
- let ((), (annsBalanced, _), _) =
- ExactPrint.runTransform anns (commentAnnFixTransformGlob ast)
- in annsBalanced
-
-
-warnExtractorCompat :: GHC.Warn -> String
-warnExtractorCompat (GHC.Warn _ (L _ s)) = s
diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs-boot b/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs-boot
deleted file mode 100644
index e3be109..0000000
--- a/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs-boot
+++ /dev/null
@@ -1,33 +0,0 @@
-{-# LANGUAGE DataKinds #-}
-
-module Language.Haskell.Brittany.Internal.Layouters.Expr
- ( layoutExpr
- , litBriDoc
- , overLitValBriDoc
- )
-where
-
-
-
-#include "prelude.inc"
-
-import Language.Haskell.Brittany.Internal.Types
-import Language.Haskell.Brittany.Internal.LayouterBasics
-
-import GHC ( runGhc, GenLocated(L), moduleNameString )
-#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
-import GHC.Hs
-#else
-import HsSyn
-#endif
-import Name
-
-
-
-layoutExpr :: ToBriDoc HsExpr
-
--- layoutStmt :: ToBriDoc' (StmtLR GhcPs GhcPs (LHsExpr GhcPs))
-
-litBriDoc :: HsLit GhcPs -> BriDocFInt
-
-overLitValBriDoc :: OverLitVal -> BriDocFInt
diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Stmt.hs-boot b/src/Language/Haskell/Brittany/Internal/Layouters/Stmt.hs-boot
deleted file mode 100644
index 1fab3c5..0000000
--- a/src/Language/Haskell/Brittany/Internal/Layouters/Stmt.hs-boot
+++ /dev/null
@@ -1,27 +0,0 @@
-{-# LANGUAGE DataKinds #-}
-
-module Language.Haskell.Brittany.Internal.Layouters.Stmt
- ( layoutStmt
- )
-where
-
-
-
-#include "prelude.inc"
-
-import Language.Haskell.Brittany.Internal.Types
-import Language.Haskell.Brittany.Internal.LayouterBasics
-
-import GHC ( runGhc, GenLocated(L), moduleNameString )
-#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
-import GHC.Hs
-#else
-import HsSyn
-#endif
-import Name
-import qualified FastString
-import BasicTypes
-
-
-
-layoutStmt :: ToBriDoc' (StmtLR GhcPs GhcPs (LHsExpr GhcPs))
diff --git a/src/Language/Haskell/Brittany/Internal/Prelude.hs b/src/Language/Haskell/Brittany/Internal/Prelude.hs
deleted file mode 100644
index b33e339..0000000
--- a/src/Language/Haskell/Brittany/Internal/Prelude.hs
+++ /dev/null
@@ -1,413 +0,0 @@
-module Language.Haskell.Brittany.Internal.Prelude
- ( module E
- , module Language.Haskell.Brittany.Internal.Prelude
- )
-where
-
-
-
--- rather project-specific stuff:
----------------------------------
-#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
-import GHC.Hs.Extension as E ( GhcPs )
-#else
-import HsExtension as E ( GhcPs )
-#endif /* ghc-8.10.1 */
-
-import RdrName as E ( RdrName )
-#if MIN_VERSION_ghc(8,8,0)
-import qualified GHC ( dL, HasSrcSpan, SrcSpanLess )
-#endif
-import qualified GHC ( Located )
-
-
--- more general:
-----------------
-
-import Data.Functor.Identity as E ( Identity(..) )
-import Control.Concurrent.Chan as E ( Chan )
-import Control.Concurrent.MVar as E ( MVar )
-import Data.Int as E ( Int )
-import Data.Word as E ( Word )
-import Prelude as E ( Integer
- , Float
- , Double
- )
-import Control.Monad.ST as E ( ST )
-import Data.Bool as E ( Bool(..) )
-import Data.Char as E ( Char )
-import Data.Either as E ( Either(..) )
-import Data.IORef as E ( IORef )
-import Data.Maybe as E ( Maybe(..) )
-import Data.Semigroup as E ( Option(..) )
-import Data.Monoid as E ( Endo(..)
- , All(..)
- , Any(..)
- , Sum(..)
- , Product(..)
- , Alt(..)
- )
-import Data.Ord as E ( Ordering(..)
- , Down(..)
- )
-import Data.Ratio as E ( Ratio
- , Rational
- )
-import Data.String as E ( String )
-import Data.Void as E ( Void )
-import System.IO as E ( IO )
-import Data.Proxy as E ( Proxy(..) )
-import Data.Sequence as E ( Seq )
-
-import Data.Map as E ( Map )
-import Data.Set as E ( Set )
-
-import Data.Text as E ( Text )
-
-import Prelude as E ( Char
- , String
- , Int
- , Integer
- , Float
- , Double
- , Bool (..)
- , undefined
- , Eq (..)
- , Ord (..)
- , Enum (..)
- , Bounded (..)
- , Maybe (..)
- , Either (..)
- , IO
- , (<$>)
- , (.)
- , ($)
- , ($!)
- , Num (..)
- , Integral (..)
- , Fractional (..)
- , Floating (..)
- , RealFrac (..)
- , RealFloat (..)
- , fromIntegral
- , error
- , foldr
- , foldl
- , foldr1
- , id
- , map
- , subtract
- , putStrLn
- , putStr
- , Show (..)
- , print
- , fst
- , snd
- , (++)
- , not
- , (&&)
- , (||)
- , curry
- , uncurry
- , Ordering (..)
- , flip
- , const
- , seq
- , reverse
- , otherwise
- , traverse
- , realToFrac
- , or
- , and
- , head
- , any
- , (^)
- , Foldable
- , Traversable
- )
-
-import Data.Function as E ( fix
- )
-
-import Data.Foldable as E ( foldl'
- , foldr'
- , fold
- , asum
- )
-
-import Data.List as E ( partition
- , null
- , elem
- , notElem
- , minimum
- , maximum
- , length
- , all
- , take
- , drop
- , find
- , sum
- , zip
- , zip3
- , zipWith
- , repeat
- , replicate
- , iterate
- , nub
- , filter
- , intersperse
- , intercalate
- , isSuffixOf
- , isPrefixOf
- , dropWhile
- , takeWhile
- , unzip
- , break
- , transpose
- , sortBy
- , mapAccumL
- , mapAccumR
- , uncons
- )
-
-import Data.List.NonEmpty as E ( NonEmpty(..)
- , nonEmpty
- )
-
-import Data.Tuple as E ( swap
- )
-
-import Data.Char as E ( ord
- , chr
- )
-
-import Data.Maybe as E ( fromMaybe
- , maybe
- , listToMaybe
- , maybeToList
- , catMaybes
- )
-
-import Data.Word as E ( Word32
- )
-
-import Data.Ord as E ( comparing
- , Down (..)
- )
-
-import Data.Either as E ( either
- )
-
-import Data.Ratio as E ( Ratio
- , (%)
- , numerator
- , denominator
- )
-
-import Text.Read as E ( readMaybe
- )
-
-import Control.Monad as E ( Functor (..)
- , Monad (..)
- , MonadPlus (..)
- , mapM
- , mapM_
- , forM
- , forM_
- , sequence
- , sequence_
- , (=<<)
- , (>=>)
- , (<=<)
- , forever
- , void
- , join
- , replicateM
- , replicateM_
- , guard
- , when
- , unless
- , liftM
- , liftM2
- , liftM3
- , liftM4
- , liftM5
- , filterM
- , (<$!>)
- )
-
-import Control.Applicative as E ( Applicative (..)
- , Alternative (..)
- )
-
-import Foreign.Storable as E ( Storable )
-import GHC.Exts as E ( Constraint )
-
-import Control.Concurrent as E ( threadDelay
- , forkIO
- , forkOS
- )
-
-import Control.Concurrent.MVar as E ( MVar
- , newEmptyMVar
- , newMVar
- , putMVar
- , readMVar
- , takeMVar
- , swapMVar
- )
-
-import Control.Exception as E ( evaluate
- , bracket
- , assert
- )
-
-import Debug.Trace as E ( trace
- , traceId
- , traceShowId
- , traceShow
- , traceStack
- , traceShowId
- , traceIO
- , traceM
- , traceShowM
- )
-
-import Foreign.ForeignPtr as E ( ForeignPtr
- )
-
-import Data.Monoid as E ( mconcat
- , Monoid (..)
- )
-
-import Data.Bifunctor as E ( bimap )
-import Data.Functor as E ( (<$), ($>) )
-import Data.Function as E ( (&) )
-import Data.Semigroup as E ( (<>)
- , Semigroup(..)
- )
-import System.IO as E ( hFlush
- , stdout
- )
-
-import Data.Typeable as E ( Typeable
- )
-
-import Control.Arrow as E ( first
- , second
- , (***)
- , (&&&)
- , (>>>)
- , (<<<)
- )
-
-import Data.Functor.Identity as E ( Identity (..)
- )
-
-import Data.Proxy as E ( Proxy (..)
- )
-
-import Data.Version as E ( showVersion
- )
-
-import Data.List.Extra as E ( nubOrd
- , stripSuffix
- )
-import Control.Monad.Extra as E ( whenM
- , unlessM
- , ifM
- , notM
- , orM
- , andM
- , anyM
- , allM
- )
-
-import Data.Tree as E ( Tree(..)
- )
-
-import Control.Monad.Trans.MultiRWS as E ( -- MultiRWST (..)
- -- , MultiRWSTNull
- -- , MultiRWS
- -- ,
- MonadMultiReader(..)
- , MonadMultiWriter(..)
- , MonadMultiState(..)
- , mGet
- -- , runMultiRWST
- -- , runMultiRWSTASW
- -- , runMultiRWSTW
- -- , runMultiRWSTAW
- -- , runMultiRWSTSW
- -- , runMultiRWSTNil
- -- , runMultiRWSTNil_
- -- , withMultiReader
- -- , withMultiReader_
- -- , withMultiReaders
- -- , withMultiReaders_
- -- , withMultiWriter
- -- , withMultiWriterAW
- -- , withMultiWriterWA
- -- , withMultiWriterW
- -- , withMultiWriters
- -- , withMultiWritersAW
- -- , withMultiWritersWA
- -- , withMultiWritersW
- -- , withMultiState
- -- , withMultiStateAS
- -- , withMultiStateSA
- -- , withMultiStateA
- -- , withMultiStateS
- -- , withMultiState_
- -- , withMultiStates
- -- , withMultiStatesAS
- -- , withMultiStatesSA
- -- , withMultiStatesA
- -- , withMultiStatesS
- -- , withMultiStates_
- -- , inflateReader
- -- , inflateMultiReader
- -- , inflateWriter
- -- , inflateMultiWriter
- -- , inflateState
- -- , inflateMultiState
- -- , mapMultiRWST
- -- , mGetRawR
- -- , mGetRawW
- -- , mGetRawS
- -- , mPutRawR
- -- , mPutRawW
- -- , mPutRawS
- )
-
-import Control.Monad.Trans.MultiReader ( runMultiReaderTNil
- , runMultiReaderTNil_
- , MultiReaderT (..)
- , MultiReader
- , MultiReaderTNull
- )
-
-import Data.Text as E ( Text )
-
-import Control.Monad.IO.Class as E ( MonadIO (..)
- )
-
-import Control.Monad.Trans.Class as E ( lift
- )
-import Control.Monad.Trans.Maybe as E ( MaybeT (..)
- )
-
-import Data.Data as E ( toConstr
- )
-
-todo :: a
-todo = error "todo"
-
-
-#if MIN_VERSION_ghc(8,8,0)
-ghcDL :: GHC.HasSrcSpan a => a -> GHC.Located (GHC.SrcSpanLess a)
-ghcDL = GHC.dL
-#else /* ghc-8.6 */
-ghcDL :: GHC.Located a -> GHC.Located a
-ghcDL x = x
-#endif
diff --git a/srcinc/prelude.inc b/srcinc/prelude.inc
deleted file mode 100644
index 81ca53a..0000000
--- a/srcinc/prelude.inc
+++ /dev/null
@@ -1,147 +0,0 @@
-import qualified Data.ByteString
--- import qualified Data.ByteString.Builder
--- import qualified Data.ByteString.Builder.Extra
--- import qualified Data.ByteString.Builder.Prim
-import qualified Data.ByteString.Char8
--- import qualified Data.ByteString.Lazy.Builder
--- import qualified Data.ByteString.Lazy.Builder.ASCII
--- import qualified Data.ByteString.Lazy.Builder.Extras
--- import qualified Data.ByteString.Lazy.Char8
--- import qualified Data.ByteString.Lazy
--- import qualified Data.ByteString.Short
--- import qualified Data.ByteString.Unsafe
-
--- import qualified Data.Graph
--- import qualified Data.IntMap
--- import qualified Data.IntMap.Lazy
--- import qualified Data.IntMap.Strict
--- import qualified Data.IntSet
--- import qualified Data.Map
--- import qualified Data.Map.Lazy
--- import qualified Data.Map.Strict
--- import qualified Data.Sequence
--- import qualified Data.Set
--- import qualified Data.Tree
-
-import qualified System.Directory
-
--- import qualified Control.Concurrent.Extra
--- import qualified Control.Exception.Extra
--- import qualified Control.Monad.Extra
--- import qualified Data.Either.Extra
--- import qualified Data.IORef.Extra
-import qualified Data.List.Extra
--- import qualified Data.Tuple.Extra
--- import qualified Data.Version.Extra
--- import qualified Numeric.Extra
--- import qualified System.Directory.Extra
--- import qualified System.Environment.Extra
--- import qualified System.IO.Extra
--- import qualified System.Info.Extra
--- import qualified System.Process.Extra
--- import qualified System.Time.Extra
-
--- import qualified Control.Monad.Trans.MultiRWS.Lazy
--- import qualified Control.Monad.Trans.MultiRWS.Strict
--- import qualified Control.Monad.Trans.MultiReader
--- import qualified Control.Monad.Trans.MultiReader.Class
--- import qualified Control.Monad.Trans.MultiReader.Lazy
--- import qualified Control.Monad.Trans.MultiReader.Strict
--- import qualified Control.Monad.Trans.MultiState
--- import qualified Control.Monad.Trans.MultiState.Class
--- import qualified Control.Monad.Trans.MultiState.Lazy
--- import qualified Control.Monad.Trans.MultiState.Strict
--- import qualified Control.Monad.Trans.MultiWriter
--- import qualified Control.Monad.Trans.MultiWriter.Class
--- import qualified Control.Monad.Trans.MultiWriter.Lazy
--- import qualified Control.Monad.Trans.MultiWriter.Strict
-
-import qualified Control.Monad.Trans.MultiRWS.Strict as MultiRWSS
-import qualified Control.Monad.Trans.MultiRWS.Lazy as MultiRWSL
-
-import qualified Text.PrettyPrint
-
-import qualified Text.PrettyPrint.Annotated
-import qualified Text.PrettyPrint.Annotated.HughesPJ
-import qualified Text.PrettyPrint.Annotated.HughesPJClass
-
--- import qualified Text.PrettyPrint.HughesPJ
--- import qualified Text.PrettyPrint.HughesPJClass
-
--- import qualified Data.Text
--- import qualified Data.Text.Array
--- import qualified Data.Text.Encoding
--- import qualified Data.Text.Encoding.Error
--- import qualified Data.Text.Foreign
--- import qualified Data.Text.IO
--- import qualified Data.Text.Lazy
--- import qualified Data.Text.Lazy.Builder
-
--- import qualified Data.Bifunctor
--- import qualified Data.Bits
--- import qualified Data.Bool
--- import qualified Data.Char
-import qualified Data.Coerce
--- import qualified Data.Complex
-import qualified Data.Data
--- import qualified Data.Dynamic
-import qualified Data.Either
--- import qualified Data.Eq
--- import qualified Data.Fixed
-import qualified Data.Foldable
--- import qualified Data.Function
--- import qualified Data.Functor
--- import qualified Data.Functor.Identity
--- import qualified Data.IORef
--- import qualified Data.Int
--- import qualified Data.Ix
--- import qualified Data.List
-import qualified Data.Maybe
--- import qualified Data.Monoid
--- import qualified Data.Ord
--- import qualified Data.Proxy
--- import qualified Debug.Trace
--- import qualified Numeric
--- import qualified Numeric.Natural
-import qualified System.IO
--- import qualified Unsafe.Coerce
-
-import qualified Data.Bool as Bool
-import qualified Data.Foldable as Foldable
-import qualified GHC.OldList as List
-
-import qualified Data.Semigroup as Semigroup
-
-import qualified Data.ByteString as ByteString
-import qualified Data.ByteString.Lazy as ByteStringL
-
-import qualified Data.IntMap.Lazy as IntMapL
-import qualified Data.IntMap.Strict as IntMapS
-import qualified Data.Map as Map
-import qualified Data.Sequence as Seq
-import qualified Data.Set as Set
-
-import qualified Control.Monad.RWS.Class as RWS.Class
-import qualified Control.Monad.Reader.Class as Reader.Class
-import qualified Control.Monad.State.Class as State.Class
-import qualified Control.Monad.Writer.Class as Writer.Class
-
-import qualified Data.Text as Text
-import qualified Data.Text.Encoding as Text.Encoding
-import qualified Data.Text.IO as Text.IO
-import qualified Data.Text.Lazy as TextL
-import qualified Data.Text.Lazy.Encoding as TextL.Encoding
-import qualified Data.Text.Lazy.IO as TextL.IO
-
-import qualified Control.Monad.Trans.State as State
-import qualified Control.Monad.Trans.State.Lazy as StateL
-import qualified Control.Monad.Trans.State.Strict as StateS
-import qualified Control.Monad.Trans.Except as ExceptT
-
-import qualified Data.Strict.Maybe as Strict
-
-import qualified Safe as Safe
-
-
-import Language.Haskell.Brittany.Internal.Prelude
-import Language.Haskell.Brittany.Internal.PreludeUtils
diff --git a/stack-8.6.5.yaml b/stack-8.6.5.yaml
deleted file mode 100644
index 785b146..0000000
--- a/stack-8.6.5.yaml
+++ /dev/null
@@ -1 +0,0 @@
-resolver: lts-14.27
diff --git a/stack-8.6.5.yaml.lock b/stack-8.6.5.yaml.lock
deleted file mode 100644
index e24dcac..0000000
--- a/stack-8.6.5.yaml.lock
+++ /dev/null
@@ -1,12 +0,0 @@
-# This file was autogenerated by Stack.
-# You should not edit this file by hand.
-# For more information, please see the documentation at:
-# https://docs.haskellstack.org/en/stable/lock_files
-
-packages: []
-snapshots:
-- completed:
- size: 524996
- url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/14/27.yaml
- sha256: 7ea31a280c56bf36ff591a7397cc384d0dff622e7f9e4225b47d8980f019a0f0
- original: lts-14.27
diff --git a/stack-8.8.4.yaml b/stack-8.8.4.yaml
deleted file mode 100644
index d014f95..0000000
--- a/stack-8.8.4.yaml
+++ /dev/null
@@ -1 +0,0 @@
-resolver: lts-16.25
diff --git a/stack-8.8.4.yaml.lock b/stack-8.8.4.yaml.lock
deleted file mode 100644
index 31befa1..0000000
--- a/stack-8.8.4.yaml.lock
+++ /dev/null
@@ -1,12 +0,0 @@
-# This file was autogenerated by Stack.
-# You should not edit this file by hand.
-# For more information, please see the documentation at:
-# https://docs.haskellstack.org/en/stable/lock_files
-
-packages: []
-snapshots:
-- completed:
- size: 533252
- url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/16/25.yaml
- sha256: 147598b98bdd95ec0409bac125a4f1bff3cd4f8d73334d283d098f66a4bcc053
- original: lts-16.25
diff --git a/stack.yaml b/stack.yaml
deleted file mode 100644
index 9989a09..0000000
--- a/stack.yaml
+++ /dev/null
@@ -1,4 +0,0 @@
-resolver: nightly-2020-12-09
-
-extra-deps:
- - data-tree-print-0.1.0.2
diff --git a/stack.yaml.lock b/stack.yaml.lock
deleted file mode 100644
index 91c9355..0000000
--- a/stack.yaml.lock
+++ /dev/null
@@ -1,19 +0,0 @@
-# This file was autogenerated by Stack.
-# You should not edit this file by hand.
-# For more information, please see the documentation at:
-# https://docs.haskellstack.org/en/stable/lock_files
-
-packages:
-- completed:
- hackage: data-tree-print-0.1.0.2@sha256:d845e99f322df70e0c06d6743bf80336f5918d5423498528beb0593a2afc1703,1620
- pantry-tree:
- size: 272
- sha256: b8778eb1b16fddb91b2eed2b25f33a89d1e4f7a533160de4ccbf226f82456135
- original:
- hackage: data-tree-print-0.1.0.2
-snapshots:
-- completed:
- size: 556768
- url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/nightly/2020/12/9.yaml
- sha256: bca31ebf05f842be9dd24410eca84f296da1860369a82eb7466f447a76cca762
- original: nightly-2020-12-09