From e1925d6fdd10bdb4e23e37c4013ec15818d5f183 Mon Sep 17 00:00:00 2001 From: kqr Date: Mon, 15 Jun 2026 21:28:32 +0200 Subject: [PATCH] Migrate to ghc-lib-parser to build on GHC 9.10 MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit The main potential objection to this change is that it cannot use GHC for parsing CPP, but uses cpphs instead. The cpphs library is apparently somewhat more lenient and will skip past minor syntax errors such as skipping missing includes and unterminated ifs. This means complexity will be calculated slightly differently in files where that is the case. A test definition has been changed to mirror this difference. The upgrade to GHC 9 also forces smaller rewrites to get rid of old dependencies (dirstream, lens-simple) that likewise don't build on modern GHC versions – these are small and self-contained in Walker.hs and Results.hs. The build system has switched from Stack to Cabal, mostly because that's what I have and know. I wouldn't know how to upgrade the Stack bits so I dropped them instead. Unfortunately, the CI tooling implied by .travis.yml also depends on Stack, so someone may want to reinstate it. --- .gitignore | 2 +- .travis.yml | 149 ------------------------------------ README.md | 127 +++++++++++++++++++----------- argon.cabal | 26 ++----- cabal.project | 10 +++ src/Argon/Cabal.hs | 23 ++---- src/Argon/Loc.hs | 6 +- src/Argon/Parser.hs | 125 ++++++++++++++++-------------- src/Argon/Preprocess.hs | 68 +++++++--------- src/Argon/Results.hs | 10 ++- src/Argon/SYB/Utils.hs | 28 ++----- src/Argon/Types.hs | 1 - src/Argon/Visitor.hs | 38 +++++---- src/Argon/Walker.hs | 49 ++++++------ stack-travis-coveralls.yaml | 8 -- stack.yaml | 4 - test/ArgonSpec.hs | 42 +++++----- test/data/lambdacases.hs | 5 ++ 18 files changed, 284 insertions(+), 437 deletions(-) delete mode 100644 .travis.yml create mode 100644 cabal.project delete mode 100644 stack-travis-coveralls.yaml delete mode 100644 stack.yaml create mode 100644 test/data/lambdacases.hs diff --git a/.gitignore b/.gitignore index 38eeae3..57fa1e6 100644 --- a/.gitignore +++ b/.gitignore @@ -1,5 +1,6 @@ *.sw[eop] dist/ +dist-newstyle/ cabal-dev *.o *.hi @@ -11,7 +12,6 @@ cabal-dev .hpc .hsenv .cabal-sandbox/ -.stack-work/ cabal.sandbox.config *.prof *.aux diff --git a/.travis.yml b/.travis.yml deleted file mode 100644 index 85e9a79..0000000 --- a/.travis.yml +++ /dev/null @@ -1,149 +0,0 @@ -# Use new container infrastructure to enable caching -sudo: false - -# Do not choose a language; we provide our own build tools. -language: generic - -# Caching so the next build will be fast too. -cache: - directories: - - $HOME/.ghc - - $HOME/.cabal - - $HOME/.stack - -matrix: - include: - - env: BUILD=cabal GHCVER=8.0.2 CABALVER=1.24 HAPPYVER=1.19.5 ALEXVER=3.1.7 - compiler: ": #GHC 8.0.2" - addons: {apt: {packages: [cabal-install-1.24,ghc-8.0.2,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}} - - env: BUILD=cabal GHCVER=8.2.2 CABALVER=2.0 HAPPYVER=1.19.5 ALEXVER=3.1.7 - compiler: ": #GHC 8.2.2" - addons: {apt: {packages: [cabal-install-2.0,ghc-8.2.2,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}} - # Build with the newest GHC and cabal-install. This is an accepted failure, - # see below. - - env: BUILD=cabal GHCVER=head CABALVER=head HAPPYVER=1.19.5 ALEXVER=3.1.7 - compiler: ": #GHC HEAD" - addons: {apt: {packages: [cabal-install-head,ghc-head,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}} - # The Stack builds. We can pass in arbitrary Stack arguments via the ARGS - # variable, such as using --stack-yaml to point to a different file. - - env: BUILD=stack ARGS="" - compiler: ": #stack default" - addons: {apt: {packages: [libgmp-dev]}} - - env: BUILD=stack ARGS="--resolver lts-9" - compiler: ": #stack 8.0.2" - addons: {apt: {packages: [libgmp-dev]}} - - env: BUILD=stack ARGS="--resolver lts-11" - compiler: ": #stack 8.2.2" - addons: {apt: {packages: [libgmp-dev]}} - # Nightly builds are allowed to fail - - env: BUILD=stack ARGS="--resolver nightly" - compiler: ": #stack nightly" - addons: {apt: {packages: [libgmp-dev]}} - - # Build on macOS in addition to Linux - - env: BUILD=stack ARGS="" - compiler: ": #stack default osx" - os: osx - - - env: BUILD=stack ARGS="--resolver lts-9" - compiler: ": #stack 8.0.2 osx" - os: osx - - - env: BUILD=stack ARGS="--resolver lts-11" - compiler: ": #stack 8.2.2 osx" - os: osx - - allow_failures: - - env: BUILD=cabal GHCVER=head CABALVER=head HAPPYVER=1.19.5 ALEXVER=3.1.7 - - env: BUILD=cabal GHCVER=8.2.2 CABALVER=2.0 HAPPYVER=1.19.5 ALEXVER=3.1.7 # TODO: I need to figure out why this one fails with /home/travis/.cabal/logs/ghc-8.2.2/integer-logarithms-1.0.2.1-2a6l3Ge7uAMKtkov70g6We.log: openFile: does not exist (No such file or directory) - - env: BUILD=stack ARGS="--resolver nightly" - # TODO: on MacOS it the following builds will fail with `error: non-portable path to file '".stack-work/dist/x86_64-osx/Cabal-2.0.1.0/build/Argon/autogen/cabal_macros.h"';` - - os: osx - -before_install: -# Using compiler above sets CC to an invalid value, so unset it -- unset CC - -# We want to always allow newer versions of packages when building on GHC HEAD -- CABALARGS="" -- if [ "x$GHCVER" = "xhead" ]; then CABALARGS=--allow-newer; fi - -# Download and unpack the stack executable -- export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$HOME/.local/bin:/opt/alex/$ALEXVER/bin:/opt/happy/$HAPPYVER/bin:$HOME/.cabal/bin:$PATH -- mkdir -p ~/.local/bin -- | - if [ `uname` = "Darwin" ] - then - travis_retry curl --insecure -L https://www.stackage.org/stack/osx-x86_64 | tar xz --strip-components=1 --include '*/stack' -C ~/.local/bin - else - travis_retry curl -L https://www.stackage.org/stack/linux-x86_64 | tar xz --wildcards --strip-components=1 -C ~/.local/bin '*/stack' - fi - - # Use the more reliable S3 mirror of Hackage - mkdir -p $HOME/.cabal - echo 'remote-repo: hackage.haskell.org:http://hackage.fpcomplete.com/' > $HOME/.cabal/config - echo 'remote-repo-cache: $HOME/.cabal/packages' >> $HOME/.cabal/config - - if [ "$CABALVER" != "1.16" ] - then - echo 'jobs: $ncpus' >> $HOME/.cabal/config - fi - -install: -- echo "$(ghc --version) [$(ghc --print-project-git-commit-id 2> /dev/null || echo '?')]" -- if [ -f configure.ac ]; then autoreconf -i; fi -- | - set -ex - case "$BUILD" in - stack) - # Add in extra-deps for older snapshots, as necessary - stack --no-terminal --install-ghc $ARGS test --bench --dry-run || ( \ - stack --no-terminal $ARGS build cabal-install && \ - stack --no-terminal $ARGS solver --update-config) - - # Build the dependencies - stack --no-terminal --install-ghc $ARGS test --bench --only-dependencies - ;; - cabal) - cabal --version - travis_retry cabal update - - # Get the list of packages from the stack.yaml file. Note that - # this will also implicitly run hpack as necessary to generate - # the .cabal files needed by cabal-install. - PACKAGES=$(stack --install-ghc query locals | grep '^ *path' | sed 's@^ *path:@@') - - cabal install --only-dependencies --enable-tests --enable-benchmarks --force-reinstalls --ghc-options=-O0 --reorder-goals --max-backjumps=-1 $CABALARGS $PACKAGES - ;; - esac - set +ex - -script: -- | - set -ex - case "$BUILD" in - stack) - stack --no-terminal $ARGS test --bench --no-run-benchmarks --haddock --no-haddock-deps --coverage --pedantic - ;; - cabal) - cabal install --enable-tests --enable-benchmarks --force-reinstalls --ghc-options=-O0 --reorder-goals --max-backjumps=-1 $CABALARGS $PACKAGES - - ORIGDIR=$(pwd) - for dir in $PACKAGES - do - cd $dir - cabal check || [ "$CABALVER" == "1.16" ] - cabal sdist - PKGVER=$(cabal info . | awk '{print $2;exit}') - SRC_TGZ=$PKGVER.tar.gz - cd dist - tar zxfv "$SRC_TGZ" - cd "$PKGVER" - cabal configure --enable-tests --ghc-options -O0 - cabal build - cabal test - cd $ORIGDIR - done - ;; - esac - set +ex diff --git a/README.md b/README.md index 6472c08..3f5c280 100644 --- a/README.md +++ b/README.md @@ -36,15 +36,16 @@ ### Installing -Simple as ``stack install argon`` or ``cabal install argon``. -Note: if you are using Stack and your resolver if too old, you might have to -add some packages to your `stack.yaml` file. +Simple as ``cabal install argon``. #### GHC compatibility -Argon is compatible with GHC version 8.0.2 and above. In the -[releases](https://github.com/rubik/argon/releases) page you can find binaries -for older versions of `argon` which support GHC versions 7.8 and 7.10. +Argon parses Haskell using the standalone +[`ghc-lib-parser`](https://hackage.haskell.org/package/ghc-lib-parser), so it is +independent of the compiler used to build it. It builds with modern GHC (tested +with GHC 9.10) and understands the Haskell syntax of its pinned `ghc-lib-parser` +(currently the 9.12 series). Older `argon` releases targeting GHC 7.8–8.x can be +found on the [releases](https://github.com/rubik/argon/releases) page. ### About the complexity being measured @@ -94,27 +95,37 @@ potential maintainability issues. The Argon executable expects a list of file paths (files or directories): $ argon --no-color --min 2 src - src/Argon/Types.hs - 61:5 toJSON - 2 - src/Argon/Visitor.hs - 55:1 visitExp - 5 - 62:1 visitOp - 4 - 28:11 visit - 2 - 35:1 getFuncName - 2 - src/Argon/Parser.hs - 55:1 parseModuleWithCpp - 3 - 88:1 customLogAction - 3 - 35:1 analyze - 2 - 39:9 analysis - 2 src/Argon/Formatters.hs - 61:1 formatResult - 3 42:1 coloredFunc - 2 43:11 color - 2 - src/Argon/Results.hs - 35:1 export - 3 - 28:1 filterResults - 2 + 57:1 formatResult - 2 + src/Argon/SYB/Utils.hs + 20:1 everythingStaged - 2 + src/Argon/Preprocess.hs + 34:1 toCpphsOptions - 2 + 44:5 parseDefine - 2 src/Argon/Loc.hs - 18:11 toRealSrcLoc - 2 + 20:11 toRealSrcLoc - 2 + src/Argon/Walker.hs + 22:1 walk - 4 + 15:1 allFiles - 2 + src/Argon/Results.hs + 46:1 filterNulls - 3 + 66:1 exportStream - 3 + 56:1 filterResults - 2 + src/Argon/Parser.hs + 67:1 parseModuleWithCpp - 3 + 42:1 analyze - 2 + 46:9 analysis - 2 + 105:1 renderError - 2 + src/Argon/Cabal.hs + 23:11 toString - 3 + src/Argon/Types.hs + 81:5 toJSON - 2 + src/Argon/Visitor.hs + 61:1 visitExp - 6 + 71:1 visitOp - 4 + 30:11 visit - 2 For every file, Argon sorts results with the following criteria (and in this order): @@ -139,54 +150,78 @@ Results can also be exported to JSON: ```json $ argon --json --min 2 src [ - { "blocks": [ ], "path": "src/Argon.hs", "type": "result" }, { - "blocks": [{ "complexity": 2, "name": "toJSON", "lineno": 61, "col": 5 }], - "path": "src/Argon/Types.hs", + "blocks": [ + { "col": 1, "complexity": 2, "lineno": 42, "name": "coloredFunc" }, + { "col": 11, "complexity": 2, "lineno": 43, "name": "color" }, + { "col": 1, "complexity": 2, "lineno": 57, "name": "formatResult" } + ], + "path": "src/Argon/Formatters.hs", + "type": "result" + }, + { + "blocks": [{ "col": 1, "complexity": 2, "lineno": 20, "name": "everythingStaged" }], + "path": "src/Argon/SYB/Utils.hs", "type": "result" }, { "blocks": [ - { "complexity": 5, "name": "visitExp", "lineno": 55, "col": 1 }, - { "complexity": 4, "name": "visitOp", "lineno": 62, "col": 1 }, - { "complexity": 2, "name": "visit", "lineno": 28, "col": 11 }, - { "complexity": 2, "name": "getFuncName", "lineno": 35, "col": 1 } + { "col": 1, "complexity": 2, "lineno": 34, "name": "toCpphsOptions" }, + { "col": 5, "complexity": 2, "lineno": 44, "name": "parseDefine" } ], - "path": "src/Argon/Visitor.hs", + "path": "src/Argon/Preprocess.hs", + "type": "result" + }, + { + "blocks": [{ "col": 11, "complexity": 2, "lineno": 20, "name": "toRealSrcLoc" }], + "path": "src/Argon/Loc.hs", "type": "result" }, { "blocks": [ - { "complexity": 3, "name": "parseModuleWithCpp", "lineno": 55, "col": 1 }, - { "complexity": 3, "name": "customLogAction", "lineno": 88, "col": 1 }, - { "complexity": 2, "name": "analyze", "lineno": 35, "col": 1 }, - { "complexity": 2, "name": "analysis", "lineno": 39, "col": 9 } + { "col": 1, "complexity": 4, "lineno": 22, "name": "walk" }, + { "col": 1, "complexity": 2, "lineno": 15, "name": "allFiles" } ], - "path": "src/Argon/Parser.hs", + "path": "src/Argon/Walker.hs", "type": "result" }, { "blocks": [ - { "complexity": 3, "name": "formatResult", "lineno": 61, "col": 1 }, - { "complexity": 2, "name": "coloredFunc", "lineno": 42, "col": 1 }, - { "complexity": 2, "name": "color", "lineno": 43, "col": 11 } + { "col": 1, "complexity": 3, "lineno": 46, "name": "filterNulls" }, + { "col": 1, "complexity": 3, "lineno": 66, "name": "exportStream" }, + { "col": 1, "complexity": 2, "lineno": 56, "name": "filterResults" } ], - "path": "src/Argon/Formatters.hs", + "path": "src/Argon/Results.hs", "type": "result" }, { "blocks": [ - { "complexity": 3, "name": "export", "lineno": 35, "col": 1 }, - { "complexity": 2, "name": "filterResults", "lineno": 28, "col": 1 } + { "col": 1, "complexity": 3, "lineno": 67, "name": "parseModuleWithCpp" }, + { "col": 1, "complexity": 2, "lineno": 42, "name": "analyze" }, + { "col": 9, "complexity": 2, "lineno": 46, "name": "analysis" }, + { "col": 1, "complexity": 2, "lineno": 105, "name": "renderError" } ], - "path": "src/Argon/Results.hs", + "path": "src/Argon/Parser.hs", "type": "result" }, { - "blocks": [{ "complexity": 2, "name": "toRealSrcLoc", "lineno": 18, "col": 11 }], - "path": "src/Argon/Loc.hs", + "blocks": [{ "col": 11, "complexity": 3, "lineno": 23, "name": "toString" }], + "path": "src/Argon/Cabal.hs", "type": "result" }, - { "blocks": [ ], "path": "src/Argon/Preprocess.hs", "type": "result" } + { + "blocks": [{ "col": 5, "complexity": 2, "lineno": 81, "name": "toJSON" }], + "path": "src/Argon/Types.hs", + "type": "result" + }, + { + "blocks": [ + { "col": 1, "complexity": 6, "lineno": 61, "name": "visitExp" }, + { "col": 1, "complexity": 4, "lineno": 71, "name": "visitOp" }, + { "col": 11, "complexity": 2, "lineno": 30, "name": "visit" } + ], + "path": "src/Argon/Visitor.hs", + "type": "result" + } ] ``` diff --git a/argon.cabal b/argon.cabal index 022e174..e50f3c8 100644 --- a/argon.cabal +++ b/argon.cabal @@ -1,3 +1,4 @@ +cabal-version: 2.4 name: argon version: 0.4.1.0 synopsis: Measure your code's complexity @@ -10,7 +11,6 @@ maintainer: michelelacchia@gmail.com copyright: 2015 Michele Lacchia category: Development, Static Analysis build-type: Simple -cabal-version: >=1.18 description: Argon performs static analysis on your code in order to compute cyclomatic complexity. It is a quantitative measure of the number of linearly @@ -20,7 +20,6 @@ description: files or directories to analyze. The data can be optionally exported to JSON. extra-source-files: - stack.yaml README.md CHANGELOG.md USAGE.txt @@ -32,7 +31,7 @@ extra-source-files: test/tree/*.txt test/tree/sub/*.hs test/tree/sub2/*.hs -tested-with: GHC >= 8.0.2 && < 9 +tested-with: GHC == 9.10.* library hs-source-dirs: src @@ -55,17 +54,13 @@ library , pipes-group , pipes-safe , pipes-bytestring - , lens-simple - , ghc - , ghc-boot - , ghc-paths - , ghc-syb-utils + , ghc-lib-parser + , ghc-lib-parser-ex + , cpphs , syb , Cabal , containers , directory - , system-filepath - , dirstream , filepath default-language: Haskell2010 ghc-options: -Wall @@ -73,8 +68,6 @@ library -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints - if impl(ghc < 7.8) - buildable: False executable argon hs-source-dirs: app @@ -86,8 +79,6 @@ executable argon , pipes >=4.1 , pipes-safe >=2.2 default-language: Haskell2010 - if impl(ghc < 7.8) - buildable: False test-suite argon-test type: exitcode-stdio-1.0 @@ -97,7 +88,7 @@ test-suite argon-test build-depends: base >=4.7 && <5 , argon , ansi-terminal - , ghc + , ghc-lib-parser , aeson , hspec , QuickCheck @@ -106,10 +97,9 @@ test-suite argon-test , pipes-safe ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N - + + build-tool-depends: hspec-discover:hspec-discover default-language: Haskell2010 - if impl(ghc < 7.8) - buildable: False test-suite style type: exitcode-stdio-1.0 diff --git a/cabal.project b/cabal.project new file mode 100644 index 0000000..80a77b9 --- /dev/null +++ b/cabal.project @@ -0,0 +1,10 @@ +packages: . + +-- Argon parses Haskell via the standalone, compiler-version-independent +-- ghc-lib-parser. The version of ghc-lib-parser used by Argon must match that +-- used by hlint used as a style check of the Argon code. +constraints: + ghc-lib-parser ==9.12.3.20251228 + , ghc-lib-parser-ex ==9.12.0.0 + , hlint ==3.10 + , cpphs ==1.20.10 diff --git a/src/Argon/Cabal.hs b/src/Argon/Cabal.hs index ef3c9d8..6c175a4 100644 --- a/src/Argon/Cabal.hs +++ b/src/Argon/Cabal.hs @@ -1,29 +1,22 @@ -{-# LANGUAGE CPP #-} module Argon.Cabal (parseExts) where -import Data.List (nub) -#if __GLASGOW_HASKELL__ < 710 -import Control.Applicative ((<$>)) -#endif +import Data.List (nub) -import qualified Distribution.PackageDescription as Dist -import qualified Distribution.PackageDescription.Parse as Dist -import qualified Distribution.Verbosity as Dist -import qualified Language.Haskell.Extension as Dist +import qualified Distribution.PackageDescription as Dist +import qualified Distribution.Simple.PackageDescription as Dist +import qualified Distribution.Verbosity as Dist +import qualified Language.Haskell.Extension as Dist -- | Parse the given Cabal file generate a list of GHC extension flags. The -- extension names are read from the default-extensions field in the library -- section. parseExts :: FilePath -> IO [String] -#if __GLASGOW_HASKELL__ < 802 -parseExts path = extract <$> Dist.readPackageDescription Dist.silent path -#else parseExts path = extract <$> Dist.readGenericPackageDescription Dist.silent path -#endif - where extract pkg = maybe [] extFromBI $ - Dist.libBuildInfo . Dist.condTreeData <$> Dist.condLibrary pkg + where extract pkg = maybe [] + (extFromBI . Dist.libBuildInfo . Dist.condTreeData) + (Dist.condLibrary pkg) extFromBI :: Dist.BuildInfo -> [String] extFromBI binfo = map toString . nub $ allExts diff --git a/src/Argon/Loc.hs b/src/Argon/Loc.hs index dc75576..79ec16b 100644 --- a/src/Argon/Loc.hs +++ b/src/Argon/Loc.hs @@ -4,8 +4,8 @@ module Argon.Loc (Loc, srcSpanToLoc, locToString, tagMsg) import Text.Printf (printf) import Control.Arrow ((&&&)) -import qualified SrcLoc as GHC -import qualified FastString as GHC +import qualified GHC.Data.FastString as GHC +import qualified GHC.Types.SrcLoc as GHC -- | Type synonym representing a location in the source code. The tuple -- represents the following: @(start line, start col)@. @@ -17,7 +17,7 @@ type Loc = (Int, Int) srcSpanToLoc :: GHC.SrcSpan -> Loc srcSpanToLoc ss = lloc $ GHC.srcSpanStart ss where lloc = (GHC.srcLocLine &&& GHC.srcLocCol) . toRealSrcLoc - toRealSrcLoc (GHC.RealSrcLoc z) = z + toRealSrcLoc (GHC.RealSrcLoc z _) = z toRealSrcLoc _ = GHC.mkRealSrcLoc (GHC.mkFastString "no info") 0 0 -- | Convert a location to a string of the form "line:col" diff --git a/src/Argon/Parser.hs b/src/Argon/Parser.hs index 0405929..8c80f2e 100644 --- a/src/Argon/Parser.hs +++ b/src/Argon/Parser.hs @@ -1,22 +1,28 @@ -{-# LANGUAGE CPP #-} +{-# LANGUAGE TypeApplications #-} module Argon.Parser (LModule, analyze, parseModule) where -import Control.Monad (void) import qualified Control.Exception as E +import Data.Either (fromRight) -import qualified GHC hiding (parseModule) -import qualified SrcLoc as GHC -import qualified Lexer as GHC -import qualified Parser as GHC -import qualified DynFlags as GHC -import qualified GHC.LanguageExtensions as GHC -import qualified HeaderInfo as GHC -import qualified MonadUtils as GHC -import qualified Outputable as GHC -import qualified FastString as GHC -import qualified StringBuffer as GHC -import GHC.Paths (libdir) +import GHC.Hs (HsModule) +import GHC.Hs.Extension (GhcPs) +import GHC.Types.SrcLoc (Located, noLoc) +import GHC.Driver.Session (DynFlags, defaultDynFlags, xopt + , parseDynamicFlagsCmdLine) +import qualified GHC.LanguageExtensions as LangExt +import GHC.Parser.Lexer (ParseResult(POk, PFailed), PState + , getPsErrorMessages) +import GHC.Types.Error (getMessages, MsgEnvelope(..) + , diagnosticMessage, defaultDiagnosticOpts + , unDecorated) +import GHC.Parser.Errors.Types (PsMessage) +import GHC.Utils.Outputable (showSDocUnsafe) +import GHC.Data.Bag (bagToList) + +import Language.Haskell.GhclibParserEx.GHC.Parser (parseFile) +import Language.Haskell.GhclibParserEx.GHC.Driver.Session (parsePragmasIntoDynFlags) +import Language.Haskell.GhclibParserEx.GHC.Settings.Config (fakeSettings) import Argon.Preprocess import Argon.Visitor (funcsCC) @@ -25,7 +31,7 @@ import Argon.Loc -- | Type synonym for a syntax node representing a module tagged with a -- 'SrcSpan' -type LModule = GHC.Located (GHC.HsModule GHC.RdrName) +type LModule = Located (HsModule GhcPs) -- | Parse the code in the given filename and compute cyclomatic complexity for @@ -45,8 +51,8 @@ analyze conf file = do handleExc :: E.SomeException -> IO (Either String LModule) handleExc = return . Left . show --- | Parse a module with the default instructions for the C pre-processor --- Only the includes directory is taken from the config +-- | Parse a module with the default instructions for the C pre-processor. +-- Only the includes directory is taken from the config. parseModule :: Config -> FilePath -> IO (Either String LModule) parseModule conf = parseModuleWithCpp conf $ defaultCppOptions { cppInclude = includeDirs conf @@ -58,47 +64,50 @@ parseModuleWithCpp :: Config -> CppOptions -> FilePath -> IO (Either String LModule) -parseModuleWithCpp conf cppOptions file = - GHC.runGhc (Just libdir) $ do - dflags <- initDynFlags conf file - let useCpp = GHC.xopt GHC.Cpp dflags - (fileContents, dflags1) <- - if useCpp - then getPreprocessedSrcDirect cppOptions file - else do - contents <- GHC.liftIO $ readFile file - return (contents, dflags) - return $ - case parseCode dflags1 file fileContents of - GHC.PFailed ss m -> Left $ tagMsg (srcSpanToLoc ss) - (GHC.showSDoc dflags m) - GHC.POk _ pmod -> Right pmod - -parseCode :: GHC.DynFlags -> FilePath -> String -> GHC.ParseResult LModule -parseCode = runParser GHC.parseModule +parseModuleWithCpp conf cppOptions file = do + raw <- readFile file + dflags1 <- initDynFlags conf + -- Read the file's own LANGUAGE/OPTIONS pragmas (e.g. to learn whether CPP + -- is enabled) before deciding whether to preprocess. + dflags2 <- pragmaFlags dflags1 file raw + (contents, dflags3) <- + if xopt LangExt.Cpp dflags2 + then do pp <- runPreprocessor cppOptions file raw + -- Re-read pragmas: CPP may have revealed extensions that + -- were hidden inside #if blocks. + df <- pragmaFlags dflags2 file pp + return (pp, df) + else return (raw, dflags2) + return $ + case parseFile file dflags3 contents of + PFailed pst -> Left $ renderError pst + POk _ pmod -> Right pmod -runParser :: GHC.P a -> GHC.DynFlags -> FilePath -> String -> GHC.ParseResult a -runParser parser flags filename str = GHC.unP parser parseState - where location = GHC.mkRealSrcLoc (GHC.mkFastString filename) 1 1 - buffer = GHC.stringToStringBuffer str - parseState = GHC.mkPState flags buffer location +-- | Base 'DynFlags' (no real GHC installation needed) with the configured +-- extensions enabled. Extensions are turned on via @-X@ flags so that names +-- like @"CPP"@ map to the right extension. +initDynFlags :: Config -> IO DynFlags +initDynFlags conf = do + let dflags0 = defaultDynFlags fakeSettings + (dflags1, _, _) <- parseDynamicFlagsCmdLine dflags0 + [noLoc ("-X" ++ e) | e <- exts conf] + return dflags1 -initDynFlags :: GHC.GhcMonad m => Config -> FilePath -> m GHC.DynFlags -initDynFlags conf file = do - dflags0 <- GHC.getSessionDynFlags - (dflags1,_,_) <- GHC.parseDynamicFlagsCmdLine dflags0 - [GHC.L GHC.noSrcSpan ("-X" ++ e) | e <- exts conf] - src_opts <- GHC.liftIO $ GHC.getOptionsFromFile dflags1 file - (dflags2, _, _) <- GHC.parseDynamicFilePragma dflags1 src_opts - let dflags3 = dflags2 { GHC.log_action = customLogAction } - void $ GHC.setSessionDynFlags dflags3 - return dflags3 +-- | Fold a source file's own pragmas into the given flags, ignoring pragma +-- parse failures (the main parse will surface any real problem). +pragmaFlags :: DynFlags -> FilePath -> String -> IO DynFlags +pragmaFlags dflags file src = + fromRight dflags <$> parsePragmasIntoDynFlags dflags ([], []) file src -customLogAction :: GHC.LogAction -customLogAction dflags _ severity srcSpan _ m = - case severity of - GHC.SevFatal -> throwError - GHC.SevError -> throwError - _ -> return () - where throwError = E.throwIO $ GhcParseError (srcSpanToLoc srcSpan) - (GHC.showSDoc dflags m) +-- | Render the first parser error of a failed parse to a @line:col message@ +-- string. +renderError :: PState -> String +renderError pst = + case bagToList (getMessages (getPsErrorMessages pst)) of + [] -> "parse error" + (env:_) -> tagMsg (srcSpanToLoc (errMsgSpan env)) + (renderDiagnostic (errMsgDiagnostic env)) + where + renderDiagnostic :: PsMessage -> String + renderDiagnostic = unwords . map showSDocUnsafe . unDecorated + . diagnosticMessage (defaultDiagnosticOpts @PsMessage) diff --git a/src/Argon/Preprocess.hs b/src/Argon/Preprocess.hs index 94fc262..e1e4e0d 100644 --- a/src/Argon/Preprocess.hs +++ b/src/Argon/Preprocess.hs @@ -1,25 +1,18 @@ --- The following code is taken and modified from ghc-exactprint, because adding --- a dependency for just one module and then adding wrappers for that module --- seemed excessive. -{-# LANGUAGE CPP #-} {-# LANGUAGE RecordWildCards #-} --- | This module provides support for CPP and interpreter directives. +-- | This module provides support for the C pre-processor. Because +-- 'ghc-lib-parser' does not ship GHC's driver pipeline, CPP is handled +-- in-process by the pure-Haskell 'cpphs' library instead of shelling out to +-- the system preprocessor. module Argon.Preprocess ( CppOptions(..) , defaultCppOptions - , getPreprocessedSrcDirect + , runPreprocessor ) where -#if __GLASGOW_HASKELL__ < 710 -import Control.Applicative ((<$>)) -#endif -import qualified GHC -import qualified DynFlags as GHC -import qualified MonadUtils as GHC -import qualified DriverPhases as GHC -import qualified DriverPipeline as GHC -import qualified HscTypes as GHC +import Language.Preprocessor.Cpphs + ( CpphsOptions(..), BoolOptions(..) + , defaultCpphsOptions, defaultBoolOptions, runCpphs ) data CppOptions = CppOptions { cppDefine :: [String] -- ^ CPP #define macros @@ -31,30 +24,23 @@ data CppOptions = CppOptions defaultCppOptions :: CppOptions defaultCppOptions = CppOptions [] [] [] -getPreprocessedSrcDirect :: (GHC.GhcMonad m) - => CppOptions - -> FilePath - -> m (String, GHC.DynFlags) -getPreprocessedSrcDirect cppOptions file = do - hscEnv <- GHC.getSession - let dfs = GHC.hsc_dflags hscEnv - newEnv = hscEnv { GHC.hsc_dflags = injectCppOptions cppOptions dfs } - (dflags', hspp_fn) <- - GHC.liftIO $ GHC.preprocess newEnv (file, Just (GHC.Cpp GHC.HsSrcFile)) - txt <- GHC.liftIO $ readFile hspp_fn - return (txt, dflags') - -injectCppOptions :: CppOptions -> GHC.DynFlags -> GHC.DynFlags -injectCppOptions CppOptions{..} dflags = - foldr addOptP dflags (map mkDefine cppDefine ++ map mkIncludeDir cppInclude - ++ map mkInclude cppFile) +-- | Run the C pre-processor over the given source contents. cpphs is told to +-- emit Haskell @{-\# LINE \#-}@ pragmas ('locations' on, 'hashline' off) so +-- that downstream parse locations still refer to the original source lines. +runPreprocessor :: CppOptions -> FilePath -> String -> IO String +runPreprocessor cppOptions = runCpphs (toCpphsOptions cppOptions) + +toCpphsOptions :: CppOptions -> CpphsOptions +toCpphsOptions CppOptions{..} = defaultCpphsOptions + { defines = map parseDefine cppDefine + , includes = cppInclude + , preInclude = cppFile + , boolopts = defaultBoolOptions { locations = True + , hashline = False + , lang = True + } + } where - mkDefine = ("-D" ++) - mkIncludeDir = ("-I" ++) - mkInclude = ("-include" ++) - -addOptP :: String -> GHC.DynFlags -> GHC.DynFlags -addOptP f = alterSettings (\s -> s { GHC.sOpt_P = f : GHC.sOpt_P s}) - -alterSettings :: (GHC.Settings -> GHC.Settings) -> GHC.DynFlags -> GHC.DynFlags -alterSettings f dflags = dflags { GHC.settings = f (GHC.settings dflags) } + parseDefine d = case break (== '=') d of + (name, '=':val) -> (name, val) + (name, _) -> (name, "1") diff --git a/src/Argon/Results.hs b/src/Argon/Results.hs index 279cdce..e853a46 100644 --- a/src/Argon/Results.hs +++ b/src/Argon/Results.hs @@ -11,16 +11,22 @@ import Control.Applicative ((<*), (*>)) #endif import Data.Aeson (encode) +import Data.Functor.Const (Const(..)) import Pipes import Pipes.Group import qualified Pipes.Prelude as P import qualified Pipes.ByteString as PB -import Lens.Simple ((^.)) import Argon.Formatters import Argon.Types +-- | Read the focus of a van Laarhoven lens. Inlined here so we don't need a +-- lens dependency just for 'Pipes.Group.chunksOf'. +view :: ((a -> Const a a) -> s -> Const a s) -> s -> a +view l s = getConst (l Const s) + + -- sortOn is built-in only in base 4.8.0.0 onwards sortOn :: Ord b => (a -> b) -> [a] -> [a] sortOn f = @@ -71,4 +77,4 @@ jsonStream :: (MonadIO m) jsonStream source = yield "[" *> intersperse' "," source <* yield "]\n" intersperse' :: Monad m => a -> Producer a m r -> Producer a m r -intersperse' a producer = intercalates (yield a) (producer ^. chunksOf 1) +intersperse' a producer = intercalates (yield a) (view (chunksOf 1) producer) diff --git a/src/Argon/SYB/Utils.hs b/src/Argon/SYB/Utils.hs index a225a99..9851a9e 100644 --- a/src/Argon/SYB/Utils.hs +++ b/src/Argon/SYB/Utils.hs @@ -1,17 +1,12 @@ --- The following code is temporarily taken from @alanz's fork of --- nominolo/ghc-syb. Argon will use the original ghc-syb when a new version --- is released on Hackage with @alanz's fixes. -{-# LANGUAGE CPP #-} +-- The following code is taken and modified from @alanz's fork of +-- nominolo/ghc-syb, vendored to avoid depending on ghc-syb-utils. {-# LANGUAGE RankNTypes #-} module Argon.SYB.Utils (Stage(..), everythingStaged) where -import GHC -import NameSet (NameSet) +import GHC.Types.Name.Set (NameSet) +import qualified GHC.Types.Fixity as GHC import Data.Generics -#if __GLASGOW_HASKELL__ <= 708 -import Coercion -#endif -- | Ghc Ast types tend to have undefined holes, to be filled @@ -23,20 +18,7 @@ data Stage = Parser | Renamer | TypeChecker deriving (Eq, Ord, Show) -- generated the Ast. everythingStaged :: Stage -> (r -> r -> r) -> r -> GenericQ r -> GenericQ r everythingStaged stage k z f x - | (const False -#if __GLASGOW_HASKELL__ <= 708 - `extQ` postTcType - `extQ` nameList - `extQ` coercion - `extQ` cmdTable -#endif - `extQ` fixity `extQ` nameSet) x = z + | (const False `extQ` fixity `extQ` nameSet) x = z | otherwise = foldl k (f x) (gmapQ (everythingStaged stage k z f) x) where nameSet = const (stage `elem` [Parser,TypeChecker]) :: NameSet -> Bool -#if __GLASGOW_HASKELL__ <= 708 - postTcType = const (stage < TypeChecker) :: PostTcType -> Bool - nameList = const (stage < TypeChecker) :: [Name] -> Bool - coercion = const (stage < TypeChecker) :: Coercion -> Bool - cmdTable = const (stage < TypeChecker) :: CmdSyntaxTable RdrName -> Bool -#endif fixity = const (stage < Renamer) :: GHC.Fixity -> Bool diff --git a/src/Argon/Types.hs b/src/Argon/Types.hs index d430923..bb72a99 100644 --- a/src/Argon/Types.hs +++ b/src/Argon/Types.hs @@ -1,5 +1,4 @@ {-# LANGUAGE CPP #-} -{-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-} #if __GLASGOW_HASKELL__ < 710 diff --git a/src/Argon/Visitor.hs b/src/Argon/Visitor.hs index 2d625bc..7903b35 100644 --- a/src/Argon/Visitor.hs +++ b/src/Argon/Visitor.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE CPP #-} module Argon.Visitor (funcsCC) where @@ -6,16 +5,17 @@ import Argon.SYB.Utils (Stage (..), everythingStaged) import Control.Arrow ((&&&)) import Data.Generics (Data, mkQ) -import qualified GHC -import qualified OccName as GHC -import qualified RdrName as GHC +import qualified GHC.Hs as GHC +import qualified GHC.Types.SrcLoc as GHC +import qualified GHC.Types.Name.Reader as GHC +import qualified GHC.Types.Name.Occurrence as GHC import Argon.Loc import Argon.Types (ComplexityBlock (..)) -type Exp = GHC.HsExpr GHC.RdrName -type Function = GHC.HsBindLR GHC.RdrName GHC.RdrName -type MatchBody = GHC.LHsExpr GHC.RdrName +type Exp = GHC.HsExpr GHC.GhcPs +type Function = GHC.HsBind GHC.GhcPs +type MatchBody = GHC.LHsExpr GHC.GhcPs -- | Compute cyclomatic complexity of every function binding in the given AST. @@ -30,8 +30,8 @@ getBinds = everythingStaged Parser (++) [] $ mkQ [] visit where visit fun@GHC.FunBind {} = [fun] visit _ = [] -getLocation :: GHC.Located a -> Loc -getLocation = srcSpanToLoc . GHC.getLoc +getLocation :: GHC.LIdP GHC.GhcPs -> Loc +getLocation = srcSpanToLoc . GHC.getLocA getFuncName :: Function -> String getFuncName = getName . GHC.unLoc . GHC.fun_id @@ -42,13 +42,13 @@ complexity f = let matches = getMatches f visit = uncurry (+) . (visitExp &&& visitOp) in length matches + sumWith getGRHSsFromMatch matches + sumWith query matches -getMatches :: Function -> [GHC.LMatch GHC.RdrName MatchBody] +getMatches :: Function -> [GHC.LMatch GHC.GhcPs MatchBody] getMatches = GHC.unLoc . GHC.mg_alts . GHC.fun_matches -getGRHSsFromMatch :: GHC.LMatch GHC.RdrName MatchBody -> Int +getGRHSsFromMatch :: GHC.LMatch GHC.GhcPs MatchBody -> Int getGRHSsFromMatch match = length (getGRHSs' match) - 1 where - getGRHSs' :: GHC.LMatch GHC.RdrName MatchBody -> [GHC.LGRHS GHC.RdrName MatchBody] + getGRHSs' :: GHC.LMatch GHC.GhcPs MatchBody -> [GHC.LGRHS GHC.GhcPs MatchBody] getGRHSs' = GHC.grhssGRHSs . GHC.m_grhss . GHC.unLoc getName :: GHC.RdrName -> String @@ -60,17 +60,15 @@ sumWith f = sum . map f visitExp :: Exp -> Int visitExp GHC.HsIf {} = 1 visitExp (GHC.HsMultiIf _ alts) = length alts - 1 -#if __GLASGOW_HASKELL__ < 802 -visitExp (GHC.HsCase _ alts) = length (GHC.unLoc . GHC.mg_alts $ alts) - 1 -visitExp (GHC.HsLamCase _ alts) = length (GHC.unLoc . GHC.mg_alts $ alts) - 1 -#else -visitExp (GHC.HsLamCase mg) = length (GHC.unLoc . GHC.mg_alts $ mg) - 1 -visitExp (GHC.HsCase _ mg) = length (GHC.unLoc . GHC.mg_alts $ mg) - 1 -#endif +visitExp (GHC.HsCase _ _ mg) = length (GHC.unLoc . GHC.mg_alts $ mg) - 1 +-- Since GHC 9.10 @\\case@/@\\cases@ are 'GHC.HsLam' tagged with a 'GHC.LamCase' +-- /'GHC.LamCases' variant; a plain @\\x -> e@ ('GHC.LamSingle') does not branch. +visitExp (GHC.HsLam _ GHC.LamCase mg) = length (GHC.unLoc . GHC.mg_alts $ mg) - 1 +visitExp (GHC.HsLam _ GHC.LamCases mg) = length (GHC.unLoc . GHC.mg_alts $ mg) - 1 visitExp _ = 0 visitOp :: Exp -> Int -visitOp (GHC.OpApp _ (GHC.L _ (GHC.HsVar op)) _ _) = +visitOp (GHC.OpApp _ _ (GHC.L _ (GHC.HsVar _ op)) _) = case getName (GHC.unLoc op) of "||" -> 1 "&&" -> 1 diff --git a/src/Argon/Walker.hs b/src/Argon/Walker.hs index b31c6ca..26156d1 100644 --- a/src/Argon/Walker.hs +++ b/src/Argon/Walker.hs @@ -1,34 +1,31 @@ -{-# LANGUAGE OverloadedStrings #-} module Argon.Walker (allFiles) where -import Data.DirStream (childOf) -import Data.List (isSuffixOf) -import Filesystem.Path.CurrentOS (decodeString, encodeString) -import Pipes (ListT, MonadIO, Producer, each, - every, liftIO, (>->)) -import qualified Pipes.Prelude as P -import Pipes.Safe -import System.Directory (doesDirectoryExist, doesFileExist, - pathIsSymbolicLink) -import System.FilePath (takeExtension) +import Control.Monad (forM_, when) +import Data.List (isSuffixOf) +import Pipes (MonadIO, Producer, liftIO, yield) +import System.Directory (doesDirectoryExist, doesFileExist, + listDirectory, pathIsSymbolicLink) +import System.FilePath (takeExtension, ()) -- | Starting from a path, generate a sequence of paths corresponding --- to Haskell files. The filesystem is traversed depth-first. -allFiles :: (MonadIO m, MonadSafe m) => FilePath -> Producer FilePath m () +-- to Haskell files. The filesystem is traversed depth-first. Symbolic links +-- are not followed. +allFiles :: MonadIO m => FilePath -> Producer FilePath m () allFiles path = do isFile <- liftIO $ doesFileExist path - if isFile then each [path] >-> P.filter (".hs" `isSuffixOf`) - else every $ hsFilesIn path + if isFile then when (".hs" `isSuffixOf` path) $ yield path + else walk path --- | List the regular files in a directory. -hsFilesIn :: MonadSafe m => FilePath -> ListT m FilePath -hsFilesIn path = do - child <- encodeString <$> childOf (decodeString path) - isDir <- liftIO $ doesDirectoryExist child - isSymLink <- liftIO $ pathIsSymbolicLink child - if isDir && not isSymLink - then hsFilesIn child - else if not isSymLink && takeExtension child == ".hs" - then return child - else mempty +-- | Recursively yield the @.hs@ files under a directory, depth-first. +walk :: MonadIO m => FilePath -> Producer FilePath m () +walk dir = do + entries <- liftIO $ listDirectory dir + forM_ entries $ \e -> do + let child = dir e + isSymLink <- liftIO $ pathIsSymbolicLink child + isDir <- liftIO $ doesDirectoryExist child + if isDir && not isSymLink + then walk child + else when (not isSymLink && takeExtension child == ".hs") $ + yield child diff --git a/stack-travis-coveralls.yaml b/stack-travis-coveralls.yaml deleted file mode 100644 index 4b79afd..0000000 --- a/stack-travis-coveralls.yaml +++ /dev/null @@ -1,8 +0,0 @@ -flags: {} -extra-package-dbs: [] -packages: -- '.' -extra-deps: -- stack-hpc-coveralls-0.0.0.3 -- docopt-0.7.0.4 -resolver: lts-3.11 diff --git a/stack.yaml b/stack.yaml deleted file mode 100644 index 6b097a3..0000000 --- a/stack.yaml +++ /dev/null @@ -1,4 +0,0 @@ -resolver: lts-11.6 - -extra-deps: [dirstream-1.0.3] - diff --git a/test/ArgonSpec.hs b/test/ArgonSpec.hs index cd29d49..61f4343 100644 --- a/test/ArgonSpec.hs +++ b/test/ArgonSpec.hs @@ -12,9 +12,9 @@ import Text.Printf (printf) #if __GLASGOW_HASKELL__ < 710 import Control.Applicative ((<$>), (<*>)) #endif -import qualified FastString as GHC +import qualified GHC.Data.FastString as GHC import Pipes (Producer, (>->), each) -import qualified SrcLoc as GHC +import qualified GHC.Types.SrcLoc as GHC import System.Console.ANSI (Color (..), ConsoleIntensity(BoldIntensity), setSGRCode, SGR(SetColor, SetConsoleIntensity), ConsoleLayer(Foreground), ColorIntensity(Dull)) @@ -104,6 +104,10 @@ spec = do "ifthenelse.hs" `shouldAnalyze` Right [CC (ones, "f", 2)] it "accounts for lambda case" $ "lambdacase.hs" `shouldAnalyze` Right [CC (lo 2, "g", 3)] + -- GHC 9.10 unified \case and \cases under HsLam; \cases is new syntax + -- with no pre-migration baseline, so each extra clause adds 1 (as \case). + it "accounts for multi-pattern lambda case (\\cases)" $ + "lambdacases.hs" `shouldAnalyze` Right [CC (lo 2, "g", 3)] it "accounts for multi way if" $ "multiif.hs" `shouldAnalyze` Right [CC (lo 2, "f", 4)] it "accounts for || operator" $ @@ -148,25 +152,19 @@ spec = do it "catches syntax errors" $ "syntaxerror.hs" `shouldContainErrors` ["parse error (possibly incorrect indentation or mismatched brackets)"] + -- The exact quoting around the offending token (`#' vs ‘#’) depends + -- on the renderer's unicode setting, so only match the stable text. it "catches syntax errors (missing CPP)" $ - "missingcpp.hs" `shouldAnalyze` -#if __GLASGOW_HASKELL__ < 800 - Left "1:2 lexical error at character 'i'" -#else - Left "1:1 parse error on input \8216#\8217" -#endif -#if __GLASGOW_HASKELL__ < 800 --- The analysis of "missingmacros.hs" will succeed in newest GHC versions. - it "catches syntax errors (missing cabal macros)" $ - "missingmacros.hs" `shouldContainErrors` - ["error: missing binary operator before token "] -#endif - it "catches syntax errors (missing include dir)" $ - "missingincluded.hs" `shouldContainErrors` - ["fatal error", "necessaryInclude.h"] - it "catches CPP parsing errors" $ - "cpp-error.hs" `shouldContainErrors` - ["error: unterminated"] + "missingcpp.hs" `shouldContainErrors` + ["1:1 parse error on input"] + describe "CPP edge cases" $ do + -- cpphs is more lenient than GHC's C preprocessor: instead of + -- aborting it warns and carries on, so Argon analyses the surviving + -- branch rather than reporting an error. + it "skips a missing #include and analyses the #else branch" $ + "missingincluded.hs" `shouldAnalyze` Right [CC (lo 10, "g", 1)] + it "tolerates an unterminated #if and analyses the #else branch" $ + "cpp-error.hs" `shouldAnalyze` Right [CC (lo 5, "f", 1)] describe "config" $ do it "reads default extensions from Cabal file" $ ("missingcpp.hs", unsafePerformIO @@ -298,7 +296,7 @@ spec = do describe "ToJSON instance" $ do it "is implemented by ComplexityResult" $ encode (CC ((1, 3), "f", 4)) `shouldBe` - "{\"complexity\":4,\"name\":\"f\",\"lineno\":1,\"col\":3}" + "{\"col\":3,\"complexity\":4,\"lineno\":1,\"name\":\"f\"}" it "is implemented by (FilePath, AnalysisResult)" $ encode ("f.hs" :: String, Right [] :: AnalysisResult) `shouldBe` @@ -306,7 +304,7 @@ spec = do it "is implemented by (FilePath, AnalysisResult) II" $ encode ("f.hs" :: String, Left "err" :: AnalysisResult) `shouldBe` - "{\"path\":\"f.hs\",\"type\":\"error\",\"message\":\"err\"}" + "{\"message\":\"err\",\"path\":\"f.hs\",\"type\":\"error\"}" #if 0 describe "Argon.Walker" $ describe "allFiles" $ do diff --git a/test/data/lambdacases.hs b/test/data/lambdacases.hs new file mode 100644 index 0000000..8154566 --- /dev/null +++ b/test/data/lambdacases.hs @@ -0,0 +1,5 @@ +{-# LANGUAGE LambdaCase #-} +g = \cases + 3 4 -> 4 + 2 5 -> 5 + _ _ -> 6