From adb642353d6c3166eea4f52dc3ba83382dcaef04 Mon Sep 17 00:00:00 2001 From: Ximin Luo Date: Fri, 29 May 2020 23:26:51 +0100 Subject: [PATCH] more GHC 8.10.1 fixes --- src/Language/Haskell/Brittany/Internal.hs | 9 +++++++ .../Brittany/Internal/ExactPrintUtils.hs | 11 +++++++- .../Brittany/Internal/Layouters/DataDecl.hs | 4 +++ .../Brittany/Internal/Layouters/Decl.hs | 15 ++++++++--- .../Brittany/Internal/Layouters/Expr.hs | 25 ++++++++++++++++++- .../Brittany/Internal/Layouters/Expr.hs-boot | 4 +++ .../Haskell/Brittany/Internal/Layouters/IE.hs | 7 +++++- .../Brittany/Internal/Layouters/Import.hs | 12 +++++++++ .../Brittany/Internal/Layouters/Module.hs | 7 +++++- .../Brittany/Internal/Layouters/Pattern.hs | 12 +++++++++ .../Brittany/Internal/Layouters/Stmt.hs | 4 +++ .../Brittany/Internal/Layouters/Stmt.hs-boot | 4 +++ .../Brittany/Internal/Layouters/Type.hs | 12 +++++++-- .../Haskell/Brittany/Internal/Utils.hs | 10 +++----- 14 files changed, 121 insertions(+), 15 deletions(-) diff --git a/src/Language/Haskell/Brittany/Internal.hs b/src/Language/Haskell/Brittany/Internal.hs index 1d9266f..1fc3e12 100644 --- a/src/Language/Haskell/Brittany/Internal.hs +++ b/src/Language/Haskell/Brittany/Internal.hs @@ -61,7 +61,12 @@ import GHC ( Located ) import RdrName ( RdrName(..) ) import SrcLoc ( SrcSpan ) +#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */ +import GHC.Hs +import Bag +#else import HsSyn +#endif import qualified DynFlags as GHC import qualified GHC.LanguageExtensions.Type as GHC @@ -380,7 +385,11 @@ parsePrintModuleTests conf filename input = do let inputStr = Text.unpack input parseResult <- ExactPrint.Parsers.parseModuleFromString filename inputStr case parseResult of +#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */ + Left err -> return $ Left $ "parsing error: " ++ show (bagToList (show <$> err)) +#else Left (_ , s ) -> return $ Left $ "parsing error: " ++ s +#endif Right (anns, parsedModule) -> runExceptT $ do (inlineConf, perItemConf) <- case extractCommentConfigs anns (getTopLevelDeclNameMap parsedModule) of diff --git a/src/Language/Haskell/Brittany/Internal/ExactPrintUtils.hs b/src/Language/Haskell/Brittany/Internal/ExactPrintUtils.hs index 5dcf840..6115f52 100644 --- a/src/Language/Haskell/Brittany/Internal/ExactPrintUtils.hs +++ b/src/Language/Haskell/Brittany/Internal/ExactPrintUtils.hs @@ -36,6 +36,7 @@ import qualified CmdLineParser as GHC #if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */ import GHC.Hs +import Bag #else import HsSyn #endif @@ -96,7 +97,11 @@ parseModuleWithCpp cpp opts args fp dynCheck = ++ show (warnings <&> warnExtractorCompat) x <- ExceptT.ExceptT $ liftIO $ dynCheck dflags2 res <- lift $ ExactPrint.parseModuleApiAnnsWithCppInternal cpp dflags2 fp +#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */ + either (\err -> ExceptT.throwE $ "transform error: " ++ show (bagToList (show <$> err))) +#else either (\(span, err) -> ExceptT.throwE $ show span ++ ": " ++ err) +#endif (\(a, m) -> pure (a, m, x)) $ ExactPrint.postParseTransform res opts @@ -129,7 +134,11 @@ parseModuleFromString args fp dynCheck str = dynCheckRes <- ExceptT.ExceptT $ liftIO $ dynCheck dflags1 let res = ExactPrint.parseModuleFromStringInternal dflags1 fp str case res of +#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */ + Left err -> ExceptT.throwE $ "parse error: " ++ show (bagToList (show <$> err)) +#else Left (span, err) -> ExceptT.throwE $ showOutputable span ++ ": " ++ err +#endif Right (a , m ) -> pure (a, m, dynCheckRes) @@ -193,7 +202,7 @@ commentAnnFixTransformGlob ast = do , ExactPrint.annsDP = assocs' } ExactPrint.modifyAnnsT $ \anns -> Map.insert annKey1 ann1' anns - + commentAnnFixTransform :: GHC.ParsedSource -> ExactPrint.Transform () diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/DataDecl.hs b/src/Language/Haskell/Brittany/Internal/Layouters/DataDecl.hs index 00453b3..4d2b93a 100644 --- a/src/Language/Haskell/Brittany/Internal/Layouters/DataDecl.hs +++ b/src/Language/Haskell/Brittany/Internal/Layouters/DataDecl.hs @@ -19,7 +19,11 @@ import Language.Haskell.Brittany.Internal.Config.Types import RdrName ( RdrName(..) ) import GHC ( Located, runGhc, GenLocated(L), moduleNameString ) import qualified GHC +#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */ +import GHC.Hs +#else import HsSyn +#endif import Name import BasicTypes import Language.Haskell.GHC.ExactPrint.Types ( mkAnnKey ) diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Decl.hs b/src/Language/Haskell/Brittany/Internal/Layouters/Decl.hs index f33b511..8ec8d74 100644 --- a/src/Language/Haskell/Brittany/Internal/Layouters/Decl.hs +++ b/src/Language/Haskell/Brittany/Internal/Layouters/Decl.hs @@ -37,8 +37,10 @@ import GHC ( runGhc ) import SrcLoc ( SrcSpan, noSrcSpan, Located , getLoc, unLoc ) import qualified FastString -import HsSyn -#if MIN_VERSION_ghc(8,6,0) +#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */ +import GHC.Hs +import GHC.Hs.Extension (NoExtField (..)) +#elif MIN_VERSION_ghc(8,6,0) import HsExtension (NoExt (..)) #endif import Name @@ -1040,7 +1042,14 @@ layoutClsInst lcid@(L _ cid) = docLines ] where layoutInstanceHead :: ToBriDocM BriDocNumbered -#if MIN_VERSION_ghc(8,6,0) /* 8.6 */ +#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */ + layoutInstanceHead = + briDocByExactNoComment + $ InstD NoExtField + . ClsInstD NoExtField + . removeChildren + <$> lcid +#elif MIN_VERSION_ghc(8,6,0) /* 8.6 */ layoutInstanceHead = briDocByExactNoComment $ InstD NoExt diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs b/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs index 660355c..d7c9a2b 100644 --- a/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs +++ b/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs @@ -19,7 +19,11 @@ import Language.Haskell.Brittany.Internal.Config.Types import qualified Language.Haskell.GHC.ExactPrint.Types as ExactPrint.Types import GHC ( runGhc, GenLocated(L), SrcSpan, moduleNameString, AnnKeywordId(..), RdrName(..) ) +#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */ +import GHC.Hs +#else import HsSyn +#endif import Name import qualified FastString import BasicTypes @@ -521,7 +525,12 @@ layoutExpr lexpr@(L _ expr) = do #else ExplicitTuple args boxity -> do #endif -#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ +#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */ + let argExprs = args <&> \arg -> case arg of + (L _ (Present _ e)) -> (arg, Just e); + (L _ (Missing NoExtField)) -> (arg, Nothing) + (L _ XTupArg{}) -> error "brittany internal error: XTupArg" +#elif MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ let argExprs = args <&> \arg -> case arg of (L _ (Present _ e)) -> (arg, Just e); (L _ (Missing NoExt)) -> (arg, Nothing) @@ -984,10 +993,18 @@ layoutExpr lexpr@(L _ expr) = do else Just <$> docSharedWrapper layoutExpr rFExpr return $ (lfield, lrdrNameToText lnameF, rFExpDoc) recordExpression False indentPolicy lexpr nameDoc rFs +#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */ + HsRecFields [] (Just (L _ 0)) -> do +#else HsRecFields [] (Just 0) -> do +#endif let t = lrdrNameToText lname docWrapNode lname $ docLit $ t <> Text.pack " { .. }" +#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */ + HsRecFields fs@(_:_) (Just (L _ dotdoti)) | dotdoti == length fs -> do +#else HsRecFields fs@(_:_) (Just dotdoti) | dotdoti == length fs -> do +#endif let nameDoc = docWrapNode lname $ docLit $ lrdrNameToText lname fieldDocs <- fs `forM` \fieldl@(L _ (HsRecField (L _ fieldOcc) fExpr pun)) -> do #if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ @@ -1137,12 +1154,15 @@ layoutExpr lexpr@(L _ expr) = do HsStatic{} -> do -- TODO briDocByExactInlineOnly "HsStatic{}" lexpr +#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */ +#else HsArrApp{} -> do -- TODO briDocByExactInlineOnly "HsArrApp{}" lexpr HsArrForm{} -> do -- TODO briDocByExactInlineOnly "HsArrForm{}" lexpr +#endif HsTick{} -> do -- TODO briDocByExactInlineOnly "HsTick{}" lexpr @@ -1152,6 +1172,8 @@ layoutExpr lexpr@(L _ expr) = do HsTickPragma{} -> do -- TODO briDocByExactInlineOnly "HsTickPragma{}" lexpr +#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */ +#else EWildPat{} -> do docLit $ Text.pack "_" #if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ @@ -1169,6 +1191,7 @@ layoutExpr lexpr@(L _ expr) = do ELazyPat{} -> do -- TODO briDocByExactInlineOnly "ELazyPat{}" lexpr +#endif HsWrap{} -> do -- TODO briDocByExactInlineOnly "HsWrap{}" lexpr diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs-boot b/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs-boot index 1f76032..733ac90 100644 --- a/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs-boot +++ b/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs-boot @@ -15,7 +15,11 @@ import Language.Haskell.Brittany.Internal.Types import Language.Haskell.Brittany.Internal.LayouterBasics import GHC ( runGhc, GenLocated(L), moduleNameString ) +#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */ +import GHC.Hs +#else import HsSyn +#endif import Name diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/IE.hs b/src/Language/Haskell/Brittany/Internal/Layouters/IE.hs index f2c36de..bfe2679 100644 --- a/src/Language/Haskell/Brittany/Internal/Layouters/IE.hs +++ b/src/Language/Haskell/Brittany/Internal/Layouters/IE.hs @@ -18,9 +18,14 @@ import GHC ( unLoc , AnnKeywordId(..) , Located ) +#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */ +import GHC.Hs +import GHC.Hs.ImpExp +#else import HsSyn -import Name import HsImpExp +#endif +import Name import FieldLabel import qualified FastString import BasicTypes diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Import.hs b/src/Language/Haskell/Brittany/Internal/Layouters/Import.hs index bcce106..d5bf0dd 100644 --- a/src/Language/Haskell/Brittany/Internal/Layouters/Import.hs +++ b/src/Language/Haskell/Brittany/Internal/Layouters/Import.hs @@ -12,7 +12,11 @@ import GHC ( unLoc , moduleNameString , Located ) +#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */ +import GHC.Hs +#else import HsSyn +#endif import Name import FieldLabel import qualified FastString @@ -59,7 +63,11 @@ layoutImport limportD@(L _ importD) = docWrapNode limportD $ case importD of hiding = maybe False fst mllies minQLength = length "import qualified " qLengthReal = +#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */ + let qualifiedPart = if q /= NotQualified then length "qualified " else 0 +#else let qualifiedPart = if q then length "qualified " else 0 +#endif safePart = if safe then length "safe " else 0 pkgPart = maybe 0 ((+ 1) . Text.length) pkgNameT srcPart = if src then length "{-# SOURCE #-} " else 0 @@ -73,7 +81,11 @@ layoutImport limportD@(L _ importD) = docWrapNode limportD $ case importD of [ appSep $ docLit $ Text.pack "import" , if src then appSep $ docLit $ Text.pack "{-# SOURCE #-}" else docEmpty , if safe then appSep $ docLit $ Text.pack "safe" else docEmpty +#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */ + , if q /= NotQualified then appSep $ docLit $ Text.pack "qualified" else docEmpty +#else , if q then appSep $ docLit $ Text.pack "qualified" else docEmpty +#endif , maybe docEmpty (appSep . docLit) pkgNameT ] indentName = diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Module.hs b/src/Language/Haskell/Brittany/Internal/Layouters/Module.hs index f899e08..3839ecd 100644 --- a/src/Language/Haskell/Brittany/Internal/Layouters/Module.hs +++ b/src/Language/Haskell/Brittany/Internal/Layouters/Module.hs @@ -9,9 +9,14 @@ import Language.Haskell.Brittany.Internal.Layouters.Import import Language.Haskell.Brittany.Internal.Config.Types import GHC (unLoc, runGhc, GenLocated(L), moduleNameString, AnnKeywordId(..)) +#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */ +import GHC.Hs +import GHC.Hs.ImpExp +#else import HsSyn -import Name import HsImpExp +#endif +import Name import FieldLabel import qualified FastString import BasicTypes diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Pattern.hs b/src/Language/Haskell/Brittany/Internal/Layouters/Pattern.hs index cd1b31e..de943b7 100644 --- a/src/Language/Haskell/Brittany/Internal/Layouters/Pattern.hs +++ b/src/Language/Haskell/Brittany/Internal/Layouters/Pattern.hs @@ -21,7 +21,11 @@ import GHC ( Located , ol_val ) import qualified GHC +#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */ +import GHC.Hs +#else import HsSyn +#endif import Name import BasicTypes @@ -136,14 +140,22 @@ layoutPat (ghcDL -> lpat@(L _ pat)) = docWrapNode lpat $ case pat of , docSeparator , docLit $ Text.pack "}" ] +#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */ + ConPatIn lname (RecCon (HsRecFields [] (Just (L _ 0)))) -> do +#else ConPatIn lname (RecCon (HsRecFields [] (Just 0))) -> do +#endif -- Abc { .. } -> expr let t = lrdrNameToText lname Seq.singleton <$> docSeq [ appSep $ docLit t , docLit $ Text.pack "{..}" ] +#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */ + ConPatIn lname (RecCon (HsRecFields fs@(_:_) (Just (L _ dotdoti)))) | dotdoti == length fs -> do +#else ConPatIn lname (RecCon (HsRecFields fs@(_:_) (Just dotdoti))) | dotdoti == length fs -> do +#endif -- Abc { a = locA, .. } let t = lrdrNameToText lname fds <- fs `forM` \(L _ (HsRecField (L _ fieldOcc) fPat pun)) -> do diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Stmt.hs b/src/Language/Haskell/Brittany/Internal/Layouters/Stmt.hs index 3aa3b5c..60ba54b 100644 --- a/src/Language/Haskell/Brittany/Internal/Layouters/Stmt.hs +++ b/src/Language/Haskell/Brittany/Internal/Layouters/Stmt.hs @@ -17,7 +17,11 @@ import GHC ( runGhc , GenLocated(L) , moduleNameString ) +#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */ +import GHC.Hs +#else import HsSyn +#endif import Name import qualified FastString import BasicTypes diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Stmt.hs-boot b/src/Language/Haskell/Brittany/Internal/Layouters/Stmt.hs-boot index faf583a..1fab3c5 100644 --- a/src/Language/Haskell/Brittany/Internal/Layouters/Stmt.hs-boot +++ b/src/Language/Haskell/Brittany/Internal/Layouters/Stmt.hs-boot @@ -13,7 +13,11 @@ import Language.Haskell.Brittany.Internal.Types import Language.Haskell.Brittany.Internal.LayouterBasics import GHC ( runGhc, GenLocated(L), moduleNameString ) +#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */ +import GHC.Hs +#else import HsSyn +#endif import Name import qualified FastString import BasicTypes diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Type.hs b/src/Language/Haskell/Brittany/Internal/Layouters/Type.hs index 940eac7..7a1fee4 100644 --- a/src/Language/Haskell/Brittany/Internal/Layouters/Type.hs +++ b/src/Language/Haskell/Brittany/Internal/Layouters/Type.hs @@ -25,7 +25,11 @@ import GHC ( runGhc , AnnKeywordId (..) ) import Language.Haskell.GHC.ExactPrint.Types ( mkAnnKey ) +#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */ +import GHC.Hs +#else import HsSyn +#endif import Name import Outputable ( ftext, showSDocUnsafe ) import BasicTypes @@ -61,7 +65,9 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of t <- lrdrNameToTextAnnTypeEqualityIsSpecial name docWrapNode name $ docLit t #endif -#if MIN_VERSION_ghc(8,6,0) +#if MIN_VERSION_ghc(8,10,1) + HsForAllTy _ _ bndrs (L _ (HsQualTy _ (L _ cntxts) typ2)) -> do +#elif MIN_VERSION_ghc(8,6,0) HsForAllTy _ bndrs (L _ (HsQualTy _ (L _ cntxts) typ2)) -> do #else HsForAllTy bndrs (L _ (HsQualTy (L _ cntxts) typ2)) -> do @@ -151,7 +157,9 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of ] ) ] -#if MIN_VERSION_ghc(8,6,0) +#if MIN_VERSION_ghc(8,10,1) + HsForAllTy _ _ bndrs typ2 -> do +#elif MIN_VERSION_ghc(8,6,0) HsForAllTy _ bndrs typ2 -> do #else HsForAllTy bndrs typ2 -> do diff --git a/src/Language/Haskell/Brittany/Internal/Utils.hs b/src/Language/Haskell/Brittany/Internal/Utils.hs index 9edcb7e..0a0d31f 100644 --- a/src/Language/Haskell/Brittany/Internal/Utils.hs +++ b/src/Language/Haskell/Brittany/Internal/Utils.hs @@ -304,15 +304,13 @@ lines' s = case break (== '\n') s of (s1, (_:r)) -> s1 : lines' r #if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */ -absurdExt :: HsExtension.NoExtField -> a -absurdExt = error "cannot construct NoExtField" -#else -#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ +absurdExt :: HsExtension.NoExtCon -> a +absurdExt = HsExtension.noExtCon +#elif MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ -- | A method to dismiss NoExt patterns for total matches absurdExt :: HsExtension.NoExt -> a absurdExt = error "cannot construct NoExt" #else absurdExt :: () absurdExt = () -#endif /* ghc-8.6 */ -#endif /* ghc-8.10.1 */ +#endif