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 '' --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 . . If you are interested in the implementation, have a look at ; . The implementation is documented in more detail . -} -license: AGPL-3 +license: AGPL-3.0-only license-file: LICENSE author: Lennart Spitzner maintainer: Lennart Spitzner @@ -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 - -import Aaa -import Baa - -#test sorted-qualified-imports -import Boo -import qualified Zoo - -#test imports-groups-same-module -import Boo ( a ) - -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 "" - , _ <- 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