diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 91a978c14..057d2f134 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -12,7 +12,7 @@ jobs: strategy: fail-fast: false matrix: - ghc: [ghc928, ghc945, ghc962] + ghc: [ghc947, ghc962] name: Build and test on ${{ matrix.ghc }} runs-on: ubuntu-latest steps: diff --git a/CHANGELOG.md b/CHANGELOG.md index 5c9288a9c..e68d581d1 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,11 @@ +## Unreleased + +* Switched to `ghc-lib-parser-9.8`, with the following new syntactic features: + * `ExtendedLiterals`: `123#Int8` is of type `Int8#`. (disabled by default) + * `TypeAbstractions`: `@k`-binders in type decls (enabled by default) + * GHC proposal #134: deprecating/warning about exports + * GHC proposal #541: warning categories + ## Ormolu 0.7.2.0 * Preserve necessary braces for final function arguments. [Issue diff --git a/cabal.project b/cabal.project index 34579c52d..42c6ae757 100644 --- a/cabal.project +++ b/cabal.project @@ -1,3 +1,10 @@ packages: . extract-hackage-info constraints: ormolu +dev + +source-repository-package + type: git + location: https://github.com/amesgen/stuff + tag: cbd90acce362281be73279c0b5482a6f12922f83 + subdir: ghc-lib-parser-9.8.1-alpha4 + --sha256: sha256-WmOgZBFWYIOpPfGju+Oox+FehzxfeUCuV24lWab1JKc= diff --git a/data/examples/declaration/data/invisible-binders-out.hs b/data/examples/declaration/data/invisible-binders-out.hs new file mode 100644 index 000000000..fde7890ad --- /dev/null +++ b/data/examples/declaration/data/invisible-binders-out.hs @@ -0,0 +1,2 @@ +type T :: forall k. k -> forall j. j -> Type +data T @k (a :: k) @(j :: Type) (b :: j) diff --git a/data/examples/declaration/data/invisible-binders.hs b/data/examples/declaration/data/invisible-binders.hs new file mode 100644 index 000000000..fde7890ad --- /dev/null +++ b/data/examples/declaration/data/invisible-binders.hs @@ -0,0 +1,2 @@ +type T :: forall k. k -> forall j. j -> Type +data T @k (a :: k) @(j :: Type) (b :: j) diff --git a/data/examples/declaration/value/function/primitive-literals-out.hs b/data/examples/declaration/value/function/primitive-literals-out.hs new file mode 100644 index 000000000..5ef2fef2e --- /dev/null +++ b/data/examples/declaration/value/function/primitive-literals-out.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE ExtendedLiterals #-} +{-# LANGUAGE MagicHash #-} + +foo = 1# + +bar = 2## + +baz = 3#Word32 + +baz = 0b1010#Int64 diff --git a/data/examples/declaration/value/function/primitive-literals.hs b/data/examples/declaration/value/function/primitive-literals.hs new file mode 100644 index 000000000..56e04d316 --- /dev/null +++ b/data/examples/declaration/value/function/primitive-literals.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE ExtendedLiterals, MagicHash #-} + +foo = 1# + +bar = 2## + +baz = 3#Word32 + +baz = 0b1010#Int64 diff --git a/data/examples/declaration/warning/warning-single-line-out.hs b/data/examples/declaration/warning/warning-single-line-out.hs index 1d7929b6a..a16893085 100644 --- a/data/examples/declaration/warning/warning-single-line-out.hs +++ b/data/examples/declaration/warning/warning-single-line-out.hs @@ -11,3 +11,6 @@ baz = 5 data Number = Number Dobule {-# DEPRECATED Number "Use Scientific instead." #-} + +head (a : _) = a +{-# WARNING in "x-partial" head "This function is partial..." #-} diff --git a/data/examples/declaration/warning/warning-single-line.hs b/data/examples/declaration/warning/warning-single-line.hs index 3e20bf275..a029076bc 100644 --- a/data/examples/declaration/warning/warning-single-line.hs +++ b/data/examples/declaration/warning/warning-single-line.hs @@ -13,3 +13,6 @@ baz = 5 data Number = Number Dobule {-# DEPRECATED Number "Use Scientific instead." #-} + +head (a:_) = a +{-# WARNING in "x-partial" head "This function is partial..." #-} diff --git a/data/examples/import/deprecated-export-multi-line-out.hs b/data/examples/import/deprecated-export-multi-line-out.hs new file mode 100644 index 000000000..1e001ca42 --- /dev/null +++ b/data/examples/import/deprecated-export-multi-line-out.hs @@ -0,0 +1,7 @@ +module X + ( {-# DEPRECATE D(D1) "D1 will not be exposed in a version 0.2 and later" #-} + D (D1, D2), + ) +where + +data D = D1 | D2 diff --git a/data/examples/import/deprecated-export-multi-line.hs b/data/examples/import/deprecated-export-multi-line.hs new file mode 100644 index 000000000..174ccdb96 --- /dev/null +++ b/data/examples/import/deprecated-export-multi-line.hs @@ -0,0 +1,5 @@ +module X + ( {-# DEPRECATE D(D1) "D1 will not be exposed in a version 0.2 and later" #-} + D(D1, D2) + ) where +data D = D1 | D2 diff --git a/data/examples/import/deprecated-export-single-line-out.hs b/data/examples/import/deprecated-export-single-line-out.hs new file mode 100644 index 000000000..abf5004a7 --- /dev/null +++ b/data/examples/import/deprecated-export-single-line-out.hs @@ -0,0 +1,3 @@ +module A ({-# DEPRECATED "blah" #-} x) where + +x = True diff --git a/data/examples/import/deprecated-export-single-line.hs b/data/examples/import/deprecated-export-single-line.hs new file mode 100644 index 000000000..45d8691b1 --- /dev/null +++ b/data/examples/import/deprecated-export-single-line.hs @@ -0,0 +1 @@ +module A ( {-# DEPRECATED "blah" #-} x ) where { x = True } diff --git a/extract-hackage-info/extract-hackage-info.cabal b/extract-hackage-info/extract-hackage-info.cabal index d2f2f3655..4d7ae1e18 100644 --- a/extract-hackage-info/extract-hackage-info.cabal +++ b/extract-hackage-info/extract-hackage-info.cabal @@ -23,6 +23,3 @@ executable extract-hackage-info text >=2.0 && <3.0, formatting >=7.1 && <7.3, megaparsec >=9.0 - - if !impl(ghc >=9.2 && <9.3) - buildable: False diff --git a/flake.lock b/flake.lock index ee1e103d8..10ace42dd 100644 --- a/flake.lock +++ b/flake.lock @@ -177,11 +177,11 @@ "systems": "systems" }, "locked": { - "lastModified": 1689068808, - "narHash": "sha256-6ixXo3wt24N/melDWjq70UuHQLxGV8jZvooRanIHXw0=", + "lastModified": 1694529238, + "narHash": "sha256-zsNZZGTGnMOf9YpHKJqMSsa0dXbfmxeoJ7xHlrt+xmY=", "owner": "numtide", "repo": "flake-utils", - "rev": "919d646de7be200f3bf08cb76ae1f09402b6f9b4", + "rev": "ff7b65b44d01cf9ba6a71320833626af21126384", "type": "github" }, "original": { @@ -191,17 +191,19 @@ } }, "flake-utils_2": { + "inputs": { + "systems": "systems_2" + }, "locked": { - "lastModified": 1679360468, - "narHash": "sha256-LGnza3cfXF10Biw3ZTg0u9o9t7s680Ww200t5KkHTh8=", - "owner": "hamishmack", + "lastModified": 1692799911, + "narHash": "sha256-3eihraek4qL744EvQXsK1Ha6C3CR7nnT8X2qWap4RNk=", + "owner": "numtide", "repo": "flake-utils", - "rev": "e1ea268ff47ad475443dbabcd54744b4e5b9d4f5", + "rev": "f9e7cf818399d17d347f847525c5a5a8032e4e44", "type": "github" }, "original": { - "owner": "hamishmack", - "ref": "hkm/nested-hydraJobs", + "owner": "numtide", "repo": "flake-utils", "type": "github" } @@ -270,16 +272,16 @@ }, "ghc-wasm-meta": { "inputs": { - "flake-utils": "flake-utils", + "flake-utils": "flake-utils_2", "nixpkgs": "nixpkgs" }, "locked": { "host": "gitlab.haskell.org", - "lastModified": 1693212235, - "narHash": "sha256-N3zIrWxMV+eE/gCkUw/GzM3RyX8kkxLAwsWLHDip9hA=", + "lastModified": 1694984505, + "narHash": "sha256-VzLYF8duu7b4uWcfAYqLkCwtanK6xGmDQMX6caEOyKc=", "owner": "ghc", "repo": "ghc-wasm-meta", - "rev": "28ee3192f8be23761cfa6f89b2656bfef763c028", + "rev": "414bbf6585982d5dc43a5c78af49b2561d8f6d68", "type": "gitlab" }, "original": { @@ -289,6 +291,43 @@ "type": "gitlab" } }, + "ghc980": { + "flake": false, + "locked": { + "lastModified": 1692910316, + "narHash": "sha256-Qv8I3GzzIIN32RTEKI38BW5nO1f7j6Xm+dDeDUyYZWo=", + "ref": "ghc-9.8", + "rev": "249aa8193e4c5c1ee46ce29b39d2fffa57de7904", + "revCount": 61566, + "submodules": true, + "type": "git", + "url": "https://gitlab.haskell.org/ghc/ghc" + }, + "original": { + "ref": "ghc-9.8", + "submodules": true, + "type": "git", + "url": "https://gitlab.haskell.org/ghc/ghc" + } + }, + "ghc99": { + "flake": false, + "locked": { + "lastModified": 1693974777, + "narHash": "sha256-r+uFw44X9XVPdDtxylfBuFL+l+5q5cX+vDVT7SCTHB8=", + "ref": "hkm/bump-Cabal", + "rev": "b2bddd0b8214ac1db6239cc25f7c0aabeb2ebb70", + "revCount": 61879, + "submodules": true, + "type": "git", + "url": "https://gitlab.haskell.org/hamishmack/ghc" + }, + "original": { + "submodules": true, + "type": "git", + "url": "https://gitlab.haskell.org/ghc/ghc" + } + }, "gitignore": { "inputs": { "nixpkgs": [ @@ -313,11 +352,11 @@ "hackage": { "flake": false, "locked": { - "lastModified": 1692231735, - "narHash": "sha256-75jxGw+Mzt/2OzTz9gRb5LPwysq76JyNMBjDzMTAdXE=", + "lastModified": 1695169363, + "narHash": "sha256-Mc9tcDfjEZtBPd8Tu1sJgweKRBhLGxyIHyiQpBzd6dQ=", "owner": "input-output-hk", "repo": "hackage.nix", - "rev": "7624c4239624ba595c41b81e05aa147c86cd8235", + "rev": "2dd74facdd8b3accacb69d5299ebed6d0202695d", "type": "github" }, "original": { @@ -334,11 +373,13 @@ "cabal-36": "cabal-36", "cardano-shell": "cardano-shell", "flake-compat": "flake-compat", - "flake-utils": "flake-utils_2", "ghc-8.6.5-iohk": "ghc-8.6.5-iohk", + "ghc980": "ghc980", + "ghc99": "ghc99", "hackage": "hackage", "hls-1.10": "hls-1.10", "hls-2.0": "hls-2.0", + "hls-2.2": "hls-2.2", "hpc-coveralls": "hpc-coveralls", "hydra": "hydra", "iserv-proxy": "iserv-proxy", @@ -357,11 +398,11 @@ "stackage": "stackage" }, "locked": { - "lastModified": 1692254824, - "narHash": "sha256-U18N6WYvVidlKBZjt61QsIK/PLccmM2Gv6BSJgr3uqE=", + "lastModified": 1695206781, + "narHash": "sha256-yTWw9uDmjNF8iFciGJzaKUu4pyY8L9Mv4m9g9rBHPkA=", "owner": "input-output-hk", "repo": "haskell.nix", - "rev": "0ad4dcb7286ec71fbf3b90626758bf67772a408c", + "rev": "d7b8a32fdeeb009f6c908987cba8298df497c4e1", "type": "github" }, "original": { @@ -404,6 +445,23 @@ "type": "github" } }, + "hls-2.2": { + "flake": false, + "locked": { + "lastModified": 1693064058, + "narHash": "sha256-8DGIyz5GjuCFmohY6Fa79hHA/p1iIqubfJUTGQElbNk=", + "owner": "haskell", + "repo": "haskell-language-server", + "rev": "b30f4b6cf5822f3112c35d14a0cba51f3fe23b85", + "type": "github" + }, + "original": { + "owner": "haskell", + "ref": "2.2.0.0", + "repo": "haskell-language-server", + "type": "github" + } + }, "hpc-coveralls": { "flake": false, "locked": { @@ -446,11 +504,11 @@ "iserv-proxy": { "flake": false, "locked": { - "lastModified": 1688517130, - "narHash": "sha256-hUqfxSlo+ffqVdkSZ1EDoB7/ILCL25eYkcCXW9/P3Wc=", + "lastModified": 1691634696, + "narHash": "sha256-MZH2NznKC/gbgBu8NgIibtSUZeJ00HTLJ0PlWKCBHb0=", "ref": "hkm/remote-iserv", - "rev": "9151db2a9a61d7f5fe52ff8836f18bbd0fd8933c", - "revCount": 13, + "rev": "43a979272d9addc29fbffc2e8542c5d96e993d73", + "revCount": 14, "type": "git", "url": "https://gitlab.haskell.org/hamishmack/iserv-proxy.git" }, @@ -549,11 +607,11 @@ }, "nixpkgs": { "locked": { - "lastModified": 1691371061, - "narHash": "sha256-BxPbPVlBIoneaXIBiHd0LVzA+L4nmvFCNBU6TmQAiMM=", + "lastModified": 1694343207, + "narHash": "sha256-jWi7OwFxU5Owi4k2JmiL1sa/OuBCQtpaAesuj5LXC8w=", "owner": "NixOS", "repo": "nixpkgs", - "rev": "5068bc8fe943bde3c446326da8d0ca9c93d5a682", + "rev": "78058d810644f5ed276804ce7ea9e82d92bee293", "type": "github" }, "original": { @@ -677,16 +735,16 @@ }, "nixpkgs-stable": { "locked": { - "lastModified": 1673800717, - "narHash": "sha256-SFHraUqLSu5cC6IxTprex/nTsI81ZQAtDvlBvGDWfnA=", + "lastModified": 1685801374, + "narHash": "sha256-otaSUoFEMM+LjBI1XL/xGB5ao6IwnZOXc47qhIgJe8U=", "owner": "NixOS", "repo": "nixpkgs", - "rev": "2f9fd351ec37f5d479556cd48be4ca340da59b8f", + "rev": "c37ca420157f4abc31e26f436c1145f8951ff373", "type": "github" }, "original": { "owner": "NixOS", - "ref": "nixos-22.11", + "ref": "nixos-23.05", "repo": "nixpkgs", "type": "github" } @@ -844,11 +902,11 @@ "nixpkgs-stable": "nixpkgs-stable" }, "locked": { - "lastModified": 1678376203, - "narHash": "sha256-3tyYGyC8h7fBwncLZy5nCUjTJPrHbmNwp47LlNLOHSM=", + "lastModified": 1694364351, + "narHash": "sha256-oadhSCqopYXxURwIA6/Anpe5IAG11q2LhvTJNP5zE6o=", "owner": "cachix", "repo": "pre-commit-hooks.nix", - "rev": "1a20b9708962096ec2481eeb2ddca29ed747770a", + "rev": "4f883a76282bc28eb952570afc3d8a1bf6f481d7", "type": "github" }, "original": { @@ -865,11 +923,11 @@ "utils": "utils_2" }, "locked": { - "lastModified": 1675987041, - "narHash": "sha256-0aHIrngBLXO95SH+PjyTWJ7LWoFdJtx8y6oSln0l5Ak=", + "lastModified": 1691537451, + "narHash": "sha256-9dnX6E7eWVm8xhHDeA3AmkvhqcWRo6RJ4z6Vrn65cFs=", "owner": "purs-nix", "repo": "purescript-tools", - "rev": "7929148939325f1fed916884c53cad3c0dfa4be7", + "rev": "675cd35bc9255f9c2b1f6f6784ef41b9773202e8", "type": "github" }, "original": { @@ -891,11 +949,11 @@ "utils": "utils_3" }, "locked": { - "lastModified": 1677820987, - "narHash": "sha256-5lrWnpC39a0M9VL7GzP88K+bTzAZP9AjLNQpbtsfuUw=", + "lastModified": 1691603627, + "narHash": "sha256-bsJh6PCDF9+hSuk/dbTtSXdma0VvjFejN6weHPt7cyU=", "owner": "purs-nix", "repo": "purs-nix", - "rev": "e5af208563a8e66f8a78f3b5aeaacea9074bcd27", + "rev": "8729b7fbb02822df3fb3988bae94b276e50ca6fc", "type": "github" }, "original": { @@ -907,10 +965,7 @@ }, "root": { "inputs": { - "flake-utils": [ - "haskellNix", - "flake-utils" - ], + "flake-utils": "flake-utils", "ghc-wasm-meta": "ghc-wasm-meta", "haskellNix": "haskellNix", "nixpkgs": [ @@ -946,11 +1001,11 @@ "stackage": { "flake": false, "locked": { - "lastModified": 1692230916, - "narHash": "sha256-Mm1nPNVgZl8Rdcs/A1cliBQTlzqx1Wv1tMjr9zEwlCE=", + "lastModified": 1630400035, + "narHash": "sha256-MWaVOCzuFwp09wZIW9iHq5wWen5C69I940N1swZLEQ0=", "owner": "input-output-hk", - "repo": "stackage.nix", - "rev": "cfbafab66ac72fd00d69122d95491fdb78c57b78", + "repo": "empty-flake", + "rev": "2040a05b67bf9a669ce17eca56beb14b4206a99a", "type": "github" }, "original": { @@ -974,6 +1029,21 @@ "type": "github" } }, + "systems_2": { + "locked": { + "lastModified": 1681028828, + "narHash": "sha256-Vy1rq5AaRuLzOxct8nz4T6wlgyUR7zLU309k9mBC768=", + "owner": "nix-systems", + "repo": "default", + "rev": "da67096a3b9bf56a91d16901293e51ba5b49a27e", + "type": "github" + }, + "original": { + "owner": "nix-systems", + "repo": "default", + "type": "github" + } + }, "utils": { "locked": { "lastModified": 1653893745, diff --git a/flake.nix b/flake.nix index f899a06e6..4c5cf7aea 100644 --- a/flake.nix +++ b/flake.nix @@ -1,8 +1,12 @@ { inputs = { - haskellNix.url = "github:input-output-hk/haskell.nix"; + haskellNix = { + url = "github:input-output-hk/haskell.nix"; + # prevent nix-direnv from fetching stackage + inputs.stackage.url = "github:input-output-hk/empty-flake"; + }; nixpkgs.follows = "haskellNix/nixpkgs-unstable"; - flake-utils.follows = "haskellNix/flake-utils"; + flake-utils.url = "github:numtide/flake-utils"; pre-commit-hooks = { url = "github:cachix/pre-commit-hooks.nix"; inputs.nixpkgs.follows = "nixpkgs"; @@ -32,7 +36,7 @@ inherit (pkgs) lib haskell-nix; inherit (haskell-nix) haskellLib; - ghcVersions = [ "ghc928" "ghc945" "ghc962" ]; + ghcVersions = [ "ghc962" "ghc947" ]; defaultGHCVersion = builtins.head ghcVersions; perGHC = lib.genAttrs ghcVersions (ghcVersion: let @@ -50,6 +54,10 @@ hackageTests = import ./expected-failures { inherit pkgs ormolu; }; regionTests = import ./region-tests { inherit pkgs ormolu; }; fixityTests = import ./fixity-tests { inherit pkgs ormolu; }; + weeder = hsPkgs.tool "weeder" { + version = "2.6.0"; + modules = [{ reinstallableLibGhc = false; }]; + }; packages = lib.recurseIntoAttrs ({ inherit ormolu; ormoluTests = haskellLib.collectChecks' hsPkgs; @@ -57,14 +65,9 @@ } // hackageTests // regionTests // fixityTests // lib.optionalAttrs (ghcVersion == defaultGHCVersion) { inherit (hsPkgs.extract-hackage-info.components.exes) extract-hackage-info; - weeder = pkgs.runCommand - "ormolu-weeder" - { - buildInputs = [ (hsPkgs.tool "weeder" "2.4.0") ]; - } '' + weeder = pkgs.runCommand "ormolu-weeder" { buildInputs = [ weeder ]; } '' mkdir -p $out - export XDG_CACHE_HOME=$TMPDIR/cache - weeder --config ${./weeder.dhall} \ + weeder --config ${./weeder.toml} \ --hie-directory ${hsPkgs.ormolu.components.library.hie} \ --hie-directory ${hsPkgs.ormolu.components.exes.ormolu.hie} \ --hie-directory ${hsPkgs.ormolu.components.tests.tests.hie} \ @@ -154,7 +157,7 @@ tools = { cabal = "latest"; haskell-language-server = { - src = inputs.haskellNix.inputs."hls-2.0"; + src = inputs.haskellNix.inputs."hls-2.2"; configureArgs = "--disable-benchmarks --disable-tests"; }; }; diff --git a/ormolu-live/cabal.project b/ormolu-live/cabal.project index 7b7152507..e68a81826 100644 --- a/ormolu-live/cabal.project +++ b/ormolu-live/cabal.project @@ -11,3 +11,9 @@ package ormolu package ghc-lib-parser -- The WASM backend does not support the threaded RTS. flags: -threaded-rts + +source-repository-package + type: git + location: https://github.com/amesgen/stuff + tag: cbd90acce362281be73279c0b5482a6f12922f83 + subdir: ghc-lib-parser-9.8.1-alpha4 diff --git a/ormolu.cabal b/ormolu.cabal index c504e5244..634618086 100644 --- a/ormolu.cabal +++ b/ormolu.cabal @@ -4,7 +4,7 @@ version: 0.7.2.0 license: BSD-3-Clause license-file: LICENSE.md maintainer: Mark Karpov -tested-with: ghc ==9.2.8 ghc ==9.4.5 ghc ==9.6.2 +tested-with: ghc ==9.4.7 ghc ==9.6.2 homepage: https://github.com/tweag/ormolu bug-reports: https://github.com/tweag/ormolu/issues synopsis: A formatter for Haskell source code @@ -110,7 +110,7 @@ library directory ^>=1.3, file-embed >=0.0.15 && <0.1, filepath >=1.2 && <1.5, - ghc-lib-parser >=9.6 && <9.7, + ghc-lib-parser >=9.8 && <9.9, megaparsec >=9.0, mtl >=2.0 && <3.0, syb >=0.7 && <0.8, @@ -139,7 +139,7 @@ executable ormolu containers >=0.5 && <0.7, directory ^>=1.3, filepath >=1.2 && <1.5, - ghc-lib-parser >=9.6 && <9.7, + ghc-lib-parser >=9.8 && <9.9, optparse-applicative >=0.14 && <0.19, ormolu, text >=2.0 && <3.0, @@ -178,7 +178,7 @@ test-suite tests containers >=0.5 && <0.7, directory ^>=1.3, filepath >=1.2 && <1.5, - ghc-lib-parser >=9.6 && <9.7, + ghc-lib-parser >=9.8 && <9.9, hspec >=2.0 && <3.0, hspec-megaparsec >=2.2, megaparsec >=9.0, diff --git a/src/Ormolu.hs b/src/Ormolu.hs index 486e55fc1..d01311963 100644 --- a/src/Ormolu.hs +++ b/src/Ormolu.hs @@ -46,8 +46,10 @@ import Data.Set qualified as Set import Data.Text (Text) import Data.Text qualified as T import Debug.Trace -import GHC.Driver.CmdLine qualified as GHC +import GHC.Driver.Errors.Types +import GHC.Types.Error import GHC.Types.SrcLoc +import GHC.Utils.Error import Ormolu.Config import Ormolu.Diff.ParseResult import Ormolu.Diff.Text @@ -96,8 +98,9 @@ ormolu cfgWithIndices path originalInput = do (warnings, result0) <- parseModule' cfg fixityMap OrmoluParsingFailed path originalInput when (cfgDebug cfg) $ do - forM_ warnings $ \(GHC.Warn reason (L loc msg)) -> - traceM $ unwords ["*** WARNING ***", showOutputable loc, msg, showOutputable reason] + forM_ warnings $ \driverMsg -> do + let driverMsgSDoc = formatBulleted $ diagnosticMessage defaultOpts driverMsg + traceM $ unwords ["*** WARNING ***", showOutputable driverMsgSDoc] forM_ result0 $ \case ParsedSnippet r -> do let CommentStream comments = prCommentStream r @@ -244,7 +247,7 @@ parseModule' :: FilePath -> -- | Actual input for the parser Text -> - m ([GHC.Warn], [SourceSnippet]) + m (DriverMessages, [SourceSnippet]) parseModule' cfg fixityMap mkException path str = do (warnings, r) <- parseModule cfg fixityMap path str case r of diff --git a/src/Ormolu/Fixity/Imports.hs b/src/Ormolu/Fixity/Imports.hs index 8c4e57824..bb5be97b8 100644 --- a/src/Ormolu/Fixity/Imports.hs +++ b/src/Ormolu/Fixity/Imports.hs @@ -16,7 +16,7 @@ import Data.Map.Strict qualified as Map import Distribution.ModuleName (ModuleName) import Distribution.Types.PackageName import GHC.Data.FastString qualified as GHC -import GHC.Hs hiding (ModuleName) +import GHC.Hs hiding (ModuleName, OpName) import GHC.Types.Name.Occurrence import GHC.Types.PkgQual (RawPkgQual (..)) import GHC.Types.SourceText (StringLiteral (..)) diff --git a/src/Ormolu/Imports.hs b/src/Ormolu/Imports.hs index 0055f1888..9f476015d 100644 --- a/src/Ormolu/Imports.hs +++ b/src/Ormolu/Imports.hs @@ -123,7 +123,7 @@ importId (L _ ImportDecl {..}) = isPrelude = moduleNameString moduleName == "Prelude" moduleName = unLoc ideclName --- | Normalize a collection of import\/export items. +-- | Normalize a collection of import items. normalizeLies :: [LIE GhcPs] -> [LIE GhcPs] normalizeLies = sortOn (getIewn . unLoc) . M.elems . foldl' combine M.empty where @@ -139,21 +139,21 @@ normalizeLies = sortOn (getIewn . unLoc) . M.elems . foldl' combine M.empty Nothing -> Just . L new_l $ case new of IEThingWith _ n wildcard g -> - IEThingWith EpAnnNotUsed n wildcard (normalizeWNames g) + IEThingWith (Nothing, EpAnnNotUsed) n wildcard (normalizeWNames g) other -> other Just old -> let f = \case - IEVar _ n -> IEVar NoExtField n + IEVar _ n -> IEVar Nothing n IEThingAbs _ _ -> new - IEThingAll _ n -> IEThingAll EpAnnNotUsed n + IEThingAll _ n -> IEThingAll (Nothing, EpAnnNotUsed) n IEThingWith _ n wildcard g -> case new of - IEVar NoExtField _ -> + IEVar _ _ -> error "Ormolu.Imports broken presupposition" IEThingAbs _ _ -> - IEThingWith EpAnnNotUsed n wildcard g + IEThingWith (Nothing, EpAnnNotUsed) n wildcard g IEThingAll _ n' -> - IEThingAll EpAnnNotUsed n' + IEThingAll (Nothing, EpAnnNotUsed) n' IEThingWith _ n' wildcard' g' -> let combinedWildcard = case (wildcard, wildcard') of @@ -161,7 +161,7 @@ normalizeLies = sortOn (getIewn . unLoc) . M.elems . foldl' combine M.empty (_, IEWildcard _) -> IEWildcard 0 _ -> NoIEWildcard in IEThingWith - EpAnnNotUsed + (Nothing, EpAnnNotUsed) n' combinedWildcard (normalizeWNames (g <> g')) @@ -187,7 +187,7 @@ instance Ord IEWrappedNameOrd where -- | Project @'IEWrappedName' 'GhcPs'@ from @'IE' 'GhcPs'@. getIewn :: IE GhcPs -> IEWrappedNameOrd getIewn = \case - IEVar NoExtField x -> IEWrappedNameOrd (unLoc x) + IEVar _ x -> IEWrappedNameOrd (unLoc x) IEThingAbs _ x -> IEWrappedNameOrd (unLoc x) IEThingAll _ x -> IEWrappedNameOrd (unLoc x) IEThingWith _ x _ _ -> IEWrappedNameOrd (unLoc x) diff --git a/src/Ormolu/Parser.hs b/src/Ormolu/Parser.hs index 01854b549..14dd69c51 100644 --- a/src/Ormolu/Parser.hs +++ b/src/Ormolu/Parser.hs @@ -28,7 +28,6 @@ import GHC.Data.EnumSet qualified as EnumSet import GHC.Data.FastString qualified as GHC import GHC.Data.Maybe (orElse) import GHC.Data.StringBuffer (StringBuffer) -import GHC.Driver.CmdLine qualified as GHC import GHC.Driver.Config.Parser (initParserOpts) import GHC.Driver.Errors.Types qualified as GHC import GHC.Driver.Session as GHC @@ -44,7 +43,6 @@ import GHC.Types.SourceError qualified as GHC import GHC.Types.SrcLoc import GHC.Utils.Error import GHC.Utils.Exception (ExceptionMonad) -import GHC.Utils.Outputable (defaultSDocContext) import GHC.Utils.Panic qualified as GHC import Ormolu.Config import Ormolu.Exception @@ -70,7 +68,7 @@ parseModule :: -- | Input for parser Text -> m - ( [GHC.Warn], + ( GHC.DriverMessages, Either (SrcSpan, String) [SourceSnippet] ) parseModule config@Config {..} packageFixityMap path rawInput = liftIO $ do @@ -134,7 +132,7 @@ parseModuleSnippet Config {..} modFixityMap dynFlags path rawInput = liftIO $ do Nothing -> "" msg = showOutputable - . formatBulleted defaultSDocContext + . formatBulleted . diagnosticMessage GHC.NoDiagnosticOpts $ err in case L.sortOn (rateSeverity . errMsgSeverity) errs of @@ -254,7 +252,8 @@ manualExts = LinearTypes, -- steals the (%) type operator in some cases OverloadedRecordDot, -- f.g parses differently OverloadedRecordUpdate, -- qualified fields are not supported - OverloadedLabels -- a#b is parsed differently + OverloadedLabels, -- a#b is parsed differently + ExtendedLiterals -- 1#Word32 is parsed differently ] -- | Run a 'GHC.P' computation. @@ -289,7 +288,7 @@ parsePragmasIntoDynFlags :: FilePath -> -- | Input for parser StringBuffer -> - IO (Either String ([GHC.Warn], DynFlags)) + IO (Either String (GHC.DriverMessages, DynFlags)) parsePragmasIntoDynFlags flags extraOpts filepath input = catchGhcErrors $ do let (_warnings, fileOpts) = diff --git a/src/Ormolu/Printer/Meat/Common.hs b/src/Ormolu/Printer/Meat/Common.hs index 63632b1ab..fa42e4b86 100644 --- a/src/Ormolu/Printer/Meat/Common.hs +++ b/src/Ormolu/Printer/Meat/Common.hs @@ -18,6 +18,7 @@ where import Control.Monad import Data.Text qualified as T +import GHC.Data.FastString import GHC.Hs.Doc import GHC.Hs.Extension (GhcPs) import GHC.Hs.ImpExp @@ -71,6 +72,9 @@ p_rdrName l = located l $ \x -> do NameAnn {nann_adornment = NameParens} -> parens N . handleUnboxedSumsAndHashInteraction NameAnn {nann_adornment = NameBackquotes} -> backticks + -- The `->` identifier is always parenthesized, but does not use + -- `NameAnn {nann_adornment = NameParens}`. + NameAnnRArrow {} -> parens N -- special case for unboxed unit tuples NameAnnOnly {nann_adornment = NameParensHash} -> const $ txt "(# #)" _ -> id @@ -188,4 +192,4 @@ p_hsDocName name = txt ("-- $" <> T.pack name) p_sourceText :: SourceText -> R () p_sourceText = \case NoSourceText -> pure () - SourceText s -> txt (T.pack s) + SourceText s -> atom @FastString s diff --git a/src/Ormolu/Printer/Meat/Declaration.hs b/src/Ormolu/Printer/Meat/Declaration.hs index 1a550d079..f64336233 100644 --- a/src/Ormolu/Printer/Meat/Declaration.hs +++ b/src/Ormolu/Printer/Meat/Declaration.hs @@ -139,7 +139,9 @@ p_tyClDecl style = \case p_dataDecl Associated tcdLName - (tyVarsToTyPats tcdTyVars) + (hsq_explicit tcdTyVars) + getLocA + (located' p_hsTyVarBndr) tcdFixity tcdDataDefn ClassDecl {..} -> diff --git a/src/Ormolu/Printer/Meat/Declaration/Data.hs b/src/Ormolu/Printer/Meat/Declaration/Data.hs index 84c3b5107..7146e226e 100644 --- a/src/Ormolu/Printer/Meat/Declaration/Data.hs +++ b/src/Ormolu/Printer/Meat/Declaration/Data.hs @@ -24,21 +24,25 @@ import GHC.Types.SrcLoc import Ormolu.Printer.Combinators import Ormolu.Printer.Meat.Common import Ormolu.Printer.Meat.Type -import Ormolu.Utils (matchAddEpAnn) +import Ormolu.Utils p_dataDecl :: -- | Whether to format as data family FamilyStyle -> -- | Type constructor LocatedN RdrName -> - -- | Type patterns - HsTyPats GhcPs -> + -- | Type variables + [tyVar] -> + -- | Get location information for type variables + (tyVar -> SrcSpan) -> + -- | How to print type variables + (tyVar -> R ()) -> -- | Lexical fixity LexicalFixity -> -- | Data definition HsDataDefn GhcPs -> R () -p_dataDecl style name tpats fixity HsDataDefn {..} = do +p_dataDecl style name tyVars getTyVarLoc p_tyVar fixity HsDataDefn {..} = do txt $ case dd_cons of NewTypeCon _ -> "newtype" DataTypeCons False _ -> "data" @@ -57,7 +61,7 @@ p_dataDecl style name tpats fixity HsDataDefn {..} = do space p_sourceText type_ txt " #-}" - let constructorSpans = getLocA name : fmap lhsTypeArgSrcSpan tpats + let constructorSpans = getLocA name : fmap getTyVarLoc tyVars sigSpans = maybeToList . fmap getLocA $ dd_kindSig declHeaderSpans = maybeToList (getLocA <$> dd_ctxt) ++ constructorSpans ++ sigSpans @@ -76,7 +80,7 @@ p_dataDecl style name tpats fixity HsDataDefn {..} = do (isInfix fixity) True (p_rdrName name) - (p_lhsTypeArg <$> tpats) + (p_tyVar <$> tyVars) forM_ dd_kindSig $ \k -> do space txt "::" diff --git a/src/Ormolu/Printer/Meat/Declaration/Instance.hs b/src/Ormolu/Printer/Meat/Declaration/Instance.hs index b0ca41e37..1487f6f8f 100644 --- a/src/Ormolu/Printer/Meat/Declaration/Instance.hs +++ b/src/Ormolu/Printer/Meat/Declaration/Instance.hs @@ -97,7 +97,14 @@ p_tyFamInstDecl style TyFamInstDecl {..} = do p_dataFamInstDecl :: FamilyStyle -> DataFamInstDecl GhcPs -> R () p_dataFamInstDecl style (DataFamInstDecl {dfid_eqn = FamEqn {..}}) = - p_dataDecl style feqn_tycon feqn_pats feqn_fixity feqn_rhs + p_dataDecl + style + feqn_tycon + feqn_pats + lhsTypeArgSrcSpan + p_lhsTypeArg + feqn_fixity + feqn_rhs match_overlap_mode :: Maybe (LocatedP OverlapMode) -> R () -> R () match_overlap_mode overlap_mode layoutStrategy = diff --git a/src/Ormolu/Printer/Meat/Declaration/Value.hs b/src/Ormolu/Printer/Meat/Declaration/Value.hs index c0cdc0445..70bb79067 100644 --- a/src/Ormolu/Printer/Meat/Declaration/Value.hs +++ b/src/Ormolu/Printer/Meat/Declaration/Value.hs @@ -33,6 +33,7 @@ import Data.Text (Text) import Data.Text qualified as Text import Data.Void import GHC.Data.Bag (bagToList) +import GHC.Data.FastString import GHC.Data.Strict qualified as Strict import GHC.Hs import GHC.LanguageExtensions.Type (Extension (NegativeLiterals)) @@ -791,11 +792,11 @@ p_hsExpr' isApp s = \case Ambiguous NoExtField n -> n p_recFields p_lbl = sep commaDel (sitcc . located' (p_hsFieldBind p_lbl)) - inci . braces N $ - either - (p_recFields p_updLbl) - (p_recFields $ located' $ coerce p_ldotFieldOccs) - rupd_flds + inci . braces N $ case rupd_flds of + RegularRecUpdFields {..} -> + p_recFields p_updLbl recUpdFields + OverloadedRecUpdFields {..} -> + p_recFields (located' (coerce p_ldotFieldOccs)) olRecUpdFields HsGetField {..} -> do located gf_expr p_hsExpr txt "." @@ -1184,9 +1185,9 @@ p_hsQuote epAnn = \case _ -> False -- | Print the source text of a string literal while indenting gaps correctly. -p_stringLit :: String -> R () +p_stringLit :: FastString -> R () p_stringLit src = - let s = splitGaps src + let s = splitGaps (unpackFS src) singleLine = txt $ Text.pack (mconcat s) multiLine = diff --git a/src/Ormolu/Printer/Meat/Declaration/Value.hs-boot b/src/Ormolu/Printer/Meat/Declaration/Value.hs-boot index 8a64c512e..857683601 100644 --- a/src/Ormolu/Printer/Meat/Declaration/Value.hs-boot +++ b/src/Ormolu/Printer/Meat/Declaration/Value.hs-boot @@ -11,6 +11,7 @@ module Ormolu.Printer.Meat.Declaration.Value ) where +import GHC.Data.FastString import GHC.Hs import Ormolu.Printer.Combinators @@ -18,7 +19,7 @@ p_valDecl :: HsBindLR GhcPs GhcPs -> R () p_pat :: Pat GhcPs -> R () p_hsExpr :: HsExpr GhcPs -> R () p_hsUntypedSplice :: SpliceDecoration -> HsUntypedSplice GhcPs -> R () -p_stringLit :: String -> R () +p_stringLit :: FastString -> R () data IsApplicand diff --git a/src/Ormolu/Printer/Meat/Declaration/Warning.hs b/src/Ormolu/Printer/Meat/Declaration/Warning.hs index 0ffaab0f4..5a209bffa 100644 --- a/src/Ormolu/Printer/Meat/Declaration/Warning.hs +++ b/src/Ormolu/Printer/Meat/Declaration/Warning.hs @@ -1,14 +1,16 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} module Ormolu.Printer.Meat.Declaration.Warning ( p_warnDecls, - p_moduleWarning, + p_warningTxt, ) where import Data.Foldable import Data.Text (Text) +import Data.Text qualified as T import GHC.Hs import GHC.Types.Name.Reader import GHC.Types.SourceText @@ -16,6 +18,7 @@ import GHC.Types.SrcLoc import GHC.Unit.Module.Warnings import Ormolu.Printer.Combinators import Ormolu.Printer.Meat.Common +import Ormolu.Utils p_warnDecls :: WarnDecls GhcPs -> R () p_warnDecls (Warnings _ warnings) = @@ -25,8 +28,8 @@ p_warnDecl :: WarnDecl GhcPs -> R () p_warnDecl (Warning _ functions warningTxt) = p_topLevelWarning functions warningTxt -p_moduleWarning :: WarningTxt GhcPs -> R () -p_moduleWarning wtxt = do +p_warningTxt :: WarningTxt GhcPs -> R () +p_warningTxt wtxt = do let (pragmaText, lits) = warningText wtxt inci $ pragma pragmaText $ inci $ p_lits lits @@ -41,7 +44,12 @@ p_topLevelWarning fnames wtxt = do warningText :: WarningTxt GhcPs -> (Text, [Located StringLiteral]) warningText = \case - WarningTxt _ lits -> ("WARNING", fmap hsDocString <$> lits) + WarningTxt mcat _ lits -> ("WARNING" <> T.pack cat, fmap hsDocString <$> lits) + where + cat = case unLoc <$> mcat of + Just InWarningCategory {..} -> + " in " <> show (showOutputable @WarningCategory (unLoc iwc_wc)) + Nothing -> "" DeprecatedTxt _ lits -> ("DEPRECATED", fmap hsDocString <$> lits) p_lits :: [Located StringLiteral] -> R () diff --git a/src/Ormolu/Printer/Meat/ImportExport.hs b/src/Ormolu/Printer/Meat/ImportExport.hs index 91ca9b473..1fc2240b4 100644 --- a/src/Ormolu/Printer/Meat/ImportExport.hs +++ b/src/Ormolu/Printer/Meat/ImportExport.hs @@ -10,12 +10,14 @@ module Ormolu.Printer.Meat.ImportExport where import Control.Monad +import Data.Foldable (for_) import GHC.Hs import GHC.LanguageExtensions.Type import GHC.Types.PkgQual import GHC.Types.SrcLoc import Ormolu.Printer.Combinators import Ormolu.Printer.Meat.Common +import Ormolu.Printer.Meat.Declaration.Warning import Ormolu.Utils (RelativePos (..), attachRelativePos) p_hsmodExports :: [LIE GhcPs] -> R () @@ -74,7 +76,10 @@ p_hsmodImport ImportDecl {..} = do p_lie :: Layout -> RelativePos -> IE GhcPs -> R () p_lie encLayout relativePos = \case - IEVar NoExtField l1 -> do + IEVar mwarn l1 -> do + for_ mwarn $ \warnTxt -> do + located warnTxt p_warningTxt + breakpoint located l1 p_ieWrappedName p_comma IEThingAbs _ l1 -> do diff --git a/src/Ormolu/Printer/Meat/Module.hs b/src/Ormolu/Printer/Meat/Module.hs index 820370121..f4e54d697 100644 --- a/src/Ormolu/Printer/Meat/Module.hs +++ b/src/Ormolu/Printer/Meat/Module.hs @@ -49,7 +49,7 @@ p_hsModule mstackHeader pragmas HsModule {..} = do p_hsmodName name breakpoint forM_ hsmodDeprecMessage $ \w -> do - located' p_moduleWarning w + located' p_warningTxt w breakpoint case hsmodExports of Nothing -> return () diff --git a/src/Ormolu/Printer/Meat/Type.hs b/src/Ormolu/Printer/Meat/Type.hs index 818f60ea5..795d173db 100644 --- a/src/Ormolu/Printer/Meat/Type.hs +++ b/src/Ormolu/Printer/Meat/Type.hs @@ -14,7 +14,6 @@ module Ormolu.Printer.Meat.Type p_conDeclFields, p_lhsTypeArg, p_hsSigType, - tyVarsToTyPats, hsOuterTyVarBndrsToHsType, lhsTypeToSigType, ) @@ -74,7 +73,7 @@ p_hsType' multilineArgs = \case breakpoint inci $ sep breakpoint (located' p_hsType) args - HsAppKindTy _ ty kd -> sitcc $ do + HsAppKindTy _ ty _ kd -> sitcc $ do -- The first argument is the location of the "@..." part. Not 100% sure, -- but I think we can ignore it as long as we use 'located' on both the -- type and the kind. @@ -199,27 +198,38 @@ p_hsContext = \case [x] -> located x p_hsType xs -> parens N $ sep commaDel (sitcc . located' p_hsType) xs -class IsInferredTyVarBndr flag where +class IsTyVarBndrFlag flag where isInferred :: flag -> Bool + p_tyVarBndrFlag :: flag -> R () + p_tyVarBndrFlag _ = pure () -instance IsInferredTyVarBndr () where +instance IsTyVarBndrFlag () where isInferred () = False -instance IsInferredTyVarBndr Specificity where +instance IsTyVarBndrFlag Specificity where isInferred = \case InferredSpec -> True SpecifiedSpec -> False -p_hsTyVarBndr :: (IsInferredTyVarBndr flag) => HsTyVarBndr flag GhcPs -> R () +instance IsTyVarBndrFlag (HsBndrVis GhcPs) where + isInferred _ = False + p_tyVarBndrFlag = \case + HsBndrRequired -> pure () + HsBndrInvisible _ -> txt "@" + +p_hsTyVarBndr :: (IsTyVarBndrFlag flag) => HsTyVarBndr flag GhcPs -> R () p_hsTyVarBndr = \case - UserTyVar _ flag x -> + UserTyVar _ flag x -> do + p_tyVarBndrFlag flag (if isInferred flag then braces N else id) $ p_rdrName x - KindedTyVar _ flag l k -> (if isInferred flag then braces else parens) N $ do - located l atom - space - txt "::" - breakpoint - inci (located k p_hsType) + KindedTyVar _ flag l k -> do + p_tyVarBndrFlag flag + (if isInferred flag then braces else parens) N $ do + located l atom + space + txt "::" + breakpoint + inci (located k p_hsType) data ForAllVisibility = ForAllInvis | ForAllVis @@ -275,21 +285,6 @@ p_hsSigType HsSig {..} = ---------------------------------------------------------------------------- -- Conversion functions -tyVarToType :: HsTyVarBndr () GhcPs -> HsType GhcPs -tyVarToType = \case - UserTyVar _ () tvar -> HsTyVar EpAnnNotUsed NotPromoted tvar - KindedTyVar _ () tvar kind -> - -- Note: we always add parentheses because for whatever reason GHC does - -- not use HsParTy for left-hand sides of declarations. Please see - -- . This is fine as - -- long as 'tyVarToType' does not get applied to right-hand sides of - -- declarations. - HsParTy EpAnnNotUsed . noLocA $ - HsKindSig EpAnnNotUsed (noLocA (HsTyVar EpAnnNotUsed NotPromoted tvar)) kind - -tyVarsToTyPats :: LHsQTyVars GhcPs -> HsTyPats GhcPs -tyVarsToTyPats HsQTvs {..} = HsValArg . fmap tyVarToType <$> hsq_explicit - -- could be generalized to also handle () instead of Specificity hsOuterTyVarBndrsToHsType :: HsOuterTyVarBndrs Specificity GhcPs -> diff --git a/stack.yaml b/stack.yaml index 6b7a4563e..994355dde 100644 --- a/stack.yaml +++ b/stack.yaml @@ -4,6 +4,11 @@ packages: - '.' - extract-hackage-info +extra-deps: +- github: amesgen/stuff + commit: 7564a27214e21cf96ede8c69cf1037889d8118cd + subdirs: [ghc-lib-parser-9.8.1-alpha1] + nix: packages: - haskellPackages.happy diff --git a/weeder.dhall b/weeder.dhall deleted file mode 100644 index 2cccc8f18..000000000 --- a/weeder.dhall +++ /dev/null @@ -1,7 +0,0 @@ -{ roots = - [ "^Main.main\$" - , "^Paths_" - , "^Ormolu.Terminal.QualifiedDo.>>\$" -- https://github.com/ocharles/weeder/issues/112 - ] -, type-class-roots = True -} diff --git a/weeder.toml b/weeder.toml new file mode 100644 index 000000000..9a2c8b639 --- /dev/null +++ b/weeder.toml @@ -0,0 +1,6 @@ +roots = [ + "^Main.main$", + "^Paths_", + "^Ormolu.Terminal.QualifiedDo.>>$" # https://github.com/ocharles/weeder/issues/112 +] +type-class-roots = true