ghc-lib-parser-ex 8.10.0.24 → 9.0.0.0
raw patch · 22 files changed
+179/−558 lines, 22 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
- Language.Haskell.GhclibParserEx.GHC.Hs.Expr: isListComp :: HsStmtContext Name -> Bool
- Language.Haskell.GhclibParserEx.GHC.Hs.Expr: isMonadComp :: HsStmtContext Name -> Bool
- Language.Haskell.GhclibParserEx.GHC.Hs.Expr: isOverLabel :: LHsExpr GhcPs -> Bool
- Language.Haskell.GhclibParserEx.GHC.Hs.Expr: isQuasiQuoteExpr :: LHsExpr GhcPs -> Bool
- Language.Haskell.GhclibParserEx.GHC.Hs.Expr: isQuasiQuoteSplice :: HsSplice GhcPs -> Bool
- Language.Haskell.GhclibParserEx.GHC.Hs.Pat: isSplicePat :: LPat GhcPs -> Bool
- Language.Haskell.GhclibParserEx.GHC.Hs.Type: fromTyParen :: LHsType GhcPs -> LHsType GhcPs
- Language.Haskell.GhclibParserEx.GHC.Hs.Type: isKindTyApp :: LHsType GhcPs -> Bool
- Language.Haskell.GhclibParserEx.GHC.Hs.Type: isTyQuasiQuote :: LHsType GhcPs -> Bool
- Language.Haskell.GhclibParserEx.GHC.Hs.Type: isUnboxedTuple :: HsTupleSort -> Bool
+ Language.Haskell.GhclibParserEx.GHC.Hs.Types: fromTyParen :: LHsType GhcPs -> LHsType GhcPs
+ Language.Haskell.GhclibParserEx.GHC.Hs.Types: isTyQuasiQuote :: LHsType GhcPs -> Bool
+ Language.Haskell.GhclibParserEx.GHC.Hs.Types: isUnboxedTuple :: HsTupleSort -> Bool
Files
- ChangeLog.md +0/−88
- README.md +2/−2
- cbits/ghclib_api.h +5/−12
- ghc-lib-parser-ex.cabal +4/−4
- src/Language/Haskell/GhclibParserEx/Dump.hs +4/−7
- src/Language/Haskell/GhclibParserEx/Fixity.hs +18/−69
- src/Language/Haskell/GhclibParserEx/GHC/Driver/Flags.hs +1/−1
- src/Language/Haskell/GhclibParserEx/GHC/Driver/Session.hs +3/−11
- src/Language/Haskell/GhclibParserEx/GHC/Hs.hs +2/−2
- src/Language/Haskell/GhclibParserEx/GHC/Hs/Binds.hs +1/−1
- src/Language/Haskell/GhclibParserEx/GHC/Hs/Decls.hs +2/−2
- src/Language/Haskell/GhclibParserEx/GHC/Hs/Expr.hs +13/−69
- src/Language/Haskell/GhclibParserEx/GHC/Hs/ExtendInstances.hs +7/−4
- src/Language/Haskell/GhclibParserEx/GHC/Hs/ImpExp.hs +1/−1
- src/Language/Haskell/GhclibParserEx/GHC/Hs/Pat.hs +18/−48
- src/Language/Haskell/GhclibParserEx/GHC/Hs/Type.hs +0/−36
- src/Language/Haskell/GhclibParserEx/GHC/Hs/Types.hs +27/−4
- src/Language/Haskell/GhclibParserEx/GHC/Parser.hs +11/−26
- src/Language/Haskell/GhclibParserEx/GHC/Settings/Config.hs +8/−16
- src/Language/Haskell/GhclibParserEx/GHC/Types/Name/Reader.hs +2/−23
- src/Language/Haskell/GhclibParserEx/GHC/Utils/Outputable.hs +4/−1
- test/Test.hs +46/−131
ChangeLog.md view
@@ -1,93 +1,5 @@ # Changelog for ghc-lib-parser-ex -## 8.10.0.24 released-- Update to `ghc-lib-parser-8.10.7.20220219`--## 0.20220201 released-- Update to `ghc-lib-parser-0.20220201`--## 0.20220103 released-- New function `isOverLabel`-- Update to `ghc-lib-parser-0.20220103`--## 9.0.0.6 released 2021-12-26-- Add back `isQuasiQuote` for backwards compatibility--## 9.0.0.5 released 2021-12-25-- Bugfix to `isFieldPunUpdate`-- New module `Language.Haskell.GHC.Hs.Type.hs` to replace `Language.Haskell.GHC.Hs.Types.hs` (which remains for now but deprecated and will be removed in a future release)- - New function `isKindTyApp`-- Rename `isQuasiQuote` to `isQuasiQuoteExpr`-- Add new function `isQuasiQuoteSplice`-- Update to `ghc-lib-parser-9.0.2.20211226`--## 9.2.0.1 released 2021-11-01-- Update to `ghc-lib-parser-9.2.1.20211101`--## 0.20211101 released 2021-11-01-- Update to `ghc-lib-parser-0.20211101`--## 9.2.0.0 released 2021-10-30-- Update to `ghc-lib-parser-9.2.1.20211030`--## 0.20211001 released 2021-10-01-- Add `isSplicePat` to `Language.Haskell.GhclibParserEx.GHC.Hs.Pat`-- Use `genericPlatform` on `GHCLIB_API_HEAD` in `GhclibParserEx.GHC.Settings.Config.hs`-- Update to `ghc-lib-parser-0.20211001`--## 0.20210901 released 2021-09-01-- Update to `ghc-lib-parser-0.20210901`--## 8.10.0.23 released 2021-08-28-- Update to `ghc-lib-parser-8.10.7.20210828`--## 8.10.0.22 released 2021-08-14-- Update to `ghc-lib-parser-0.20210814`-- Added to `GhclibParserEx.GHC.Hs.Expr`:- - `isMonadComp`- - `isListComp`--## 0.20210701 released 2021-07-01-- Update to `ghc-lib-0.20210701`--## 8.10.0.21 released 2021-06-07-- Bugfix cabal files--## 8.10.0.20 released 2021-06-06-- Update to `ghc-lib-8.10.5.20210606`--## 0.20210601 released 2021-06-01-- Update to `ghc-lib-parser-0.20210601`-- Update types in `GHC.Types.Name.Reader` for ghc-9.2.1, `Located` becomes `LocatedN`--## 0.20210501 released 2021-05-01-- Update to `ghc-lib-0.20210501`--## 0.20210331 released 2021-02-31-- Update to `ghc-lib-0.20210331`-- Update to `ghc-lib-parser-9.0.1.20210324`--## 9.0.0.4 released 2021-03-11-- Bugfix for `GHC.Hs.Dump`--## 0.20210228 released 2021-02-28-- Update to `ghc-lib-0.20210228`--## 9.0.0.3 released 2021-02-08-- Cabal bugfix--## 9.0.0.2 released 2021-02-08-- Cabal bugfix--## 8.10.0.19 released 2021-02-08-- Cabal bugfix--## 8.10.0.18 released 2021-02-06-- Update to ghc-8.10.4.--## 9.0.0.1 released 2021-02-05-- Upgrade Cabal defaults flag to 9.0.1- ## 9.0.0.0 released 2021-02-05 - Update to ghc-9.0.1
README.md view
@@ -1,5 +1,5 @@ # ghc-lib-parser-ex [](http://opensource.org/licenses/BSD-3-Clause) [](https://hackage.haskell.org/package/ghc-lib-parser-ex) [](https://www.stackage.org/package/ghc-lib-parser-ex) [](https://shayne-fletcher.visualstudio.com/ghc-lib-parser-ex/_build/latest?definitionId=1&branchName=master)-Copyright © 2020-2021 Shayne Fletcher. All rights reserved.+Copyright © 2020, Shayne Fletcher. All rights reserved. SPDX-License-Identifier: BSD-3-Clause The `ghc-lib-parser-ex` package contains GHC API parse tree utilities. It works with or without [`ghc-lib-parser`](https://github.com/digital-asset/ghc-lib).@@ -27,7 +27,7 @@ ``` Run `stack runhaskell --package extra --package optparse-applicative CI.hs -- --help` for more options. -To run [`hlint`](https://github.com/ndmitchell/hlint) on this repository, `hlint --cpp-include cbits --cpp-define GHCLIB_API_XXX .` (where `XXX` at this time is one of `808`, `810`, `900`, `902` or `HEAD`).+To run [`hlint`](https://github.com/ndmitchell/hlint) on this repository, `hlint --cpp-include cbits --cpp-define GHCLIB_API_XXX .` (where `XXX` at this time is one of `808`, `810` or `900`). ## Releasing `ghc-lib-parser-ex` (notes for maintainers)
cbits/ghclib_api.h view
@@ -1,21 +1,15 @@ /*-Copyright (c) 2020, 2021 Shayne Fletcher. All rights reserved.-SPDX-License-Identifier: BSD-3-Clause.+Copyright (c) 2020, Shayne Fletcher. All rights+reserved. SPDX-License-Identifier: BSD-3-Clause. */ #if !defined(GHCLIB_API_H) # define GHCLIB_API_H -# if !(defined (GHCLIB_API_HEAD) \- || defined (GHCLIB_API_902) \- || defined (GHCLIB_API_900) \- || defined (GHCLIB_API_810) \- || defined (GHCLIB_API_808))+# if !defined (GHCLIB_API_HEAD) && !defined (GHCLIB_API_900) && !defined (GHCLIB_API_810) && !defined (GHCLIB_API_808) # if defined(MIN_VERSION_ghc_lib_parser) # if !MIN_VERSION_ghc_lib_parser( 1, 0, 0) # define GHCLIB_API_HEAD-# elif MIN_VERSION_ghc_lib_parser(9, 2, 0)-# define GHCLIB_API_902 # elif MIN_VERSION_ghc_lib_parser(9, 0, 0) # define GHCLIB_API_900 # elif MIN_VERSION_ghc_lib_parser(8, 10, 0)@@ -26,10 +20,8 @@ # error Unsupported GHC API version # endif # else-# if __GLASGOW_HASKELL__ == 903+# if __GLASGOW_HASKELL__ == 811 # define GHCLIB_API_HEAD-# elif __GLASGOW_HASKELL__ == 902-# define GHCLIB_API_902 # elif __GLASGOW_HASKELL__ == 900 # define GHCLIB_API_900 # elif __GLASGOW_HASKELL__ == 810@@ -41,4 +33,5 @@ # endif # endif # endif+ #endif
ghc-lib-parser-ex.cabal view
@@ -1,17 +1,18 @@-cabal-version: 1.18+cabal-version: >= 1.18 name: ghc-lib-parser-ex-version: 8.10.0.24+version: 9.0.0.0 description: Please see the README on GitHub at <https://github.com/shayne-fletcher/ghc-lib-parser-ex#readme> homepage: https://github.com/shayne-fletcher/ghc-lib-parser-ex#readme bug-reports: https://github.com/shayne-fletcher/ghc-lib-parser-ex/issues author: Shayne Fletcher maintainer: shayne@shaynefletcher.org-copyright: Copyright © 2020-2022 Shayne Fletcher. All rights reserved.+copyright: Copyright © 2020, Shayne Fletcher. All rights reserved. license: BSD3 license-file: LICENSE category: Development synopsis: Algorithms on GHC parse trees build-type: Simple+tested-with: GHC==8.8.2, GHC==8.6.5 extra-source-files: README.md ChangeLog.md@@ -41,7 +42,6 @@ Language.Haskell.GhclibParserEx.GHC.Hs Language.Haskell.GhclibParserEx.GHC.Hs.Expr Language.Haskell.GhclibParserEx.GHC.Hs.Pat- Language.Haskell.GhclibParserEx.GHC.Hs.Type Language.Haskell.GhclibParserEx.GHC.Hs.Types Language.Haskell.GhclibParserEx.GHC.Hs.Decls Language.Haskell.GhclibParserEx.GHC.Hs.Binds
src/Language/Haskell/GhclibParserEx/Dump.hs view
@@ -12,15 +12,12 @@ #include "ghclib_api.h" module Language.Haskell.GhclibParserEx.Dump( showAstData- , BlankSrcSpan(..)-#if defined(GHCLIB_API_HEAD) || defined(GHCLIB_API_902)- , BlankEpAnnotations(..)-#endif+ , BlankSrcSpan(..), ) where #if !defined(MIN_VERSION_ghc_lib_parser) -- Using native ghc.-# if defined (GHCLIB_API_HEAD) || defined(GHCLIB_API_902) || defined(GHCLIB_API_900) || defined (GHCLIB_API_810)+# if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_810) import GHC.Hs.Dump # else import HsDumpAst@@ -28,7 +25,7 @@ #else -- Using ghc-lib-parser. Recent versions will include -- GHC.Hs.Dump (it got moved in from ghc-lib on 2020-02-05).-# if defined (GHCLIB_API_HEAD) || defined(GHCLIB_API_902) || defined (GHCLIB_API_900) || defined (GHCLIB_API_810)+# if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_900) || defined (GHCLIB_API_810) import GHC.Hs.Dump # else -- For simplicity, just assume it's missing from 8.8 ghc-lib-parser@@ -43,7 +40,7 @@ import Name import DataCon import SrcLoc-#if defined (GHCLIB_API_HEAD) || defined(GHCLIB_API_902) || defined (GHCLIB_API_900) || defined (GHCLIB_API_810)+#if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_900) || defined (GHCLIB_API_810) import GHC.Hs #else import HsSyn
src/Language/Haskell/GhclibParserEx/Fixity.hs view
@@ -16,9 +16,9 @@ , infixr_, infixl_, infix_, fixity ) where -#if defined (GHCLIB_API_HEAD) || defined(GHCLIB_API_902) || defined (GHCLIB_API_900)+#if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_900) import GHC.Hs-#if defined (GHCLIB_API_HEAD) || defined(GHCLIB_API_902)+#if defined (GHCLIB_API_HEAD) import GHC.Types.Fixity import GHC.Types.SourceText #else@@ -44,7 +44,7 @@ import Data.Data hiding (Fixity) import Data.Generics.Uniplate.Data -#if defined (GHCLIB_API_900) || defined (GHCLIB_API_810)+#if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_900) || defined (GHCLIB_API_810) noExt :: NoExtField noExt = noExtField #endif@@ -64,7 +64,7 @@ -- LPat and Pat have gone through a lot of churn. See -- https://gitlab.haskell.org/ghc/ghc/merge_requests/1925 for details. patFix :: [(String, Fixity)] -> LPat GhcPs -> LPat GhcPs-#if defined (GHCLIB_API_HEAD) || defined(GHCLIB_API_902) || defined (GHCLIB_API_900)+#if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_900) patFix fixities (L loc (ConPat _ op (InfixCon pat1 pat2))) = L loc (mkConOpPat (getFixities fixities) op (findFixity' (getFixities fixities) op) pat1 pat2) #elif defined (GHCLIB_API_810)@@ -78,40 +78,29 @@ mkConOpPat :: [(String, Fixity)]-#if defined (GHCLIB_API_HEAD) || defined(GHCLIB_API_902)- -> LocatedN RdrName-#else- -> Located RdrName-#endif- -> Fixity+ -> Located RdrName -> Fixity -> LPat GhcPs -> LPat GhcPs -> Pat GhcPs-#if defined (GHCLIB_API_HEAD) || defined(GHCLIB_API_902) || defined (GHCLIB_API_900)+#if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_900) mkConOpPat fs op2 fix2 p1@(L loc (ConPat _ op1 (InfixCon p11 p12))) p2 #elif defined (GHCLIB_API_810) mkConOpPat fs op2 fix2 p1@(L loc (ConPatIn op1 (InfixCon p11 p12))) p2 #else mkConOpPat fs op2 fix2 p1@(dL->L loc (ConPatIn op1 (InfixCon p11 p12))) p2 #endif-#if defined (GHCLIB_API_HEAD) || defined(GHCLIB_API_902)- | nofix_error = ConPat noAnn op2 (InfixCon p1 p2)-#elif defined (GHCLIB_API_900)+#if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_900) | nofix_error = ConPat noExtField op2 (InfixCon p1 p2) #else | nofix_error = ConPatIn op2 (InfixCon p1 p2) #endif-#if defined (GHCLIB_API_HEAD) || defined(GHCLIB_API_902)- | associate_right = ConPat noAnn op1 (InfixCon p11 (L loc (mkConOpPat fs op2 fix2 p12 p2)))-#elif defined (GHCLIB_API_900)+#if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_900) | associate_right = ConPat noExtField op1 (InfixCon p11 (L loc (mkConOpPat fs op2 fix2 p12 p2))) #elif defined (GHCLIB_API_810) | associate_right = ConPatIn op1 (InfixCon p11 (L loc (mkConOpPat fs op2 fix2 p12 p2))) #else | associate_right = ConPatIn op1 (InfixCon p11 (cL loc (mkConOpPat fs op2 fix2 p12 p2))) #endif-#if defined (GHCLIB_API_HEAD) || defined(GHCLIB_API_902)- | otherwise = ConPat noAnn op2 (InfixCon p1 p2)-#elif defined (GHCLIB_API_900)+#if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_900) | otherwise = ConPat noExtField op2 (InfixCon p1 p2) #else | otherwise = ConPatIn op2 (InfixCon p1 p2)@@ -119,75 +108,41 @@ where fix1 = findFixity' fs op1 (nofix_error, associate_right) = compareFixity fix1 fix2-#if defined (GHCLIB_API_HEAD) || defined(GHCLIB_API_902)-mkConOpPat _ op _ p1 p2 = ConPat noAnn op (InfixCon p1 p2)-#elif defined (GHCLIB_API_900)+#if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_900) mkConOpPat _ op _ p1 p2 = ConPat noExtField op (InfixCon p1 p2) #else mkConOpPat _ op _ p1 p2 = ConPatIn op (InfixCon p1 p2) #endif mkOpApp ::- [(String, Fixity)]-#if defined(GHCLIB_API_HEAD) || defined(GHCLIB_API_902)- -> SrcSpanAnnA-#else- -> SrcSpan-#endif- -> LHsExpr GhcPs -- Left operand; already rearrange.- -> LHsExpr GhcPs -> Fixity -- Operator and fixity.- -> LHsExpr GhcPs -- Right operand (not an OpApp, but might be a NegApp).- -> LHsExpr GhcPs+ [(String, Fixity)]+ -> SrcSpan+ -> LHsExpr GhcPs -- Left operand; already rearrange.+ -> LHsExpr GhcPs -> Fixity -- Operator and fixity.+ -> LHsExpr GhcPs -- Right operand (not an OpApp, but might be a NegApp).+ -> LHsExpr GhcPs -- (e11 `op1` e12) `op2` e2 mkOpApp fs loc e1@(L _ (OpApp x1 e11 op1 e12)) op2 fix2 e2-#if defined (GHCLIB_API_HEAD) || defined(GHCLIB_API_902)- | nofix_error = L loc (OpApp noAnn e1 op2 e2)-#else | nofix_error = L loc (OpApp noExt e1 op2 e2)-#endif | associate_right = L loc (OpApp x1 e11 op1 (mkOpApp fs loc' e12 op2 fix2 e2 )) where-#if defined (GHCLIB_API_HEAD) || defined(GHCLIB_API_902)- loc'= combineLocsA e12 e2-#else loc'= combineLocs e12 e2-#endif fix1 = findFixity fs op1 (nofix_error, associate_right) = compareFixity fix1 fix2 -- (- neg_arg) `op` e2 mkOpApp fs loc e1@(L _ (NegApp _ neg_arg neg_name)) op2 fix2 e2-#if defined(GHCLIB_API_HEAD) || defined(GHCLIB_API_902)- | nofix_error = L loc (OpApp noAnn e1 op2 e2)-#else | nofix_error = L loc (OpApp noExt e1 op2 e2)-#endif-#if defined(GHCLIB_API_HEAD) || defined(GHCLIB_API_902)- | associate_right = L loc (NegApp noAnn (mkOpApp fs loc' neg_arg op2 fix2 e2) neg_name)-#else | associate_right = L loc (NegApp noExt (mkOpApp fs loc' neg_arg op2 fix2 e2) neg_name)-#endif where-#if defined (GHCLIB_API_HEAD) || defined(GHCLIB_API_902)- loc' = combineLocsA neg_arg e2-#else loc' = combineLocs neg_arg e2-#endif (nofix_error, associate_right) = compareFixity negateFixity fix2 -- e1 `op` - neg_arg mkOpApp _ loc e1 op1 fix1 e2@(L _ NegApp {}) -- NegApp can occur on the right.-#if defined(GHCLIB_API_HEAD) || defined(GHCLIB_API_902)- | not associate_right = L loc (OpApp noAnn e1 op1 e2)-- We *want* right association.-#else | not associate_right = L loc (OpApp noExt e1 op1 e2)-- We *want* right association.-#endif where (_, associate_right) = compareFixity fix1 negateFixity -- Default case, no rearrangment.-#if defined(GHCLIB_API_HEAD) || defined(GHCLIB_API_902)-mkOpApp _ loc e1 op _fix e2 = L loc (OpApp noAnn e1 op e2)-#else mkOpApp _ loc e1 op _fix e2 = L loc (OpApp noExt e1 op e2)-#endif getIdent :: LHsExpr GhcPs -> String getIdent (unLoc -> HsVar _ (L _ n)) = occNameString . rdrNameOcc $ n@@ -200,11 +155,7 @@ findFixity :: [(String, Fixity)] -> LHsExpr GhcPs -> Fixity findFixity fs r = askFix fs (getIdent r) -- Expressions. -#if defined(GHCLIB_API_HEAD) || defined(GHCLIB_API_902)-findFixity' :: [(String, Fixity)] -> LocatedN RdrName -> Fixity-#else findFixity' :: [(String, Fixity)] -> Located RdrName -> Fixity-#endif findFixity' fs r = askFix fs (occNameString . rdrNameOcc . unLoc $ r) -- Patterns. askFix :: [(String, Fixity)] -> String -> Fixity@@ -262,14 +213,12 @@ fixity :: FixityDirection -> Int -> [String] -> [(String, Fixity)] fixity a p = map (,Fixity (SourceText "") p a) -#if defined (GHCLIB_API_HEAD) || defined(GHCLIB_API_902) || defined (GHCLIB_API_900)+#if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_900) fixitiesFromModule :: Located HsModule -> [(String, Fixity)] #else fixitiesFromModule :: Located (HsModule GhcPs) -> [(String, Fixity)] #endif-#if defined (GHCLIB_API_HEAD) || defined(GHCLIB_API_902)-fixitiesFromModule (L _ (HsModule _ _ _ _ _ decls _ _)) = concatMap f decls-#elif defined (GHCLIB_API_900)+#if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_900) fixitiesFromModule (L _ (HsModule _ _ _ _ decls _ _)) = concatMap f decls #else fixitiesFromModule (L _ (HsModule _ _ _ decls _ _)) = concatMap f decls
src/Language/Haskell/GhclibParserEx/GHC/Driver/Flags.hs view
@@ -3,7 +3,7 @@ #include "ghclib_api.h" module Language.Haskell.GhclibParserEx.GHC.Driver.Flags () where -#if !(defined (GHCLIB_API_HEAD) || defined(GHCLIB_API_902) || defined (GHCLIB_API_900))+#if !defined (GHCLIB_API_HEAD) && !defined (GHCLIB_API_900) import DynFlags #endif
src/Language/Haskell/GhclibParserEx/GHC/Driver/Session.hs view
@@ -17,12 +17,12 @@ #if defined (GHCLIB_API_808) || defined (GHCLIB_API_810) import qualified GHC.LanguageExtensions as LangExt #endif-#if defined (GHCLIB_API_HEAD) || defined(GHCLIB_API_902) || defined (GHCLIB_API_900)+#if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_900) import GHC.Utils.Panic import GHC.Parser.Header import GHC.Data.StringBuffer import GHC.Driver.Session-#if defined (GHCLIB_API_HEAD) || defined(GHCLIB_API_902)+#if defined (GHCLIB_API_HEAD) import GHC.Types.SourceError #else import GHC.Driver.Types@@ -44,9 +44,6 @@ instance Ord Extension where compare = compare `on` fromEnum #endif-#if defined (GHCLIB_API_HEAD)-import GHC.Driver.Config.Parser-#endif -- | Parse a GHC extension. readExtension :: String -> Maybe Extension@@ -161,12 +158,7 @@ -> IO (Either String DynFlags) parsePragmasIntoDynFlags flags (enable, disable) file str = catchErrors $ do- let opts =-#if defined (GHCLIB_API_HEAD)- getOptions (initParserOpts flags) (stringToStringBuffer str) file-#else- getOptions flags (stringToStringBuffer str) file-#endif+ let opts = getOptions flags (stringToStringBuffer str) file -- Important : apply enables, disables *before* parsing dynamic -- file pragmas. let flags' = foldl' xopt_set flags enable
src/Language/Haskell/GhclibParserEx/GHC/Hs.hs view
@@ -9,7 +9,7 @@ ) where -#if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_902) || defined (GHCLIB_API_900)+#if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_900) import GHC.Hs import GHC.Unit.Module import GHC.Types.SrcLoc@@ -23,7 +23,7 @@ import SrcLoc #endif -#if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_902) || defined (GHCLIB_API_900)+#if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_900) modName :: Located HsModule -> String #else modName :: Located (HsModule GhcPs) -> String
src/Language/Haskell/GhclibParserEx/GHC/Hs/Binds.hs view
@@ -7,7 +7,7 @@ ) where -#if defined (GHCLIB_API_HEAD) || defined(GHCLIB_API_902) || defined (GHCLIB_API_900) || defined (GHCLIB_API_810)+#if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_900) || defined (GHCLIB_API_810) import GHC.Hs.Binds import GHC.Hs.Extension #else
src/Language/Haskell/GhclibParserEx/GHC/Hs/Decls.hs view
@@ -7,12 +7,12 @@ isNewType, isForD, isDerivD, isClsDefSig ) where -#if defined (GHCLIB_API_HEAD) || defined(GHCLIB_API_902) || defined (GHCLIB_API_900) || defined (GHCLIB_API_810)+#if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_900) || defined (GHCLIB_API_810) import GHC.Hs #else import HsSyn #endif-#if defined (GHCLIB_API_HEAD) || defined(GHCLIB_API_902) || defined (GHCLIB_API_900)+#if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_900) import GHC.Types.SrcLoc #else import SrcLoc
src/Language/Haskell/GhclibParserEx/GHC/Hs/Expr.hs view
@@ -7,22 +7,22 @@ #include "ghclib_api.h" module Language.Haskell.GhclibParserEx.GHC.Hs.Expr( isTag, isDol, isDot, isReturn, isSection, isRecConstr, isRecUpdate,- isVar, isPar, isApp, isOpApp, isAnyApp, isLexeme, isLambda, isQuasiQuote, isQuasiQuoteExpr, isQuasiQuoteSplice, isOverLabel,+ isVar, isPar, isApp, isOpApp, isAnyApp, isLexeme, isLambda, isQuasiQuote, isDotApp, isTypeApp, isWHNF, isLCase,- isFieldPun, isFieldPunUpdate, isRecStmt, isParComp, isMDo, isListComp, isMonadComp, isTupleSection, isString, isPrimLiteral,+ isFieldPun, isFieldPunUpdate, isRecStmt, isParComp, isMDo, isTupleSection, isString, isPrimLiteral, isSpliceDecl, isFieldWildcard, isUnboxed, isWholeFrac, isStrictMatch, isMultiIf, isProc, isTransStmt, hasFieldsDotDot, varToStr, strToVar, fromChar ) where -#if defined (GHCLIB_API_HEAD) || defined(GHCLIB_API_902) || defined (GHCLIB_API_900) || defined (GHCLIB_API_810)+#if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_900) || defined (GHCLIB_API_810) import GHC.Hs #else import HsSyn #endif-#if defined (GHCLIB_API_HEAD) || defined(GHCLIB_API_902) || defined (GHCLIB_API_900)-#if defined (GHCLIB_API_HEAD) || defined(GHCLIB_API_902)+#if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_900)+#if defined (GHCLIB_API_HEAD) import GHC.Types.SourceText #endif import GHC.Types.SrcLoc@@ -45,8 +45,8 @@ isTag tag = \case (L _ (HsVar _ (L _ s))) -> occNameString (rdrNameOcc s) == tag; _ -> False isDot, isDol, isReturn, isSection, isRecConstr, isRecUpdate,- isVar, isPar, isApp, isOpApp, isAnyApp, isLexeme, isQuasiQuote, isQuasiQuoteExpr,- isLambda, isDotApp, isTypeApp, isWHNF, isLCase, isOverLabel :: LHsExpr GhcPs -> Bool+ isVar, isPar, isApp, isOpApp, isAnyApp, isLexeme, isQuasiQuote,+ isLambda, isDotApp, isTypeApp, isWHNF, isLCase :: LHsExpr GhcPs -> Bool isDol = isTag "$" isDot = isTag "." isReturn x = isTag "return" x || isTag "pure" x -- Allow both 'pure' and 'return' as they have the same semantics.@@ -60,8 +60,7 @@ isAnyApp x = isApp x || isOpApp x isLexeme = \case (L _ HsVar{}) -> True; (L _ HsOverLit{}) -> True; (L _ HsLit{}) -> True; _ -> False isLambda = \case (L _ HsLam{}) -> True; _ -> False-isQuasiQuoteExpr = \case (L _ (HsSpliceE _ HsQuasiQuote{})) -> True; _ -> False-isQuasiQuote = isQuasiQuoteExpr -- Backwards compat.+isQuasiQuote = \case (L _ (HsSpliceE _ HsQuasiQuote{})) -> True; _ -> False isDotApp = \case (L _ (OpApp _ _ op _)) -> isDot op; _ -> False isTypeApp = \case (L _ HsAppType{}) -> True; _ -> False isWHNF = \case@@ -70,11 +69,7 @@ (L _ HsLam{}) -> True (L _ ExplicitTuple{}) -> True (L _ ExplicitList{}) -> True-#if defined (GHCLIB_API_HEAD)- (L _ (HsPar _ _ x _)) -> isWHNF x-#else (L _ (HsPar _ x)) -> isWHNF x-#endif (L _ (ExprWithTySig _ x _)) -> isWHNF x -- Other (unknown) constructors may have bang patterns in them, so -- approximate.@@ -82,12 +77,8 @@ | occNameString (rdrNameOcc x) `elem` ["Just", "Left", "Right"] -> True _ -> False isLCase = \case (L _ HsLamCase{}) -> True; _ -> False-isOverLabel = \case (L _ HsOverLabel{}) -> True; _ -> False -isQuasiQuoteSplice :: HsSplice GhcPs -> Bool-isQuasiQuoteSplice = \case HsQuasiQuote{} -> True; _ -> False--#if defined (GHCLIB_API_HEAD) || defined(GHCLIB_API_902) || defined (GHCLIB_API_901)+#if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_901) isStrictMatch :: HsMatchContext GhcPs -> Bool #else isStrictMatch :: HsMatchContext RdrName -> Bool@@ -95,22 +86,13 @@ isStrictMatch = \case FunRhs{mc_strictness=SrcStrict} -> True; _ -> False -- Field is punned e.g. '{foo}'.-#if defined (GHCLIB_API_HEAD)-isFieldPun :: LHsFieldBind GhcPs (LFieldOcc GhcPs) (LHsExpr GhcPs) -> Bool-isFieldPun = \case (L _ HsFieldBind {hfbPun=True}) -> True; _ -> False-#else isFieldPun :: LHsRecField GhcPs (LHsExpr GhcPs) -> Bool isFieldPun = \case (L _ HsRecField {hsRecPun=True}) -> True; _ -> False-#endif+ -- Field puns in updates have a different type to field puns in -- constructions.-#if defined (GHCLIB_API_HEAD)-isFieldPunUpdate :: HsFieldBind (LAmbiguousFieldOcc GhcPs) (LHsExpr GhcPs) -> Bool-isFieldPunUpdate = \case HsFieldBind {hfbPun=True} -> True; _ -> False-#else isFieldPunUpdate :: HsRecField' (AmbiguousFieldOcc GhcPs) (LHsExpr GhcPs) -> Bool isFieldPunUpdate = \case HsRecField {hsRecPun=True} -> True; _ -> False-#endif -- Contains a '..' as in 'Foo{..}' hasFieldsDotDot :: HsRecFields GhcPs (LHsExpr GhcPs) -> Bool@@ -122,28 +104,12 @@ isParComp :: StmtLR GhcPs GhcPs (LHsExpr GhcPs) -> Bool isParComp = \case ParStmt{} -> True; _ -> False --- TODO: Seems `HsStmtContext (HsDoRn p)` on master right now.-#if defined (GHCLIB_API_HEAD)-isMDo :: HsDoFlavour -> Bool-isMDo = \case MDoExpr _ -> True; _ -> False-isMonadComp :: HsDoFlavour -> Bool-isMonadComp = \case MonadComp -> True; _ -> False-isListComp :: HsDoFlavour -> Bool-isListComp = \case ListComp -> True; _ -> False-#elif defined(GHCLIB_API_902) || defined (GHCLIB_API_900)+#if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_900) isMDo :: HsStmtContext GhcRn -> Bool isMDo = \case MDoExpr _ -> True; _ -> False-isMonadComp :: HsStmtContext GhcRn -> Bool-isMonadComp = \case MonadComp -> True; _ -> False-isListComp :: HsStmtContext GhcRn -> Bool-isListComp = \case ListComp -> True; _ -> False #else isMDo :: HsStmtContext Name -> Bool isMDo = \case MDoExpr -> True; _ -> False-isMonadComp :: HsStmtContext Name -> Bool-isMonadComp = \case MonadComp -> True; _ -> False-isListComp :: HsStmtContext Name -> Bool-isListComp = \case ListComp -> True; _ -> False #endif isTupleSection :: HsTupArg GhcPs -> Bool@@ -177,44 +143,24 @@ isTransStmt = \case TransStmt{} -> True; _ -> False -- Field has a '_' as in '{foo=_} or is punned e.g. '{foo}'.-#if defined (GHCLIB_API_HEAD)-isFieldWildcard :: LHsFieldBind GhcPs (LFieldOcc GhcPs) (LHsExpr GhcPs) -> Bool-#else isFieldWildcard :: LHsRecField GhcPs (LHsExpr GhcPs) -> Bool-#endif isFieldWildcard = \case-#if defined (GHCLIB_API_HEAD)- (L _ HsFieldBind {hfbRHS=(L _ (HsUnboundVar _ s))}) -> occNameString s == "_"-#elif defined(GHCLIB_API_902) || defined (GHCLIB_API_900)+#if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_900) (L _ HsRecField {hsRecFieldArg=(L _ (HsUnboundVar _ s))}) -> occNameString s == "_" #elif defined (GHCLIB_API_810) (L _ HsRecField {hsRecFieldArg=(L _ (HsUnboundVar _ _))}) -> True #else (L _ HsRecField {hsRecFieldArg=(L _ (EWildPat _))}) -> True #endif-#if defined (GHCLIB_API_HEAD)- (L _ HsFieldBind {hfbPun=True}) -> True- (L _ HsFieldBind {}) -> False-#else (L _ HsRecField {hsRecPun=True}) -> True (L _ HsRecField {}) -> False-#endif isUnboxed :: Boxity -> Bool isUnboxed = \case Unboxed -> True; _ -> False isWholeFrac :: HsExpr GhcPs -> Bool--#if defined (GHCLIB_API_HEAD)-isWholeFrac (HsLit _ (HsRat _ fl@FL{} _)) = denominator (rationalFromFractionalLit fl) == 1-isWholeFrac (HsOverLit _ (OverLit _ (HsFractional fl@FL {}) )) = denominator (rationalFromFractionalLit fl) == 1-#elif defined(GHCLIB_API_902)-isWholeFrac (HsLit _ (HsRat _ fl@FL{} _)) = denominator (rationalFromFractionalLit fl) == 1-isWholeFrac (HsOverLit _ (OverLit _ (HsFractional fl@FL {}) _)) = denominator (rationalFromFractionalLit fl) == 1-#else isWholeFrac (HsLit _ (HsRat _ (FL _ _ v) _)) = denominator v == 1 isWholeFrac (HsOverLit _ (OverLit _ (HsFractional (FL _ _ v)) _)) = denominator v == 1-#endif isWholeFrac _ = False varToStr :: LHsExpr GhcPs -> String@@ -226,9 +172,7 @@ varToStr _ = "" strToVar :: String -> LHsExpr GhcPs-#if defined (GHCLIB_API_HEAD) || defined(GHCLIB_API_902)-strToVar x = noLocA $ HsVar noExtField (noLocA $ mkRdrUnqual (mkVarOcc x))-#elif defined (GHCLIB_API_900) || defined (GHCLIB_API_810)+#if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_900) || defined (GHCLIB_API_810) strToVar x = noLoc $ HsVar noExtField (noLoc $ mkRdrUnqual (mkVarOcc x)) #else strToVar x = noLoc $ HsVar noExt (noLoc $ mkRdrUnqual (mkVarOcc x))
src/Language/Haskell/GhclibParserEx/GHC/Hs/ExtendInstances.hs view
@@ -18,8 +18,11 @@ -- representations rather than the terms themselves, leads to -- identical results. -#if defined (GHCLIB_API_HEAD) || defined(GHCLIB_API_902) || defined (GHCLIB_API_900)+#if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_900) import GHC.Utils.Outputable+# if !defined(GHCLIB_API_900)+import GHC.Driver.Ppr+# endif #else import Outputable #endif@@ -39,8 +42,8 @@ -- string representations. toStr :: Data a => HsExtendInstances a -> String toStr (HsExtendInstances e) =-#if defined(GHCLIB_API_HEAD) || defined(GHCLIB_API_902)- showPprUnsafe $ showAstData BlankSrcSpan BlankEpAnnotations e+#if defined(GHCLIB_API_HEAD)+ showPprUnsafe $ showAstData BlankSrcSpan e #else showSDocUnsafe $ showAstData BlankSrcSpan e #endif@@ -57,7 +60,7 @@ -- Use 'ppr' for 'Show'. instance Outputable a => Show (HsExtendInstances a) where show (HsExtendInstances e) =-#if defined(GHCLIB_API_HEAD) || defined(GHCLIB_API_902)+#if defined(GHCLIB_API_HEAD) showPprUnsafe $ ppr e #else showSDocUnsafe $ ppr e
src/Language/Haskell/GhclibParserEx/GHC/Hs/ImpExp.hs view
@@ -14,7 +14,7 @@ ) where -#if defined (GHCLIB_API_HEAD) || defined(GHCLIB_API_902) || defined (GHCLIB_API_900)+#if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_900) import GHC.Hs.ImpExp import GHC.Types.Name.Reader #elif defined (GHCLIB_API_810)
src/Language/Haskell/GhclibParserEx/GHC/Hs/Pat.hs view
@@ -9,15 +9,14 @@ , fromPChar , hasPFieldsDotDot , isPFieldWildcard, isPWildcard, isPFieldPun, isPatTypeSig, isPBangPat, isPViewPat- , isSplicePat ) where -#if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_902) || defined (GHCLIB_API_900) || defined (GHCLIB_API_810)+#if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_900) || defined (GHCLIB_API_810) import GHC.Hs #else import HsSyn #endif-#if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_902) || defined (GHCLIB_API_900)+#if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_900) import GHC.Types.SrcLoc import GHC.Builtin.Types import GHC.Types.Name.Reader@@ -32,7 +31,7 @@ #endif patToStr :: LPat GhcPs -> String-#if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_902)+#if defined (GHCLIB_API_HEAD) patToStr (L _ (ConPat _ (L _ x) (PrefixCon [] []))) | occNameString (rdrNameOcc x) == "True" = "True" patToStr (L _ (ConPat _ (L _ x) (PrefixCon [] []))) | occNameString (rdrNameOcc x) == "False" = "False" patToStr (L _ (ConPat _ (L _ x) (PrefixCon [] []))) | occNameString (rdrNameOcc x) == "[]" = "[]"@@ -57,55 +56,47 @@ strToPat :: String -> LPat GhcPs strToPat z | z == "True" =-#if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_902)- noLocA $-#elif defined (GHCLIB_API_900) || defined (GHCLIB_API_810)+#if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_900) || defined (GHCLIB_API_810) noLoc $ #endif-#if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_902)- ConPat noAnn (noLocA true_RDR) (PrefixCon [] [])+#if defined (GHCLIB_API_HEAD)+ ConPat noExtField (noLoc true_RDR) (PrefixCon [] []) #elif defined (GHCLIB_API_900) ConPat noExtField (noLoc true_RDR) (PrefixCon []) #else ConPatIn (noLoc true_RDR) (PrefixCon []) #endif | z == "False" =-#if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_902)- noLocA $-#elif defined (GHCLIB_API_900) || defined (GHCLIB_API_810)+#if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_900) || defined (GHCLIB_API_810) noLoc $ #endif-#if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_902)- ConPat noAnn (noLocA false_RDR) (PrefixCon [] [])+#if defined (GHCLIB_API_HEAD)+ ConPat noExtField (noLoc false_RDR) (PrefixCon [] []) #elif defined (GHCLIB_API_900) ConPat noExtField (noLoc false_RDR) (PrefixCon []) #else ConPatIn (noLoc false_RDR) (PrefixCon []) #endif | z == "[]" =-#if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_902)- noLocA $-#elif defined (GHCLIB_API_900) || defined (GHCLIB_API_810)+#if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_900) || defined (GHCLIB_API_810) noLoc $ #endif-#if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_902)- ConPat noAnn (noLocA $ nameRdrName nilDataConName) (PrefixCon [] [])+#if defined (GHCLIB_API_HEAD)+ ConPat noExtField (noLoc $ nameRdrName nilDataConName) (PrefixCon [] []) #elif defined (GHCLIB_API_900) ConPat noExtField (noLoc $ nameRdrName nilDataConName) (PrefixCon []) #else ConPatIn (noLoc $ nameRdrName nilDataConName) (PrefixCon []) #endif | otherwise =-#if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_902)- noLocA $ VarPat noExtField (noLocA $ mkVarUnqual (fsLit z))-#elif defined (GHCLIB_API_900) || defined (GHCLIB_API_810)+#if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_900) || defined (GHCLIB_API_810) noLoc $ VarPat noExtField (noLoc $ mkVarUnqual (fsLit z)) #else VarPat noExt (noLoc $ mkVarUnqual (fsLit z)) #endif fromPChar :: LPat GhcPs -> Maybe Char-#if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_902) || defined (GHCLIB_API_900) || defined (GHCLIB_API_810)+#if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_900) || defined (GHCLIB_API_810) fromPChar (L _ (LitPat _ (HsChar _ x))) = Just x #else fromPChar (dL -> L _ (LitPat _ (HsChar _ x))) = Just x@@ -118,16 +109,8 @@ hasPFieldsDotDot _ = False -- Field has a '_' as in '{foo=_} or is punned e.g. '{foo}'.-#if defined (GHCLIB_API_HEAD)-isPFieldWildcard :: LHsFieldBind GhcPs (LFieldOcc GhcPs) (LPat GhcPs) -> Bool-#else isPFieldWildcard :: LHsRecField GhcPs (LPat GhcPs) -> Bool-#endif-#if defined (GHCLIB_API_HEAD)-isPFieldWildcard (L _ HsFieldBind {hfbRHS=L _ WildPat {}}) = True-isPFieldWildcard (L _ HsFieldBind {hfbPun=True}) = True-isPFieldWildcard (L _ HsFieldBind {}) = False-#elif defined (GHCLIB_API_902) || defined (GHCLIB_API_900) || defined (GHCLIB_API_810)+#if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_900) || defined (GHCLIB_API_810) isPFieldWildcard (L _ HsRecField {hsRecFieldArg=L _ WildPat {}}) = True isPFieldWildcard (L _ HsRecField {hsRecPun=True}) = True isPFieldWildcard (L _ HsRecField {}) = False@@ -138,21 +121,15 @@ #endif isPWildcard :: LPat GhcPs -> Bool-#if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_902) || defined (GHCLIB_API_900) || defined (GHCLIB_API_810)+#if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_900) || defined (GHCLIB_API_810) isPWildcard (L _ (WildPat _)) = True #else isPWildcard (dL -> L _ (WildPat _)) = True #endif isPWildcard _ = False -#if defined (GHCLIB_API_HEAD)-isPFieldPun :: LHsFieldBind GhcPs (LFieldOcc GhcPs) (LPat GhcPs) -> Bool-#else isPFieldPun :: LHsRecField GhcPs (LPat GhcPs) -> Bool-#endif-#if defined (GHCLIB_API_HEAD)-isPFieldPun (L _ HsFieldBind {hfbPun=True}) = True-#elif defined (GHCLIB_API_902) || defined (GHCLIB_API_900) || defined (GHCLIB_API_810)+#if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_900) || defined (GHCLIB_API_810) isPFieldPun (L _ HsRecField {hsRecPun=True}) = True #else isPFieldPun (dL -> L _ HsRecField {hsRecPun=True}) = True@@ -160,7 +137,7 @@ isPFieldPun _ = False isPatTypeSig, isPBangPat, isPViewPat :: LPat GhcPs -> Bool-#if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_902) || defined (GHCLIB_API_900) || defined (GHCLIB_API_810)+#if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_900) || defined (GHCLIB_API_810) isPatTypeSig (L _ SigPat{}) = True; isPatTypeSig _ = False isPBangPat (L _ BangPat{}) = True; isPBangPat _ = False isPViewPat (L _ ViewPat{}) = True; isPViewPat _ = False@@ -168,11 +145,4 @@ isPatTypeSig (dL -> L _ SigPat{}) = True; isPatTypeSig _ = False isPBangPat (dL -> L _ BangPat{}) = True; isPBangPat _ = False isPViewPat (dL -> L _ ViewPat{}) = True; isPViewPat _ = False-#endif--isSplicePat :: LPat GhcPs -> Bool-#if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_902) || defined (GHCLIB_API_900) || defined (GHCLIB_API_810)-isSplicePat (L _ SplicePat{}) = True; isSplicePat _ = False-#else-isSplicePat (dL -> L _ SplicePat{}) = True; isSplicePat _ = False #endif
− src/Language/Haskell/GhclibParserEx/GHC/Hs/Type.hs
@@ -1,36 +0,0 @@--- Copyright (c) 2021, Shayne Fletcher. All rights reserved.--- SPDX-License-Identifier: BSD-3-Clause.--{-# LANGUAGE CPP #-}-{-# LANGUAGE LambdaCase #-}-#include "ghclib_api.h"-module Language.Haskell.GhclibParserEx.GHC.Hs.Type (- fromTyParen- , isTyQuasiQuote, isUnboxedTuple, isKindTyApp-) where--#if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_902) || defined (GHCLIB_API_900) || defined (GHCLIB_API_810)-import GHC.Hs-#else-import HsSyn-#endif-#if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_902) || defined (GHCLIB_API_900)-import GHC.Types.SrcLoc-#else-import SrcLoc-#endif--isKindTyApp :: LHsType GhcPs -> Bool-isKindTyApp = \case (L _ HsAppKindTy{}) -> True; _ -> False--fromTyParen :: LHsType GhcPs -> LHsType GhcPs-fromTyParen (L _ (HsParTy _ x)) = x-fromTyParen x = x--isTyQuasiQuote :: LHsType GhcPs -> Bool-isTyQuasiQuote (L _ (HsSpliceTy _ HsQuasiQuote{})) = True-isTyQuasiQuote _ = False--isUnboxedTuple :: HsTupleSort -> Bool-isUnboxedTuple HsUnboxedTuple = True-isUnboxedTuple _ = False
src/Language/Haskell/GhclibParserEx/GHC/Hs/Types.hs view
@@ -1,9 +1,32 @@ -- Copyright (c) 2020, Shayne Fletcher. All rights reserved. -- SPDX-License-Identifier: BSD-3-Clause. -module Language.Haskell.GhclibParserEx.GHC.Hs.Types- {-# DEPRECATED "Use Language.Haskell.GhclibParserEx.GHC.Hs.Type instead" #-} (- module Language.Haskell.GhclibParserEx.GHC.Hs.Type+{-# LANGUAGE CPP #-}+#include "ghclib_api.h"+module Language.Haskell.GhclibParserEx.GHC.Hs.Types(+ fromTyParen+ , isTyQuasiQuote, isUnboxedTuple ) where -import Language.Haskell.GhclibParserEx.GHC.Hs.Type+#if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_900) || defined (GHCLIB_API_810)+import GHC.Hs+#else+import HsSyn+#endif+#if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_900)+import GHC.Types.SrcLoc+#else+import SrcLoc+#endif++fromTyParen :: LHsType GhcPs -> LHsType GhcPs+fromTyParen (L _ (HsParTy _ x)) = x+fromTyParen x = x++isTyQuasiQuote :: LHsType GhcPs -> Bool+isTyQuasiQuote (L _ (HsSpliceTy _ HsQuasiQuote{})) = True+isTyQuasiQuote _ = False++isUnboxedTuple :: HsTupleSort -> Bool+isUnboxedTuple HsUnboxedTuple = True+isUnboxedTuple _ = False
src/Language/Haskell/GhclibParserEx/GHC/Parser.hs view
@@ -22,20 +22,15 @@ ) where -#if defined (GHCLIB_API_HEAD) || defined(GHCLIB_API_902) || defined (GHCLIB_API_900) || defined (GHCLIB_API_810)+#if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_900) || defined (GHCLIB_API_810) import GHC.Hs #else import HsSyn #endif-#if defined (GHCLIB_API_HEAD) || defined(GHCLIB_API_902)-# if defined (GHCLIB_API_902)+#if defined (GHCLIB_API_HEAD) import GHC.Driver.Config-# endif-# if defined (GHCLIB_API_HEAD)-import GHC.Driver.Config.Parser-# endif #endif-#if defined (GHCLIB_API_HEAD) || defined(GHCLIB_API_902) || defined (GHCLIB_API_900)+#if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_900) import GHC.Parser.PostProcess import GHC.Driver.Session import GHC.Data.StringBuffer@@ -69,19 +64,19 @@ location = mkRealSrcLoc (mkFastString "<string>") 1 1 buffer = stringToStringBuffer str parseState =-#if defined (GHCLIB_API_HEAD) || defined(GHCLIB_API_902)+#if defined (GHCLIB_API_HEAD) initParserState (initParserOpts flags) buffer location #else mkPState flags buffer location #endif-#if defined (GHCLIB_API_HEAD) || defined(GHCLIB_API_902) || defined (GHCLIB_API_900)+#if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_900) parseModule :: String -> DynFlags -> ParseResult (Located HsModule) #else parseModule :: String -> DynFlags -> ParseResult (Located (HsModule GhcPs)) #endif parseModule = parse Parser.parseModule -#if defined (GHCLIB_API_HEAD) || defined(GHCLIB_API_902) || defined (GHCLIB_API_900)+#if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_900) parseSignature :: String -> DynFlags -> ParseResult (Located HsModule) #else parseSignature :: String -> DynFlags -> ParseResult (Located (HsModule GhcPs))@@ -101,16 +96,10 @@ parseDeclaration = parse Parser.parseDeclaration parseExpression :: String -> DynFlags -> ParseResult (LHsExpr GhcPs)-#if defined (GHCLIB_API_HEAD) || defined(GHCLIB_API_902)+#if defined (GHCLIB_API_HEAD) parseExpression s flags =- -- The need for annotations here came about first manifested with- -- ghc-9.0.1 case parse Parser.parseExpression s flags of- POk state e ->- let e' = e :: ECP- parser_validator = unECP e' :: PV (LHsExpr GhcPs)- parser = runPV parser_validator :: P (LHsExpr GhcPs)- in unP parser state :: ParseResult (LHsExpr GhcPs)+ POk s e -> unP (runPV . unECP $ e) s PFailed ps -> PFailed ps #elif defined (GHCLIB_API_810) || defined (GHCLIB_API_900) parseExpression s flags =@@ -130,24 +119,20 @@ parseStmt :: String -> DynFlags -> ParseResult (Maybe (LStmt GhcPs (LHsExpr GhcPs))) parseStmt = parse Parser.parseStmt -#if defined(GHCLIB_API_HEAD) || defined(GHCLIB_API_902)-parseIdentifier :: String -> DynFlags -> ParseResult (LocatedN RdrName)-#else parseIdentifier :: String -> DynFlags -> ParseResult (Located RdrName)-#endif parseIdentifier = parse Parser.parseIdentifier parseType :: String -> DynFlags -> ParseResult (LHsType GhcPs) parseType = parse Parser.parseType -#if defined (GHCLIB_API_HEAD) || defined(GHCLIB_API_902) || defined (GHCLIB_API_900)+#if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_900) parseHeader :: String -> DynFlags -> ParseResult (Located HsModule) #else parseHeader :: String -> DynFlags -> ParseResult (Located (HsModule GhcPs)) #endif parseHeader = parse Parser.parseHeader -#if defined (GHCLIB_API_HEAD) || defined(GHCLIB_API_902) || defined (GHCLIB_API_900)+#if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_900) parseFile :: String -> DynFlags -> String@@ -164,7 +149,7 @@ location = mkRealSrcLoc (mkFastString filename) 1 1 buffer = stringToStringBuffer str parseState =-#if defined (GHCLIB_API_HEAD) || defined(GHCLIB_API_902)+#if defined (GHCLIB_API_HEAD) initParserState (initParserOpts flags) buffer location #else mkPState flags buffer location
src/Language/Haskell/GhclibParserEx/GHC/Settings/Config.hs view
@@ -11,7 +11,7 @@ ) where -#if defined (GHCLIB_API_HEAD) || defined(GHCLIB_API_902) || defined (GHCLIB_API_900)+#if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_900) import GHC.Settings.Config import GHC.Driver.Session import GHC.Utils.Fingerprint@@ -32,14 +32,12 @@ fakeSettings :: Settings fakeSettings = Settings-#if defined (GHCLIB_API_HEAD) || defined(GHCLIB_API_902) || defined (GHCLIB_API_900)|| defined (GHCLIB_API_810)+#if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_900)|| defined (GHCLIB_API_810) { sGhcNameVersion=ghcNameVersion , sFileSettings=fileSettings , sTargetPlatform=platform , sPlatformMisc=platformMisc-# if !defined(GHCLIB_API_HEAD) && !defined(GHCLIB_API_902) , sPlatformConstants=platformConstants-# endif , sToolSettings=toolSettings } #else@@ -51,7 +49,7 @@ } #endif where-#if defined (GHCLIB_API_HEAD) || defined(GHCLIB_API_902) || defined (GHCLIB_API_900)|| defined (GHCLIB_API_810)+#if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_900)|| defined (GHCLIB_API_810) toolSettings = ToolSettings { toolSettings_opt_P_fingerprint=fingerprint0 }@@ -63,11 +61,8 @@ } #endif platform =-#if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_902)- genericPlatform-#else Platform{-#if defined (GHCLIB_API_900)+#if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_900) -- It doesn't matter what values we write here as these fields are -- not referenced for our purposes. However the fields are strict -- so we must say something.@@ -78,12 +73,12 @@ , platformIsCrossCompiling=False , platformLeadingUnderscore=False , platformTablesNextToCode=False-#if !defined (GHCLIB_API_900)+# if !defined (GHCLIB_API_900) , platformConstants=platformConstants-#endif+# endif , #endif-#if defined(GHCLIB_API_902)+#if defined (GHCLIB_API_HEAD) platformWordSize=PW8 , platformArchOS=ArchOS {archOS_arch=ArchUnknown, archOS_OS=OSUnknown} #elif defined (GHCLIB_API_810) || defined (GHCLIB_API_900)@@ -95,13 +90,10 @@ #endif , platformUnregisterised=True }-#endif-#if !defined(GHCLIB_API_HEAD) && !defined(GHCLIB_API_902) platformConstants = PlatformConstants{pc_DYNAMIC_BY_DEFAULT=False,pc_WORD_SIZE=8}-#endif -#if defined (GHCLIB_API_HEAD) || defined(GHCLIB_API_902) || defined (GHCLIB_API_900)|| defined (GHCLIB_API_810)+#if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_900)|| defined (GHCLIB_API_810) fakeLlvmConfig :: LlvmConfig fakeLlvmConfig = LlvmConfig [] [] #else
src/Language/Haskell/GhclibParserEx/GHC/Types/Name/Reader.hs view
@@ -9,11 +9,7 @@ ) where -#if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_902)-import GHC.Parser.Annotation-#endif--#if defined (GHCLIB_API_HEAD) || defined(GHCLIB_API_902) || defined (GHCLIB_API_900)+#if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_900) import GHC.Types.SrcLoc import GHC.Types.Name import GHC.Types.Name.Reader@@ -27,38 +23,21 @@ -- These names may not seem natural here but they work out in -- practice. The use of thse two functions is thoroughly ubiquitous. occNameStr :: RdrName -> String; occNameStr = occNameString . rdrNameOcc-#if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_902)-rdrNameStr :: GHC.Parser.Annotation.LocatedN RdrName -> String-#else-rdrNameStr :: Located RdrName -> String-#endif-rdrNameStr = occNameStr . unLoc+rdrNameStr :: Located RdrName -> String; rdrNameStr = occNameStr . unLoc -- Builtin type or data constructors.-#if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_902)-isSpecial :: LocatedN RdrName -> Bool-#else isSpecial :: Located RdrName -> Bool-#endif isSpecial (L _ (Exact n)) = isDataConName n || isTyConName n isSpecial _ = False -- Coerce qualified names to unqualified (by discarding the -- qualifier).-#if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_902)-unqual :: LocatedN RdrName -> LocatedN RdrName-#else unqual :: Located RdrName -> Located RdrName-#endif unqual (L loc (Qual _ n)) = L loc $ mkRdrUnqual n unqual x = x -- Extract the occ name from a qualified/unqualified reader name.-#if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_902)-fromQual :: LocatedN RdrName -> Maybe OccName-#else fromQual :: Located RdrName -> Maybe OccName-#endif fromQual (L _ (Qual _ x)) = Just x fromQual (L _ (Unqual x)) = Just x fromQual _ = Nothing
src/Language/Haskell/GhclibParserEx/GHC/Utils/Outputable.hs view
@@ -8,8 +8,11 @@ ) where -#if defined (GHCLIB_API_HEAD) || defined(GHCLIB_API_902) || defined (GHCLIB_API_900)+#if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_900) import GHC.Utils.Outputable+#if !defined (GHCLIB_API_900)+import GHC.Driver.Ppr+#endif #else import Outputable #endif
test/Test.hs view
@@ -17,11 +17,6 @@ import Data.List.Extra import Data.Maybe import Data.Generics.Uniplate.Data-#if defined (GHCLIB_API_HEAD)-import GHC.Data.Bag-import GHC.Driver.Errors.Types-import GHC.Types.Error-#endif import Language.Haskell.GhclibParserEx.Dump import Language.Haskell.GhclibParserEx.Fixity@@ -31,7 +26,6 @@ import Language.Haskell.GhclibParserEx.GHC.Hs.ExtendInstances import Language.Haskell.GhclibParserEx.GHC.Hs.Expr import Language.Haskell.GhclibParserEx.GHC.Hs.Pat-import Language.Haskell.GhclibParserEx.GHC.Hs.Type -- We only test 'isImportQualifiedPost' at this time which requires >= -- 8.10; avoid unused import warning. #if defined (MIN_VERSION_ghc_lib_parser)@@ -45,23 +39,19 @@ import Language.Haskell.GhclibParserEx.GHC.Driver.Session import Language.Haskell.GhclibParserEx.GHC.Types.Name.Reader -#if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_902) || defined (GHCLIB_API_900) || defined (GHCLIB_API_810)+#if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_900) || defined (GHCLIB_API_810) import GHC.Hs #else import HsSyn #endif-#if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_902) || defined (GHCLIB_API_900)+#if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_900) import GHC.Types.SrcLoc import GHC.Driver.Session import GHC.Parser.Lexer-# if !defined (GHCLIB_API_HEAD) import GHC.Utils.Outputable-#endif # if !defined (GHCLIB_API_900) import GHC.Driver.Ppr-# if !defined (GHCLIB_API_HEAD) import GHC.Parser.Errors.Ppr-# endif # endif import GHC.Utils.Error import GHC.Types.Name.Reader@@ -80,6 +70,11 @@ import Bag #endif +#if defined (GHCLIB_API_HEAD)+showSDocUnsafe :: SDoc -> String+showSDocUnsafe = showPprUnsafe+#endif+ main :: IO () main = do setEnv "TASTY_NUM_THREADS" "1"@@ -92,7 +87,6 @@ , fixityTests , extendInstancesTests , expressionPredicateTests- , typePredicateTests , patternPredicateTests , dynFlagsTests , nameTests@@ -104,91 +98,70 @@ writeFile relPath contents return relPath -#if defined (GHCLIB_API_HEAD)-chkParseResult :: (DynFlags -> Bag (MsgEnvelope GhcMessage) -> String) -> DynFlags -> ParseResult a -> IO ()-#else chkParseResult :: (DynFlags -> WarningMessages -> String) -> DynFlags -> ParseResult a -> IO ()-#endif chkParseResult report flags = \case POk s _ -> do #if defined (GHCLIB_API_HEAD)- let (wrns, errs) = getPsMessages s-#elif defined (GHCLIB_API_902) let (wrns, errs) = getMessages s #else let (wrns, errs) = getMessages s flags #endif when (not (null errs) || not (null wrns)) $ #if defined (GHCLIB_API_HEAD)- assertFailure (- report flags (getMessages (GhcPsMessage <$> wrns)) ++- report flags (getMessages (GhcPsMessage <$> errs))- )--#elif defined (GHCLIB_API_902) assertFailure (report flags (fmap pprWarning wrns) ++ report flags (fmap pprError errs)) #else assertFailure (report flags wrns ++ report flags errs) #endif+#if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_900) || defined (GHCLIB_API_810) #if defined (GHCLIB_API_HEAD)- PFailed s -> assertFailure (report flags $ getMessages (GhcPsMessage <$> snd (getPsMessages s)))-#elif defined (GHCLIB_API_902) PFailed s -> assertFailure (report flags $ fmap pprError (snd (getMessages s)))-#elif defined (GHCLIB_API_900) || defined (GHCLIB_API_810)+#else PFailed s -> assertFailure (report flags $ snd (getMessages s flags))+#endif #else PFailed _ loc err -> assertFailure (report flags $ unitBag $ mkPlainErrMsg flags loc err) #endif parseTests :: TestTree parseTests = testGroup "Parse tests"- [- testCase "Module" $- chkParseResult report flags (- parseModule (unlines- [ "module Foo (readMany) where"- , "import Data.List"- , "import Data.Maybe"- , "readMany = unfoldr $ listToMaybe . concatMap reads . tails"- ]) flags)- , testCase "Module" $- chkParseResult report flags (+ [ testCase "Module" $+ chkParseResult report flags $ parseModule (unlines [ "module Foo (readMany) where" , "import Data.List" , "import Data.Maybe" , "readMany = unfoldr $ listToMaybe . concatMap reads . tails"- ]) flags)+ ]) flags , testCase "Signature" $- chkParseResult report flags (+ chkParseResult report flags $ parseSignature (unlines [ "signature Str where" , "data Str" , "empty :: Str" , "append :: Str -> Str -> Str"- ]) flags)+ ]) flags , testCase "Import" $- chkParseResult report flags (- parseImport "import qualified \"foo-lib\" Foo as Bar hiding ((<.>))" flags)+ chkParseResult report flags $+ parseImport "import qualified \"foo-lib\" Foo as Bar hiding ((<.>))" flags , testCase "Statement" $- chkParseResult report flags (- parseStatement "Foo foo <- bar" flags)+ chkParseResult report flags $+ parseStatement "Foo foo <- bar" flags , testCase "Backpack" $- chkParseResult report flags (+ chkParseResult report flags $ parseBackpack (unlines [ "unit main where" , " module Main where" , " main = putStrLn \"Hello world!\""- ]) flags)+ ]) flags , testCase "Expression" $- chkParseResult report flags (- parseExpression "unfoldr $ listToMaybe . concatMap reads . tails" flags)+ chkParseResult report flags $+ parseExpression "unfoldr $ listToMaybe . concatMap reads . tails" flags , testCase "Declaration (1)" $- chkParseResult report flags (- parseDeclaration "fact n = if n <= 1 then 1 else n * fact (n - 1)" flags)+ chkParseResult report flags $+ parseDeclaration "fact n = if n <= 1 then 1 else n * fact (n - 1)" flags , testCase "Declaration (2)" $ -- Example from https://github.com/ndmitchell/hlint/issues/842.- chkParseResult report flags (- parseDeclaration "infixr 4 <%@~" flags)+ chkParseResult report flags $+ parseDeclaration "infixr 4 <%@~" flags , testCase "File" $ withTempDir $ \tmpDir -> do foo <- makeFile (tmpDir </> "Foo.hs") $ unlines ["{-# LANGUAGE ScopedTypeVariables #-}"@@ -200,17 +173,13 @@ s <- readFile' foo parsePragmasIntoDynFlags flags ([], []) foo s >>= \case Left msg -> assertFailure msg- Right flags -> chkParseResult report flags (parseFile foo flags s)+ Right flags -> chkParseResult report flags $ parseFile foo flags s ] where flags = defaultDynFlags fakeSettings fakeLlvmConfig-#if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_902)- report flags msgs = concat [ showSDoc flags msg | msg <- pprMsgEnvelopeBagWithLoc msgs ]-#else report flags msgs = concat [ showSDoc flags msg | msg <- pprErrMsgBagWithLoc msgs ]-#endif -#if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_902) || defined (GHCLIB_API_900)+#if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_900) moduleTest :: String -> DynFlags -> (Located HsModule -> IO ()) -> IO () #else moduleTest :: String -> DynFlags -> (Located (HsModule GhcPs) -> IO ()) -> IO ()@@ -226,12 +195,6 @@ POk _ e -> test e _ -> assertFailure "parse error" -typeTest :: String -> DynFlags -> (LHsType GhcPs -> IO ()) -> IO ()-typeTest s flags test =- case parseType s flags of- POk _ e -> test e- _ -> assertFailure "parse error"- patTest :: String -> DynFlags -> (LPat GhcPs -> IO ()) -> IO () patTest s flags test = case parsePattern s flags of@@ -244,25 +207,15 @@ exprTest "1 + 2 * 3" flags (\e -> assertBool "parse tree not affected" $-#if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_902)- showSDocUnsafe (showAstData BlankSrcSpan BlankEpAnnotations e) /=- showSDocUnsafe (showAstData BlankSrcSpan BlankEpAnnotations (applyFixities [] e))-#else showSDocUnsafe (showAstData BlankSrcSpan e) /= showSDocUnsafe (showAstData BlankSrcSpan (applyFixities [] e))-#endif ) , testCase "Pattern" $ case parseDeclaration "f (1 : 2 :[]) = 1" flags of POk _ d -> assertBool "parse tree not affected" $-#if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_902)- showSDocUnsafe (showAstData BlankSrcSpan BlankEpAnnotations d) /=- showSDocUnsafe (showAstData BlankSrcSpan BlankEpAnnotations (applyFixities [] d))-#else showSDocUnsafe (showAstData BlankSrcSpan d) /= showSDocUnsafe (showAstData BlankSrcSpan (applyFixities [] d))-#endif PFailed{} -> assertFailure "parse error" , testCase "fixitiesFromModule" $ case parseModule "infixl 4 <*!" flags of@@ -292,16 +245,6 @@ where flags = defaultDynFlags fakeSettings fakeLlvmConfig -typePredicateTests :: TestTree-typePredicateTests = testGroup "Type predicate tests"- [ testCase "isKindTyApp" $ test_with_exts [TypeApplications] "K @T" $ assert' . isKindTyApp- , testCase "isKindTyApp" $ test_with_exts [TypeApplications] "K T" $ assert' . not . isKindTyApp- ]- where- assert' = assertBool ""- test_with_exts exts s = typeTest s (flags exts)- flags = foldl' xopt_set (defaultDynFlags fakeSettings fakeLlvmConfig)- expressionPredicateTests :: TestTree expressionPredicateTests = testGroup "Expression predicate tests" [ testCase "isTag" $ test "foo" $ assert' . isTag "foo"@@ -310,16 +253,8 @@ , testCase "isDot" $ test "f . g" $ \case L _ (OpApp _ _ op _) -> assert' $ isDot op; _ -> assertFailure "unexpected" , testCase "isReturn" $ test "return x" $ \case L _ (HsApp _ f _) -> assert' $ isReturn f; _ -> assertFailure "unexpected" , testCase "isReturn" $ test "pure x" $ \case L _ (HsApp _ f _) -> assert' $ isReturn f; _ -> assertFailure "unexpected"-#if defined (GHCLIB_API_HEAD)- , testCase "isSection" $ test "(1 +)" $ \case L _ (HsPar _ _ x _) -> assert' $ isSection x; _ -> assertFailure "unexpected"-#else , testCase "isSection" $ test "(1 +)" $ \case L _ (HsPar _ x) -> assert' $ isSection x; _ -> assertFailure "unexpected"-#endif-#if defined (GHCLIB_API_HEAD)- , testCase "isSection" $ test "(+ 1)" $ \case L _ (HsPar _ _ x _) -> assert' $ isSection x; _ -> assertFailure "unexpected"-#else , testCase "isSection" $ test "(+ 1)" $ \case L _ (HsPar _ x) -> assert' $ isSection x; _ -> assertFailure "unexpected"-#endif , testCase "isRecConstr" $ test "Foo {bar=1}" $ assert' . isRecConstr , testCase "isRecUpdate" $ test "foo {bar=1}" $ assert' . isRecUpdate , testCase "isVar" $ test "foo" $ assert' . isVar@@ -368,17 +303,11 @@ , testCase "isSpliceDecl" $ test "$x" $ assert' . isSpliceDecl . unLoc , testCase "isSpliceDecl" $ test "f$x" $ assert' . not . isSpliceDecl . unLoc , testCase "isSpliceDecl" $ test "$(a + b)" $ assert' . isSpliceDecl . unLoc- , testCase "isQuasiQuoteExpr" $ test "[expr|1 + 2|]" $ assert' . isQuasiQuoteExpr- , testCase "isQuasiQuoteExpr" $ test "[expr(1 + 2)]" $ assert' . not . isQuasiQuoteExpr+ , testCase "isQuasiQuote" $ test "[expr|1 + 2|]" $ assert' . isQuasiQuote+ , testCase "isQuasiQuote" $ test "[expr(1 + 2)]" $ assert' . not . isQuasiQuote , testCase "isWholeFrac" $ test "3.2e1" $ assert' . isWholeFrac . unLoc , testCase "isWholeFrac" $ test "3.22e1" $ assert' . not . isWholeFrac . unLoc- , testCase "isMDo" $ test_with_exts [ RecursiveDo ] "mdo { pure () }" $ assert' . any isMDo . universeBi- , testCase "isListComp (1)" $ test "[ x + y | x <- xs, y <- ys ]" $ assert' . any isListComp . universeBi- , testCase "isListComp (2)" $ test_with_exts [ MonadComprehensions ] "[ x + y | x <- xs, y <- ys ]" $ assert' . any isMonadComp . universeBi- , testCase "isMonadComp (0)" $ test_with_exts [ MonadComprehensions ] "[ x + y | x <- Just 1, y <- Just 2 ]" $ assert' . not . any isListComp . universeBi- , testCase "isMonadComp (1)" $ test_with_exts [ MonadComprehensions ] "[ x + y | x <- Just 1, y <- Just 2 ]" $ assert' . any isMonadComp . universeBi- , testCase "isMonadComp (2)" $ test_with_exts [] "[ x + y | x <- Just 1, y <- Just 2 ]" $ assert' . not . any isMonadComp . universeBi- , testCase "isMonadComp (3)" $ test_with_exts [] "[ x + y | x <- Just 1, y <- Just 2 ]" $ assert' . any isListComp . universeBi+ , testCase "isMDo" $ test "mdo { pure () }" $ assert' . any isMDo . universeBi , testCase "strToVar" $ assert' . isVar . strToVar $ "foo" , testCase "varToStr" $ test "[]" $ assert' . (== "[]") . varToStr , testCase "varToStr" $ test "foo" $ assert' . (== "foo") . varToStr@@ -386,17 +315,15 @@ ] where assert' = assertBool ""- test s = exprTest s (flags [])- test_with_exts exts s = exprTest s (flags exts)- flags exts = foldl' xopt_set (defaultDynFlags fakeSettings fakeLlvmConfig)- (exts ++- [ TemplateHaskell- , TemplateHaskellQuotes- , QuasiQuotes- , TypeApplications- , LambdaCase- ]- )+ test s = exprTest s flags+ flags = foldl' xopt_set (defaultDynFlags fakeSettings fakeLlvmConfig)+ [ TemplateHaskell+ , TemplateHaskellQuotes+ , QuasiQuotes+ , TypeApplications+ , LambdaCase+ , RecursiveDo+ ] patternPredicateTests :: TestTree patternPredicateTests = testGroup "Pattern predicate tests"@@ -408,21 +335,12 @@ , testCase "strToPat" $ assert' . (== "[]") . patToStr . strToPat $ "[]" , testCase "fromPChar" $ test "'a'" $ assert' . (== Just 'a') . fromPChar , testCase "fromPChar" $ test "\"a\"" $ assert' . isNothing . fromPChar- , testCase "isSplicePat" $ test "$(varP pylonExPtrVarName)" $ assert' . isSplicePat ] where assert' = assertBool ""- test = test_with_exts []- test_with_exts exts s = patTest s (flags exts)- flags exts = foldl' xopt_set (defaultDynFlags fakeSettings fakeLlvmConfig)- (exts ++- [ TemplateHaskell- , TemplateHaskellQuotes- , QuasiQuotes- , TypeApplications- , LambdaCase- ]- )+ test s = patTest s flags+ flags = foldl' xopt_set (defaultDynFlags fakeSettings fakeLlvmConfig)+ [ TemplateHaskell, QuasiQuotes, TypeApplications, LambdaCase ] dynFlagsTests :: TestTree dynFlagsTests = testGroup "DynFlags tests"@@ -447,7 +365,7 @@ -- https://github.com/ndmitchell/hlint/issues/971). parsePragmasIntoDynFlags flags ([StarIsType], []) foo s >>= \case Left msg -> assertFailure msg- Right flags -> chkParseResult report flags (parseFile foo flags s)+ Right flags -> chkParseResult report flags $ parseFile foo flags s #if defined (MIN_VERSION_ghc_lib_parser) # if !MIN_VERSION_ghc_lib_parser(1, 0, 0) || MIN_VERSION_ghc_lib_parser(8, 10, 0) , testCase "ImportQualifiedPost" $ do@@ -464,11 +382,8 @@ ] where flags = defaultDynFlags fakeSettings fakeLlvmConfig-#if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_902)- report flags msgs = concat [ showSDoc flags msg | msg <- pprMsgEnvelopeBagWithLoc msgs ]-#else report flags msgs = concat [ showSDoc flags msg | msg <- pprErrMsgBagWithLoc msgs ]-#endif+ nameTests :: TestTree nameTests = testGroup "Name tests" [ testCase "modName (1)" $