From e36d9bc465a4b1241812d5137d11b0cec3954548 Mon Sep 17 00:00:00 2001 From: Taylor Fausak Date: Sun, 15 Nov 2020 11:56:19 -0500 Subject: [PATCH] Drop support for GHC 8.4 --- .github/workflows/ci.yaml | 3 - .travis.yml | 6 - Makefile | 7 +- README.md | 2 +- brittany.cabal | 6 +- src/Language/Haskell/Brittany/Internal.hs | 18 -- .../Brittany/Internal/ExactPrintUtils.hs | 8 - .../Brittany/Internal/Layouters/DataDecl.hs | 46 ---- .../Brittany/Internal/Layouters/Decl.hs | 123 +---------- .../Brittany/Internal/Layouters/Expr.hs | 197 +----------------- .../Haskell/Brittany/Internal/Layouters/IE.hs | 24 --- .../Brittany/Internal/Layouters/Import.hs | 4 - .../Brittany/Internal/Layouters/Pattern.hs | 48 +---- .../Brittany/Internal/Layouters/Stmt.hs | 20 -- .../Brittany/Internal/Layouters/Type.hs | 153 +------------- .../Haskell/Brittany/Internal/Prelude.hs | 2 +- .../Haskell/Brittany/Internal/Utils.hs | 5 +- stack-8.4.3.yaml | 4 - stack-8.4.3.yaml.lock | 19 -- 19 files changed, 19 insertions(+), 676 deletions(-) delete mode 100644 stack-8.4.3.yaml delete mode 100644 stack-8.4.3.yaml.lock diff --git a/.github/workflows/ci.yaml b/.github/workflows/ci.yaml index 6fb70ec..ae70751 100644 --- a/.github/workflows/ci.yaml +++ b/.github/workflows/ci.yaml @@ -23,9 +23,6 @@ jobs: - os: ubuntu-18.04 ghc: 8.6.5 cabal: 3.2.0.0 - - os: ubuntu-18.04 - ghc: 8.4.4 - cabal: 3.2.0.0 runs-on: ${{ matrix.os }} steps: - uses: actions/checkout@v2 diff --git a/.travis.yml b/.travis.yml index d9b2b07..19a5ca9 100644 --- a/.travis.yml +++ b/.travis.yml @@ -45,9 +45,6 @@ matrix: ##### CABAL ##### - - env: BUILD=cabal GHCVER=8.4.4 CABALVER=1.24 HAPPYVER=1.19.5 ALEXVER=3.1.7 - compiler: ": #cabal 8.4.4" - addons: {apt: {packages: [cabal-install-1.24,ghc-8.4.4,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}} - env: BUILD=cabal GHCVER=8.6.5 CABALVER=1.24 HAPPYVER=1.19.5 ALEXVER=3.1.7 compiler: ": #cabal 8.6.5" addons: {apt: {packages: [cabal-install-1.24,ghc-8.6.5,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}} @@ -72,9 +69,6 @@ matrix: compiler: ": #stack default" addons: {apt: {packages: [libgmp-dev]}} - - env: BUILD=stack ARGS="--stack-yaml stack-8.4.3.yaml" - compiler: ": #stack 8.4.3" - addons: {apt: {packages: [libgmp-dev]}} - env: BUILD=stack ARGS="--stack-yaml stack-8.6.5.yaml" compiler: ": #stack 8.6.5" addons: {apt: {packages: [libgmp-dev]}} diff --git a/Makefile b/Makefile index 1017b9a..ca0a962 100644 --- a/Makefile +++ b/Makefile @@ -5,14 +5,9 @@ test: .PHONY: test-all test-all: - $(MAKE) test test-8.6.5 test-8.4.3 + $(MAKE) test test-8.6.5 .PHONY: test-8.6.5 test-8.6.5: echo "test 8.6.5" stack test --stack-yaml stack-8.6.5.yaml --work-dir .stack-work-8.6.5 - -.PHONY: test-8.4.3 -test-8.4.3: - echo "test 8.4.3" - stack test --stack-yaml stack-8.4.3.yaml --work-dir .stack-work-8.4.3 diff --git a/README.md b/README.md index 56f42f0..eec9c4c 100644 --- a/README.md +++ b/README.md @@ -48,7 +48,7 @@ log the size of the input, but _not_ the full input/output of requests.) # Other usage notes -- Supports GHC versions `8.4`, `8.6`, `8.8`. +- Supports GHC versions `8.6`, `8.8`. - included in stackage with lts>=10.0 (or nightlies dating to >=2017-11-15) - config (file) documentation is lacking. - some config values can not be configured via commandline yet. diff --git a/brittany.cabal b/brittany.cabal index ffeb0f2..cd541fb 100644 --- a/brittany.cabal +++ b/brittany.cabal @@ -91,8 +91,8 @@ library { -fno-warn-redundant-constraints } build-depends: - { base >=4.11 && <4.15 - , ghc >=8.4.1 && <8.11 + { base >=4.12 && <4.15 + , ghc >=8.6.1 && <8.11 , ghc-paths >=0.1.0.9 && <0.2 , ghc-exactprint >=0.5.8 && <0.6.4 , transformers >=0.5.2.0 && <0.6 @@ -118,7 +118,7 @@ library { , semigroups >=0.18.2 && <0.20 , cmdargs >=0.10.14 && <0.11 , czipwith >=1.0.1.0 && <1.1 - , ghc-boot-th >=8.4.1 && <8.11 + , ghc-boot-th >=8.6.1 && <8.11 , filepath >=1.4.1.0 && <1.5 , random >= 1.1 && <1.2 } diff --git a/src/Language/Haskell/Brittany/Internal.hs b/src/Language/Haskell/Brittany/Internal.hs index 1fc3e12..57e6e8f 100644 --- a/src/Language/Haskell/Brittany/Internal.hs +++ b/src/Language/Haskell/Brittany/Internal.hs @@ -518,17 +518,10 @@ ppModule lmod@(L _loc _m@(HsModule _name _exports _ decls _ _)) = do _ -> return () getDeclBindingNames :: LHsDecl GhcPs -> [String] -#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ getDeclBindingNames (L _ decl) = case decl of SigD _ (TypeSig _ ns _) -> ns <&> \(L _ n) -> Text.unpack (rdrNameToText n) ValD _ (FunBind _ (L _ n) _ _ _) -> [Text.unpack $ rdrNameToText n] _ -> [] -#else -getDeclBindingNames (L _ decl) = case decl of - SigD (TypeSig ns _) -> ns <&> \(L _ n) -> Text.unpack (rdrNameToText n) - ValD (FunBind (L _ n) _ _ _ _) -> [Text.unpack $ rdrNameToText n] - _ -> [] -#endif -- Prints the information associated with the module annotation @@ -586,26 +579,15 @@ ppPreamble lmod@(L loc m@(HsModule _ _ _ _ _ _)) = do _sigHead :: Sig GhcPs -> String _sigHead = \case -#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ TypeSig _ names _ -> -#else - TypeSig names _ -> -#endif "TypeSig " ++ intercalate "," (Text.unpack . lrdrNameToText <$> names) _ -> "unknown sig" _bindHead :: HsBind GhcPs -> String -#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ _bindHead = \case FunBind _ fId _ _ [] -> "FunBind " ++ (Text.unpack $ lrdrNameToText $ fId) PatBind _ _pat _ ([], []) -> "PatBind smth" _ -> "unknown bind" -#else -_bindHead = \case - FunBind fId _ _ _ [] -> "FunBind " ++ (Text.unpack $ lrdrNameToText $ fId) - PatBind _pat _ _ _ ([], []) -> "PatBind smth" - _ -> "unknown bind" -#endif diff --git a/src/Language/Haskell/Brittany/Internal/ExactPrintUtils.hs b/src/Language/Haskell/Brittany/Internal/ExactPrintUtils.hs index b7ac608..29c126f 100644 --- a/src/Language/Haskell/Brittany/Internal/ExactPrintUtils.hs +++ b/src/Language/Haskell/Brittany/Internal/ExactPrintUtils.hs @@ -212,17 +212,9 @@ commentAnnFixTransform modul = SYB.everything (>>) genF modul genF = (\_ -> return ()) `SYB.extQ` exprF exprF :: Located (HsExpr GhcPs) -> ExactPrint.Transform () exprF lexpr@(L _ expr) = case expr of -#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ RecordCon _ _ (HsRecFields fs@(_:_) Nothing) -> -#else - RecordCon _ _ _ (HsRecFields fs@(_:_) Nothing) -> -#endif moveTrailingComments lexpr (List.last fs) -#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ RecordUpd _ _e fs@(_:_) -> -#else - RecordUpd _e fs@(_:_) _cons _ _ _ -> -#endif moveTrailingComments lexpr (List.last fs) _ -> return () diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/DataDecl.hs b/src/Language/Haskell/Brittany/Internal/Layouters/DataDecl.hs index 74b6d53..22f11d4 100644 --- a/src/Language/Haskell/Brittany/Internal/Layouters/DataDecl.hs +++ b/src/Language/Haskell/Brittany/Internal/Layouters/DataDecl.hs @@ -44,20 +44,11 @@ layoutDataDecl -> LHsQTyVars GhcPs -> HsDataDefn GhcPs -> ToBriDocM BriDocNumbered -#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ layoutDataDecl _ _ (XLHsQTyVars ext) _ = absurdExt ext layoutDataDecl ltycl name (HsQTvs _ bndrs) defn = case defn of -#else -layoutDataDecl ltycl name (HsQTvs _ bndrs _) defn = case defn of -#endif -- newtype MyType a b = MyType .. -#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ HsDataDefn _ext NewType (L _ []) _ctype Nothing [cons] mDerivs -> case cons of (L _ (ConDeclH98 _ext consName (L _ False) _qvars (Just (L _ [])) details _conDoc)) -> -#else - HsDataDefn NewType (L _ []) _ctype Nothing [cons] mDerivs -> case cons of - (L _ (ConDeclH98 consName Nothing (Just (L _ [])) details _conDoc)) -> -#endif docWrapNode ltycl $ do nameStr <- lrdrNameToTextAnn name consNameStr <- lrdrNameToTextAnn consName @@ -82,11 +73,7 @@ layoutDataDecl ltycl name (HsQTvs _ bndrs _) defn = case defn of -- data MyData a b -- (zero constructors) -#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ HsDataDefn _ext DataType (L _ lhsContext) _ctype Nothing [] mDerivs -> -#else - HsDataDefn DataType (L _ lhsContext) _ctype Nothing [] mDerivs -> -#endif docWrapNode ltycl $ do lhsContextDoc <- docSharedWrapper createContextDoc lhsContext nameStr <- lrdrNameToTextAnn name @@ -100,17 +87,9 @@ layoutDataDecl ltycl name (HsQTvs _ bndrs _) defn = case defn of -- data MyData = MyData .. -- data MyData = MyData { .. } -#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ HsDataDefn _ext DataType (L _ lhsContext) _ctype Nothing [cons] mDerivs -> -#else - HsDataDefn DataType (L _ lhsContext) _ctype Nothing [cons] mDerivs -> -#endif case cons of -#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ (L _ (ConDeclH98 _ext consName (L _ _hasExt) qvars mRhsContext details _conDoc)) -> -#else - (L _ (ConDeclH98 consName (Just (HsQTvs _ qvars _)) mRhsContext details _conDoc)) -> -#endif docWrapNode ltycl $ do lhsContextDoc <- docSharedWrapper createContextDoc lhsContext nameStr <- lrdrNameToTextAnn name @@ -266,18 +245,11 @@ createContextDoc (t1 : tR) = do createBndrDoc :: [LHsTyVarBndr GhcPs] -> ToBriDocM BriDocNumbered createBndrDoc bs = do tyVarDocs <- bs `forM` \case -#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ (L _ (UserTyVar _ext vname)) -> return $ (lrdrNameToText vname, Nothing) (L _ (KindedTyVar _ext lrdrName kind)) -> do -#else - (L _ (UserTyVar vname)) -> return $ (lrdrNameToText vname, Nothing) - (L _ (KindedTyVar lrdrName kind)) -> do -#endif d <- docSharedWrapper layoutType kind return $ (lrdrNameToText lrdrName, Just $ d) -#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ (L _ (XTyVarBndr ext)) -> absurdExt ext -#endif docSeq $ List.intersperse docSeparator $ tyVarDocs @@ -307,12 +279,8 @@ createDerivingPar derivs mainDoc = do <$> types derivingClauseDoc :: LHsDerivingClause GhcPs -> ToBriDocM BriDocNumbered -#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ derivingClauseDoc (L _ (XHsDerivingClause ext)) = absurdExt ext derivingClauseDoc (L _ (HsDerivingClause _ext mStrategy types)) = case types of -#else -derivingClauseDoc (L _ (HsDerivingClause mStrategy types)) = case types of -#endif (L _ []) -> docSeq [] (L _ ts) -> let @@ -330,12 +298,8 @@ derivingClauseDoc (L _ (HsDerivingClause mStrategy types)) = case types of $ docSeq $ List.intersperse docCommaSep $ ts <&> \case -#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ HsIB _ t -> layoutType t XHsImplicitBndrs x -> absurdExt x -#else - HsIB _ t _ -> layoutType t -#endif , whenMoreThan1Type ")" , rhsStrategy ] @@ -344,7 +308,6 @@ derivingClauseDoc (L _ (HsDerivingClause mStrategy types)) = case types of (L _ StockStrategy ) -> (docLitS " stock", docEmpty) (L _ AnyclassStrategy ) -> (docLitS " anyclass", docEmpty) (L _ NewtypeStrategy ) -> (docLitS " newtype", docEmpty) -#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ lVia@(L _ (ViaStrategy viaTypes) ) -> ( docEmpty , case viaTypes of @@ -355,7 +318,6 @@ derivingClauseDoc (L _ (HsDerivingClause mStrategy types)) = case types of ] XHsImplicitBndrs ext -> absurdExt ext ) -#endif docDeriving :: ToBriDocM BriDocNumbered docDeriving = docLitS "deriving" @@ -473,12 +435,8 @@ createDetailsDoc consNameStr details = case details of :: [LConDeclField GhcPs] -> [(ToBriDocM BriDocNumbered, ToBriDocM BriDocNumbered)] mkFieldDocs = fmap $ \lField -> case lField of -#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ L _ (ConDeclField _ext names t _) -> createNamesAndTypeDoc lField names t L _ (XConDeclField x) -> absurdExt x -#else - L _ (ConDeclField names t _) -> createNamesAndTypeDoc lField names t -#endif createForallDoc :: [LHsTyVarBndr GhcPs] -> Maybe (ToBriDocM BriDocNumbered) createForallDoc [] = Nothing @@ -497,12 +455,8 @@ createNamesAndTypeDoc lField names t = $ List.intersperse docCommaSep $ names <&> \case -#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ L _ (XFieldOcc x) -> absurdExt x L _ (FieldOcc _ fieldName) -> -#else - L _ (FieldOcc fieldName _) -> -#endif docLit =<< lrdrNameToTextAnn fieldName ] , docWrapNodeRest lField $ layoutType t diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Decl.hs b/src/Language/Haskell/Brittany/Internal/Layouters/Decl.hs index ae0b232..f6f59a4 100644 --- a/src/Language/Haskell/Brittany/Internal/Layouters/Decl.hs +++ b/src/Language/Haskell/Brittany/Internal/Layouters/Decl.hs @@ -40,7 +40,7 @@ import qualified FastString #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) +#else import HsSyn import HsExtension (NoExt (..)) #endif @@ -65,7 +65,6 @@ import Data.Char (isUpper) layoutDecl :: ToBriDoc HsDecl -#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ layoutDecl d@(L loc decl) = case decl of SigD _ sig -> withTransformedAnns d $ layoutSig (L loc sig) ValD _ bind -> withTransformedAnns d $ layoutBind (L loc bind) >>= \case @@ -77,18 +76,6 @@ layoutDecl d@(L loc decl) = case decl of InstD _ (ClsInstD _ inst) -> withTransformedAnns d $ layoutClsInst (L loc inst) _ -> briDocByExactNoComment d -#else -layoutDecl d@(L loc decl) = case decl of - SigD sig -> withTransformedAnns d $ layoutSig (L loc sig) - ValD bind -> withTransformedAnns d $ layoutBind (L loc bind) >>= \case - Left ns -> docLines $ return <$> ns - Right n -> return n - TyClD tycl -> withTransformedAnns d $ layoutTyCl (L loc tycl) - InstD (TyFamInstD tfid) -> - withTransformedAnns d $ layoutTyFamInstDecl False d tfid - InstD (ClsInstD inst) -> withTransformedAnns d $ layoutClsInst (L loc inst) - _ -> briDocByExactNoComment d -#endif -------------------------------------------------------------------------------- -- Sig @@ -96,16 +83,8 @@ layoutDecl d@(L loc decl) = case decl of layoutSig :: ToBriDoc Sig layoutSig lsig@(L _loc sig) = case sig of -#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ TypeSig _ names (HsWC _ (HsIB _ typ)) -> layoutNamesAndType Nothing names typ -#else /* ghc-8.4 */ - TypeSig names (HsWC _ (HsIB _ typ _)) -> layoutNamesAndType Nothing names typ -#endif -#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ InlineSig _ name (InlinePragma _ spec _arity phaseAct conlike) -> -#else - InlineSig name (InlinePragma _ spec _arity phaseAct conlike) -> -#endif docWrapNode lsig $ do nameStr <- lrdrNameToTextAnn name specStr <- specStringCompat lsig spec @@ -122,16 +101,8 @@ layoutSig lsig@(L _loc sig) = case sig of $ Text.pack ("{-# " ++ specStr ++ conlikeStr ++ phaseStr) <> nameStr <> Text.pack " #-}" -#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ ClassOpSig _ False names (HsIB _ typ) -> layoutNamesAndType Nothing names typ -#else /* ghc-8.4 */ - ClassOpSig False names (HsIB _ typ _) -> layoutNamesAndType Nothing names typ -#endif -#if MIN_VERSION_ghc(8,6,0) PatSynSig _ names (HsIB _ typ) -> layoutNamesAndType (Just "pattern") names typ -#else - PatSynSig names (HsIB _ typ _) -> layoutNamesAndType (Just "pattern") names typ -#endif _ -> briDocByExactNoComment lsig -- TODO where layoutNamesAndType mKeyword names typ = docWrapNode lsig $ do @@ -173,16 +144,8 @@ specStringCompat ast = \case layoutGuardLStmt :: ToBriDoc' (Stmt GhcPs (LHsExpr GhcPs)) layoutGuardLStmt lgstmt@(L _ stmtLR) = docWrapNode lgstmt $ case stmtLR of -#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ BodyStmt _ body _ _ -> layoutExpr body -#else - BodyStmt body _ _ _ -> layoutExpr body -#endif -#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ BindStmt _ lPat expr _ _ -> do -#else - BindStmt lPat expr _ _ _ -> do -#endif patDoc <- docSharedWrapper layoutPat lPat expDoc <- docSharedWrapper layoutExpr expr docCols ColBindStmt @@ -201,11 +164,7 @@ layoutBind (HsBindLR GhcPs GhcPs) (Either [BriDocNumbered] BriDocNumbered) layoutBind lbind@(L _ bind) = case bind of -#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ FunBind _ fId (MG _ lmatches@(L _ matches) _) _ [] -> do -#else - FunBind fId (MG lmatches@(L _ matches) _ _ _) _ _ [] -> do -#endif idStr <- lrdrNameToTextAnn fId binderDoc <- docLit $ Text.pack "=" funcPatDocs <- @@ -214,11 +173,7 @@ layoutBind lbind@(L _ bind) = case bind of $ layoutPatternBind (Just idStr) binderDoc `mapM` matches return $ Left $ funcPatDocs -#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ PatBind _ pat (GRHSs _ grhss whereBinds) ([], []) -> do -#else - PatBind pat (GRHSs grhss whereBinds) _ _ ([], []) -> do -#endif patDocs <- colsWrapPat =<< layoutPat pat clauseDocs <- layoutGrhs `mapM` grhss mWhereDocs <- layoutLocalBinds whereBinds @@ -233,10 +188,8 @@ layoutBind lbind@(L _ bind) = case bind of hasComments #if MIN_VERSION_ghc(8,8,0) PatSynBind _ (PSB _ patID lpat rpat dir) -> do -#elif MIN_VERSION_ghc(8,6,0) - PatSynBind _ (PSB _ patID lpat rpat dir) -> do #else - PatSynBind (PSB patID _ lpat rpat dir) -> do + PatSynBind _ (PSB _ patID lpat rpat dir) -> do #endif fmap Right $ docWrapNode lbind $ layoutPatSynBind patID lpat @@ -245,14 +198,9 @@ layoutBind lbind@(L _ bind) = case bind of _ -> Right <$> unknownNodeError "" lbind layoutIPBind :: ToBriDoc IPBind layoutIPBind lipbind@(L _ bind) = case bind of -#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ XIPBind{} -> unknownNodeError "XIPBind" lipbind IPBind _ (Right _) _ -> error "brittany internal error: IPBind Right" IPBind _ (Left (L _ (HsIPName name))) expr -> do -#else - IPBind (Right _) _ -> error "brittany internal error: IPBind Right" - IPBind (Left (L _ (HsIPName name))) expr -> do -#endif ipName <- docLit $ Text.pack $ '?' : FastString.unpackFS name binderDoc <- docLit $ Text.pack "=" exprDoc <- layoutExpr expr @@ -274,11 +222,7 @@ layoutLocalBinds lbinds@(L _ binds) = case binds of -- Just . (>>= either id return) . Data.Foldable.toList <$> mapBagM layoutBind lhsBindsLR -- TODO: fix ordering -- x@(HsValBinds (ValBindsIn{})) -> -- Just . (:[]) <$> unknownNodeError "HsValBinds (ValBindsIn _ (_:_))" x -#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ HsValBinds _ (ValBinds _ bindlrs sigs) -> do -#else - HsValBinds (ValBindsIn bindlrs sigs) -> do -#endif let unordered = [ BagBind b | b <- Data.Foldable.toList bindlrs ] ++ [ BagSig s | s <- sigs ] @@ -287,23 +231,12 @@ layoutLocalBinds lbinds@(L _ binds) = case binds of BagBind b -> either id return <$> layoutBind b BagSig s -> return <$> layoutSig s return $ Just $ docs -#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ -- x@(HsValBinds (ValBindsOut _binds _lsigs)) -> HsValBinds _ (XValBindsLR{}) -> error "brittany internal error: XValBindsLR" XHsLocalBindsLR{} -> error "brittany internal error: XHsLocalBindsLR" -#else - x@(HsValBinds (ValBindsOut _binds _lsigs)) -> - -- i _think_ this case never occurs in non-processed ast - Just . (: []) <$> unknownNodeError "HsValBinds ValBindsOut{}" - (L noSrcSpan x) -#endif -#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ x@(HsIPBinds _ XHsIPBinds{}) -> Just . (: []) <$> unknownNodeError "XHsIPBinds" (L noSrcSpan x) HsIPBinds _ (IPBinds _ bb) -> -#else - HsIPBinds (IPBinds bb _) -> -#endif Just <$> mapM layoutIPBind bb EmptyLocalBinds{} -> return $ Nothing @@ -312,17 +245,11 @@ layoutLocalBinds lbinds@(L _ binds) = case binds of layoutGrhs :: LGRHS GhcPs (LHsExpr GhcPs) -> ToBriDocM ([BriDocNumbered], BriDocNumbered, LHsExpr GhcPs) -#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ layoutGrhs lgrhs@(L _ (GRHS _ guards body)) = do -#else -layoutGrhs lgrhs@(L _ (GRHS guards body)) = do -#endif guardDocs <- docWrapNode lgrhs $ layoutStmt `mapM` guards bodyDoc <- layoutExpr body return (guardDocs, bodyDoc, body) -#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ layoutGrhs (L _ (XGRHS{})) = error "brittany internal error: XGRHS" -#endif layoutPatternBind :: Maybe Text @@ -331,19 +258,11 @@ layoutPatternBind -> ToBriDocM BriDocNumbered layoutPatternBind funId binderDoc lmatch@(L _ match) = do let pats = m_pats match -#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ let (GRHSs _ grhss whereBinds) = m_grhss match -#else - let (GRHSs grhss whereBinds) = m_grhss match -#endif patDocs <- pats `forM` \p -> fmap return $ colsWrapPat =<< layoutPat p let isInfix = isInfixMatch match mIdStr <- case match of -#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ Match _ (FunRhs matchId _ _) _ _ -> Just <$> lrdrNameToTextAnn matchId -#else - Match (FunRhs matchId _ _) _ _ -> Just <$> lrdrNameToTextAnn matchId -#endif _ -> pure Nothing let mIdStr' = fixPatternBindIdentifier match <$> mIdStr patDoc <- docWrapNodePrior lmatch $ case (mIdStr', patDocs) of @@ -785,11 +704,7 @@ layoutLPatSyn name (RecCon recArgs) = do -- pattern synonyms layoutPatSynWhere :: HsPatSynDir GhcPs -> ToBriDocM (Maybe [ToBriDocM BriDocNumbered]) layoutPatSynWhere hs = case hs of -#if MIN_VERSION_ghc(8,6,0) ExplicitBidirectional (MG _ (L _ lbinds) _) -> do -#else - ExplicitBidirectional (MG (L _ lbinds) _ _ _) -> do -#endif binderDoc <- docLit $ Text.pack "=" Just <$> mapM (docSharedWrapper $ layoutPatternBind Nothing binderDoc) lbinds _ -> pure Nothing @@ -800,17 +715,10 @@ layoutPatSynWhere hs = case hs of layoutTyCl :: ToBriDoc TyClDecl layoutTyCl ltycl@(L _loc tycl) = case tycl of -#if MIN_VERSION_ghc(8,6,0) SynDecl _ name vars fixity typ -> do let isInfix = case fixity of Prefix -> False Infix -> True -#else - SynDecl name vars fixity typ _ -> do - let isInfix = case fixity of - Prefix -> False - Infix -> True -#endif -- hasTrailingParen <- hasAnnKeywordComment ltycl AnnCloseP -- let parenWrapper = if hasTrailingParen -- then appSep . docWrapNodeRest ltycl @@ -818,11 +726,7 @@ layoutTyCl ltycl@(L _loc tycl) = case tycl of let wrapNodeRest = docWrapNodeRest ltycl docWrapNodePrior ltycl $ layoutSynDecl isInfix wrapNodeRest name (hsq_explicit vars) typ -#if MIN_VERSION_ghc(8,6,0) DataDecl _ext name tyVars _ dataDefn -> -#else - DataDecl name tyVars _ dataDefn _ _ -> -#endif layoutDataDecl ltycl name tyVars dataDefn _ -> briDocByExactNoComment ltycl @@ -870,19 +774,11 @@ layoutSynDecl isInfix wrapNodeRest name vars typ = do layoutTyVarBndr :: Bool -> ToBriDoc HsTyVarBndr layoutTyVarBndr needsSep lbndr@(L _ bndr) = do docWrapNodePrior lbndr $ case bndr of -#if MIN_VERSION_ghc(8,6,0) /* 8.6 */ XTyVarBndr{} -> error "brittany internal error: XTyVarBndr" UserTyVar _ name -> do -#else /* 8.4 */ - UserTyVar name -> do -#endif nameStr <- lrdrNameToTextAnn name docSeq $ [docSeparator | needsSep] ++ [docLit nameStr] -#if MIN_VERSION_ghc(8,6,0) /* 8.6 */ KindedTyVar _ name kind -> do -#else /* 8.4 */ - KindedTyVar name kind -> do -#endif nameStr <- lrdrNameToTextAnn name docSeq $ [ docSeparator | needsSep ] @@ -913,12 +809,8 @@ layoutTyFamInstDecl inClass outerNode tfid = do -- bndrsMay isJust e.g. with -- type instance forall a . MyType (Maybe a) = Either () a innerNode = outerNode -#elif MIN_VERSION_ghc(8,6,0) - FamEqn _ name pats _fixity typ = hsib_body $ tfid_eqn tfid - bndrsMay = Nothing - innerNode = outerNode #else - FamEqn name pats _fixity typ = hsib_body $ tfid_eqn tfid + FamEqn _ name pats _fixity typ = hsib_body $ tfid_eqn tfid bndrsMay = Nothing innerNode = outerNode #endif @@ -996,20 +888,13 @@ layoutClsInst lcid@(L _ cid) = docLines . ClsInstD NoExtField . removeChildren <$> lcid -#elif MIN_VERSION_ghc(8,6,0) /* 8.6 */ +#else layoutInstanceHead = briDocByExactNoComment $ InstD NoExt . ClsInstD NoExt . removeChildren <$> lcid -#else - layoutInstanceHead = - briDocByExactNoComment - $ InstD - . ClsInstD - . removeChildren - <$> lcid #endif removeChildren :: ClsInstDecl p -> ClsInstDecl p diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs b/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs index 8c089c2..ae514f1 100644 --- a/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs +++ b/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs @@ -44,65 +44,29 @@ layoutExpr lexpr@(L _ expr) = do .> confUnpack let allowFreeIndent = indentPolicy == IndentPolicyFree docWrapNode lexpr $ case expr of -#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ HsVar _ vname -> do -#else - HsVar vname -> do -#endif docLit =<< lrdrNameToTextAnn vname -#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ HsUnboundVar _ var -> case var of -#else - HsUnboundVar var -> case var of -#endif OutOfScope oname _ -> docLit $ Text.pack $ occNameString oname TrueExprHole oname -> docLit $ Text.pack $ occNameString oname HsRecFld{} -> do -- TODO briDocByExactInlineOnly "HsRecFld" lexpr -#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ HsOverLabel _ext _reboundFromLabel name -> -#else /* ghc-8.4 */ - HsOverLabel _reboundFromLabel name -> -#endif let label = FastString.unpackFS name in docLit . Text.pack $ '#' : label -#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ HsIPVar _ext (HsIPName name) -> -#else - HsIPVar (HsIPName name) -> -#endif let label = FastString.unpackFS name in docLit . Text.pack $ '?' : label -#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ HsOverLit _ olit -> do -#else - HsOverLit olit -> do -#endif allocateNode $ overLitValBriDoc $ ol_val olit -#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ HsLit _ lit -> do -#else - HsLit lit -> do -#endif allocateNode $ litBriDoc lit -#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ HsLam _ (MG _ (L _ [lmatch@(L _ match)]) _) -#else - HsLam (MG (L _ [lmatch@(L _ match)]) _ _ _) -#endif | pats <- m_pats match -#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ , GRHSs _ [lgrhs] llocals <- m_grhss match -#else - , GRHSs [lgrhs] llocals <- m_grhss match -#endif , L _ EmptyLocalBinds {} <- llocals -#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ , L _ (GRHS _ [] body) <- lgrhs -#else - , L _ (GRHS [] body) <- lgrhs -#endif -> do patDocs <- zip (True : repeat False) pats `forM` \(isFirst, p) -> fmap return $ do @@ -168,48 +132,26 @@ layoutExpr lexpr@(L _ expr) = do ] HsLam{} -> unknownNodeError "HsLam too complex" lexpr -#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ HsLamCase _ XMatchGroup{} -> error "brittany internal error: HsLamCase XMatchGroup" -#endif -#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ HsLamCase _ (MG _ (L _ []) _) -> do -#else /* ghc-8.4 */ - HsLamCase (MG (L _ []) _ _ _) -> do -#endif docSetParSpacing $ docAddBaseY BrIndentRegular $ (docLit $ Text.pack "\\case {}") -#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ HsLamCase _ (MG _ lmatches@(L _ matches) _) -> do -#else /* ghc-8.4 */ - HsLamCase (MG lmatches@(L _ matches) _ _ _) -> do -#endif binderDoc <- docLit $ Text.pack "->" funcPatDocs <- docWrapNode lmatches $ layoutPatternBind Nothing binderDoc `mapM` matches docSetParSpacing $ docAddBaseY BrIndentRegular $ docPar (docLit $ Text.pack "\\case") (docSetBaseAndIndent $ docNonBottomSpacing $ docLines $ return <$> funcPatDocs) -#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ HsApp _ exp1@(L _ HsApp{}) exp2 -> do -#else - HsApp exp1@(L _ HsApp{}) exp2 -> do -#endif let gather :: [LHsExpr GhcPs] -> LHsExpr GhcPs -> (LHsExpr GhcPs, [LHsExpr GhcPs]) gather list = \case -#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ L _ (HsApp _ l r) -> gather (r:list) l -#else - L _ (HsApp l r) -> gather (r:list) l -#endif x -> (x, list) let (headE, paramEs) = gather [exp2] exp1 let colsOrSequence = case headE of -#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ L _ (HsVar _ (L _ (Unqual occname))) -> -#else - L _ (HsVar (L _ (Unqual occname))) -> -#endif docCols (ColApp $ Text.pack $ occNameString occname) _ -> docSeq headDoc <- docSharedWrapper layoutExpr headE @@ -255,11 +197,7 @@ layoutExpr lexpr@(L _ expr) = do ( docNonBottomSpacing $ docLines paramDocs ) -#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ HsApp _ exp1 exp2 -> do -#else - HsApp exp1 exp2 -> do -#endif -- TODO: if expDoc1 is some literal, we may want to create a docCols here. expDoc1 <- docSharedWrapper layoutExpr exp1 expDoc2 <- docSharedWrapper layoutExpr exp2 @@ -301,12 +239,10 @@ layoutExpr lexpr@(L _ expr) = do HsAppType _ _ XHsWildCardBndrs{} -> error "brittany internal error: HsAppType XHsWildCardBndrs" HsAppType _ exp1 (HsWC _ ty1) -> do -#elif MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ +#else HsAppType XHsWildCardBndrs{} _ -> error "brittany internal error: HsAppType XHsWildCardBndrs" HsAppType (HsWC _ ty1) exp1 -> do -#else /* ghc-8.4 */ - HsAppType exp1 (HsWC _ ty1) -> do #endif t <- docSharedWrapper layoutType ty1 e <- docSharedWrapper layoutExpr exp1 @@ -321,23 +257,10 @@ layoutExpr lexpr@(L _ expr) = do e (docSeq [docLit $ Text.pack "@", t ]) ] -#if !MIN_VERSION_ghc(8,6,0) /* ghc-8.4 */ - HsAppTypeOut{} -> do - -- TODO - briDocByExactInlineOnly "HsAppTypeOut{}" lexpr -#endif -#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ OpApp _ expLeft@(L _ OpApp{}) expOp expRight -> do -#else - OpApp expLeft@(L _ OpApp{}) expOp _ expRight -> do -#endif let gather :: [(LHsExpr GhcPs, LHsExpr GhcPs)] -> LHsExpr GhcPs -> (LHsExpr GhcPs, [(LHsExpr GhcPs, LHsExpr GhcPs)]) gather opExprList = \case -#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ (L _ (OpApp _ l1 op1 r1)) -> gather ((op1, r1): opExprList) l1 -#else - (L _ (OpApp l1 op1 _ r1)) -> gather ((op1, r1): opExprList) l1 -#endif final -> (final, opExprList) (leftOperand, appList) = gather [] expLeft leftOperandDoc <- docSharedWrapper layoutExpr leftOperand @@ -351,19 +274,11 @@ layoutExpr lexpr@(L _ expr) = do hasComLeft <- hasAnyCommentsConnected expLeft hasComOp <- hasAnyCommentsConnected expOp pure $ not hasComLeft && not hasComOp -#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ let allowPar = case (expOp, expRight) of (L _ (HsVar _ (L _ (Unqual occname))), _) | occNameString occname == "$" -> True (_, L _ (HsApp _ _ (L _ HsVar{}))) -> False _ -> True -#else - let allowPar = case (expOp, expRight) of - (L _ (HsVar (L _ (Unqual occname))), _) - | occNameString occname == "$" -> True - (_, L _ (HsApp _ (L _ HsVar{}))) -> False - _ -> True -#endif runFilteredAlternative $ do -- > one + two + three -- or @@ -401,27 +316,15 @@ layoutExpr lexpr@(L _ expr) = do $ (appListDocs <&> \(od, ed) -> docCols ColOpPrefix [appSep od, docSetBaseY ed]) ++ [docCols ColOpPrefix [appSep opLastDoc, docSetBaseY expLastDoc]] ) -#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ OpApp _ expLeft expOp expRight -> do -#else - OpApp expLeft expOp _ expRight -> do -#endif expDocLeft <- docSharedWrapper layoutExpr expLeft expDocOp <- docSharedWrapper layoutExpr expOp expDocRight <- docSharedWrapper layoutExpr expRight -#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ let allowPar = case (expOp, expRight) of (L _ (HsVar _ (L _ (Unqual occname))), _) | occNameString occname == "$" -> True (_, L _ (HsApp _ _ (L _ HsVar{}))) -> False _ -> True -#else - let allowPar = case (expOp, expRight) of - (L _ (HsVar (L _ (Unqual occname))), _) - | occNameString occname == "$" -> True - (_, L _ (HsApp _ (L _ HsVar{}))) -> False - _ -> True -#endif let leftIsDoBlock = case expLeft of L _ HsDo{} -> True _ -> False @@ -467,20 +370,12 @@ layoutExpr lexpr@(L _ expr) = do then docLines [expDocLeft, expDocOpAndRight] else docAddBaseY BrIndentRegular $ docPar expDocLeft expDocOpAndRight -#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ NegApp _ op _ -> do -#else - NegApp op _ -> do -#endif opDoc <- docSharedWrapper layoutExpr op docSeq [ docLit $ Text.pack "-" , opDoc ] -#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ HsPar _ innerExp -> do -#else - HsPar innerExp -> do -#endif innerExpDoc <- docSharedWrapper (docWrapNode lexpr . layoutExpr) innerExp docAlt [ docSeq @@ -496,41 +391,25 @@ layoutExpr lexpr@(L _ expr) = do , docLit $ Text.pack ")" ] ] -#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ SectionL _ left op -> do -- TODO: add to testsuite -#else - SectionL left op -> do -- TODO: add to testsuite -#endif leftDoc <- docSharedWrapper layoutExpr left opDoc <- docSharedWrapper layoutExpr op docSeq [leftDoc, docSeparator, opDoc] -#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ SectionR _ op right -> do -- TODO: add to testsuite -#else - SectionR op right -> do -- TODO: add to testsuite -#endif opDoc <- docSharedWrapper layoutExpr op rightDoc <- docSharedWrapper layoutExpr right docSeq [opDoc, docSeparator, rightDoc] -#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ ExplicitTuple _ args boxity -> do -#else - ExplicitTuple args boxity -> do -#endif #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 */ +#else let argExprs = args <&> \arg -> case arg of (L _ (Present _ e)) -> (arg, Just e); (L _ (Missing NoExt)) -> (arg, Nothing) (L _ XTupArg{}) -> error "brittany internal error: XTupArg" -#else - let argExprs = args <&> \arg -> case arg of - (L _ (Present e)) -> (arg, Just e); - (L _ (Missing PlaceHolder)) -> (arg, Nothing) #endif argDocs <- forM argExprs $ docSharedWrapper @@ -576,15 +455,9 @@ layoutExpr lexpr@(L _ expr) = do lineN = docCols ColTuples [docCommaSep, docNodeAnnKW lexpr (Just AnnOpenP) eN] end = closeLit in docSetBaseY $ docLines $ [start] ++ linesM ++ [lineN, end] -#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ HsCase _ _ XMatchGroup{} -> error "brittany internal error: HsCase XMatchGroup" -#endif -#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ HsCase _ cExp (MG _ (L _ []) _) -> do -#else - HsCase cExp (MG (L _ []) _ _ _) -> do -#endif cExpDoc <- docSharedWrapper layoutExpr cExp docAlt [ docAddBaseY BrIndentRegular @@ -599,11 +472,7 @@ layoutExpr lexpr@(L _ expr) = do ) (docLit $ Text.pack "of {}") ] -#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ HsCase _ cExp (MG _ lmatches@(L _ matches) _) -> do -#else - HsCase cExp (MG lmatches@(L _ matches) _ _ _) -> do -#endif cExpDoc <- docSharedWrapper layoutExpr cExp binderDoc <- docLit $ Text.pack "->" funcPatDocs <- docWrapNode lmatches @@ -627,11 +496,7 @@ layoutExpr lexpr@(L _ expr) = do (docSetBaseAndIndent $ docNonBottomSpacing $ docLines $ return <$> funcPatDocs) ) ] -#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ HsIf _ _ ifExpr thenExpr elseExpr -> do -#else - HsIf _ ifExpr thenExpr elseExpr -> do -#endif ifExprDoc <- docSharedWrapper layoutExpr ifExpr thenExprDoc <- docSharedWrapper layoutExpr thenExpr elseExprDoc <- docSharedWrapper layoutExpr elseExpr @@ -751,11 +616,7 @@ layoutExpr lexpr@(L _ expr) = do docSetParSpacing $ docAddBaseY BrIndentRegular $ docPar (docLit $ Text.pack "if") (layoutPatternBindFinal Nothing binderDoc Nothing clauseDocs Nothing hasComments) -#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ HsLet _ binds exp1 -> do -#else - HsLet binds exp1 -> do -#endif expDoc1 <- docSharedWrapper layoutExpr exp1 -- We jump through some ugly hoops here to ensure proper sharing. hasComments <- hasAnyCommentsBelow lexpr @@ -861,11 +722,7 @@ layoutExpr lexpr@(L _ expr) = do ] _ -> docSeq [appSep $ docLit $ Text.pack "let in", expDoc1] -- docSeq [appSep $ docLit "let in", expDoc1] -#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ HsDo _ stmtCtx (L _ stmts) -> case stmtCtx of -#else - HsDo stmtCtx (L _ stmts) _ -> case stmtCtx of -#endif DoExpr -> do stmtDocs <- docSharedWrapper layoutStmt `mapM` stmts docSetParSpacing @@ -960,26 +817,13 @@ layoutExpr lexpr@(L _ expr) = do in docSetBaseY $ docLines $ [start] ++ linesM ++ [lineN] ++ [end] ExplicitList _ _ [] -> docLit $ Text.pack "[]" -#if !MIN_VERSION_ghc(8,6,0) /* ghc-8.4 */ - ExplicitPArr{} -> do - -- TODO - briDocByExactInlineOnly "ExplicitPArr{}" lexpr -#endif -#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ RecordCon _ lname fields -> -#else - RecordCon lname _ _ fields -> -#endif case fields of HsRecFields fs Nothing -> do let nameDoc = docWrapNode lname $ docLit $ lrdrNameToText lname rFs <- fs `forM` \lfield@(L _ (HsRecField (L _ fieldOcc) rFExpr pun)) -> do -#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ let FieldOcc _ lnameF = fieldOcc -#else - let FieldOcc lnameF _ = fieldOcc -#endif rFExpDoc <- if pun then return Nothing else Just <$> docSharedWrapper layoutExpr rFExpr @@ -999,22 +843,14 @@ layoutExpr lexpr@(L _ expr) = 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 */ let FieldOcc _ lnameF = fieldOcc -#else - let FieldOcc lnameF _ = fieldOcc -#endif fExpDoc <- if pun then return Nothing else Just <$> docSharedWrapper layoutExpr fExpr return (fieldl, lrdrNameToText lnameF, fExpDoc) recordExpression True indentPolicy lexpr nameDoc fieldDocs _ -> unknownNodeError "RecordCon with puns" lexpr -#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ RecordUpd _ rExpr fields -> do -#else - RecordUpd rExpr fields _ _ _ _ -> do -#endif rExprDoc <- docSharedWrapper layoutExpr rExpr rFs <- fields `forM` \lfield@(L _ (HsRecField (L _ ambName) rFExpr pun)) -> do @@ -1022,15 +858,10 @@ layoutExpr lexpr@(L _ expr) = do then return Nothing else Just <$> docSharedWrapper layoutExpr rFExpr return $ case ambName of -#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ Unambiguous _ n -> (lfield, lrdrNameToText n, rFExpDoc) Ambiguous _ n -> (lfield, lrdrNameToText n, rFExpDoc) XAmbiguousFieldOcc{} -> error "brittany internal error: XAmbiguousFieldOcc" -#else - Unambiguous n _ -> (lfield, lrdrNameToText n, rFExpDoc) - Ambiguous n _ -> (lfield, lrdrNameToText n, rFExpDoc) -#endif recordExpression False indentPolicy lexpr rExprDoc rFs #if MIN_VERSION_ghc(8,8,0) /* ghc-8.6 */ ExprWithTySig _ _ (HsWC _ XHsImplicitBndrs{}) -> @@ -1038,14 +869,12 @@ layoutExpr lexpr@(L _ expr) = do ExprWithTySig _ _ XHsWildCardBndrs{} -> error "brittany internal error: ExprWithTySig XHsWildCardBndrs" ExprWithTySig _ exp1 (HsWC _ (HsIB _ typ1)) -> do -#elif MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ +#else ExprWithTySig (HsWC _ XHsImplicitBndrs{}) _ -> error "brittany internal error: ExprWithTySig HsWC XHsImplicitBndrs" ExprWithTySig XHsWildCardBndrs{} _ -> error "brittany internal error: ExprWithTySig XHsWildCardBndrs" ExprWithTySig (HsWC _ (HsIB _ typ1)) exp1 -> do -#else /* ghc-8.4 */ - ExprWithTySig exp1 (HsWC _ (HsIB _ typ1 _)) -> do #endif expDoc <- docSharedWrapper layoutExpr exp1 typDoc <- docSharedWrapper layoutType typ1 @@ -1054,11 +883,6 @@ layoutExpr lexpr@(L _ expr) = do , appSep $ docLit $ Text.pack "::" , typDoc ] -#if !MIN_VERSION_ghc(8,6,0) /* ghc-8.4 */ - ExprWithTySigOut{} -> do - -- TODO - briDocByExactInlineOnly "ExprWithTySigOut{}" lexpr -#endif ArithSeq _ Nothing info -> case info of From e1 -> do @@ -1103,11 +927,6 @@ layoutExpr lexpr@(L _ expr) = do ] ArithSeq{} -> briDocByExactInlineOnly "ArithSeq" lexpr -#if !MIN_VERSION_ghc(8,6,0) /* ghc-8.4 */ - PArrSeq{} -> do - -- TODO - briDocByExactInlineOnly "PArrSeq{}" lexpr -#endif HsSCC{} -> do -- TODO briDocByExactInlineOnly "HsSCC{}" lexpr @@ -1123,11 +942,7 @@ layoutExpr lexpr@(L _ expr) = do HsTcBracketOut{} -> do -- TODO briDocByExactInlineOnly "HsTcBracketOut{}" lexpr -#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ HsSpliceE _ (HsQuasiQuote _ _ quoter _loc content) -> do -#else - HsSpliceE (HsQuasiQuote _ quoter _loc content) -> do -#endif allocateNode $ BDFPlain (Text.pack $ "[" @@ -1166,11 +981,7 @@ layoutExpr lexpr@(L _ expr) = do #else EWildPat{} -> do docLit $ Text.pack "_" -#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ EAsPat _ asName asExpr -> do -#else - EAsPat asName asExpr -> do -#endif docSeq [ docLit $ lrdrNameToText asName <> Text.pack "@" , layoutExpr asExpr @@ -1191,9 +1002,7 @@ layoutExpr lexpr@(L _ expr) = do ExplicitSum{} -> do -- TODO briDocByExactInlineOnly "ExplicitSum{}" lexpr -#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ XExpr{} -> error "brittany internal error: XExpr" -#endif recordExpression :: (Data.Data.Data lExpr, Data.Data.Data name) diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/IE.hs b/src/Language/Haskell/Brittany/Internal/Layouters/IE.hs index 739d138..4f7ec0e 100644 --- a/src/Language/Haskell/Brittany/Internal/Layouters/IE.hs +++ b/src/Language/Haskell/Brittany/Internal/Layouters/IE.hs @@ -39,32 +39,12 @@ prepareName = ieLWrappedName layoutIE :: ToBriDoc IE layoutIE lie@(L _ ie) = docWrapNode lie $ case ie of -#if MIN_VERSION_ghc(8,6,0) IEVar _ x -> layoutWrapped lie x -#else - IEVar x -> layoutWrapped lie x -#endif -#if MIN_VERSION_ghc(8,6,0) IEThingAbs _ x -> layoutWrapped lie x -#else - IEThingAbs x -> layoutWrapped lie x -#endif -#if MIN_VERSION_ghc(8,6,0) IEThingAll _ x -> docSeq [layoutWrapped lie x, docLit $ Text.pack "(..)"] -#else - IEThingAll x -> docSeq [layoutWrapped lie x, docLit $ Text.pack "(..)"] -#endif -#if MIN_VERSION_ghc(8,6,0) IEThingWith _ x (IEWildcard _) _ _ -> -#else - IEThingWith x (IEWildcard _) _ _ -> -#endif docSeq [layoutWrapped lie x, docLit $ Text.pack "(..)"] -#if MIN_VERSION_ghc(8,6,0) IEThingWith _ x _ ns _ -> do -#else - IEThingWith x _ ns _ -> do -#endif hasComments <- orM ( hasCommentsBetween lie AnnOpenP AnnCloseP : hasAnyCommentsBelow x @@ -95,11 +75,7 @@ layoutIE lie@(L _ ie) = docWrapNode lie $ case ie of $ [docSeq [docParenLSep, docWrapNode n1 $ nameDoc n1]] ++ map layoutItem nMs ++ [docSeq [docCommaSep, docNodeAnnKW lie (Just AnnOpenP) $ nameDoc nN], docParenR] -#if MIN_VERSION_ghc(8,6,0) IEModuleContents _ n -> docSeq -#else - IEModuleContents n -> docSeq -#endif [ docLit $ Text.pack "module" , docSeparator , docLit . Text.pack . moduleNameString $ unLoc n diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Import.hs b/src/Language/Haskell/Brittany/Internal/Layouters/Import.hs index ac29eda..cdcd8ed 100644 --- a/src/Language/Haskell/Brittany/Internal/Layouters/Import.hs +++ b/src/Language/Haskell/Brittany/Internal/Layouters/Import.hs @@ -37,11 +37,7 @@ prepModName = unLoc layoutImport :: ToBriDoc ImportDecl layoutImport limportD@(L _ importD) = docWrapNode limportD $ case importD of -#if MIN_VERSION_ghc(8,6,0) ImportDecl _ _ (L _ modName) pkg src safe q False mas mllies -> do -#else - ImportDecl _ (L _ modName) pkg src safe q False mas mllies -> do -#endif importCol <- mAsk <&> _conf_layout .> _lconfig_importColumn .> confUnpack importAsCol <- mAsk <&> _conf_layout .> _lconfig_importAsColumn .> confUnpack indentPolicy <- mAsk <&> _conf_layout .> _lconfig_indentPolicy .> confUnpack diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Pattern.hs b/src/Language/Haskell/Brittany/Internal/Layouters/Pattern.hs index fb0ba51..037d693 100644 --- a/src/Language/Haskell/Brittany/Internal/Layouters/Pattern.hs +++ b/src/Language/Haskell/Brittany/Internal/Layouters/Pattern.hs @@ -48,26 +48,16 @@ layoutPat :: LPat GhcPs -> ToBriDocM (Seq BriDocNumbered) layoutPat (ghcDL -> lpat@(L _ pat)) = docWrapNode lpat $ case pat of WildPat _ -> fmap Seq.singleton $ docLit $ Text.pack "_" -- _ -> expr -#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ VarPat _ n -> -#else /* ghc-8.4 */ - VarPat n -> -#endif fmap Seq.singleton $ docLit $ lrdrNameToText n -- abc -> expr -#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ LitPat _ lit -> -#else /* ghc-8.4 */ - LitPat lit -> -#endif fmap Seq.singleton $ allocateNode $ litBriDoc lit -- 0 -> expr #if MIN_VERSION_ghc(8,8,0) /* ghc-8.8 */ ParPat _ inner -> do -#elif MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ +#else ParPat _ inner -> do -#else /* ghc-8.4 */ - ParPat inner -> do #endif -- (nestedpat) -> expr left <- docLit $ Text.pack "(" @@ -117,11 +107,7 @@ layoutPat (ghcDL -> lpat@(L _ pat)) = docWrapNode lpat $ case pat of -- Abc { a, b, c } -> expr2 let t = lrdrNameToText lname fds <- fs `forM` \(L _ (HsRecField (L _ fieldOcc) fPat pun)) -> do -#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ let FieldOcc _ lnameF = fieldOcc -#else - let FieldOcc lnameF _ = fieldOcc -#endif fExpDoc <- if pun then return Nothing else Just <$> docSharedWrapper layoutPat fPat @@ -159,11 +145,7 @@ layoutPat (ghcDL -> lpat@(L _ pat)) = docWrapNode lpat $ case pat of -- Abc { a = locA, .. } let t = lrdrNameToText lname fds <- fs `forM` \(L _ (HsRecField (L _ fieldOcc) fPat pun)) -> do -#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ let FieldOcc _ lnameF = fieldOcc -#else - let FieldOcc lnameF _ = fieldOcc -#endif fExpDoc <- if pun then return Nothing else Just <$> docSharedWrapper layoutPat fPat @@ -181,29 +163,19 @@ layoutPat (ghcDL -> lpat@(L _ pat)) = docWrapNode lpat $ case pat of (fieldName, Nothing) -> [docLit fieldName, docCommaSep] , docLit $ Text.pack "..}" ] -#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ TuplePat _ args boxity -> do -#else - TuplePat args boxity _ -> do -#endif -- (nestedpat1, nestedpat2, nestedpat3) -> expr -- (#nestedpat1, nestedpat2, nestedpat3#) -> expr case boxity of Boxed -> wrapPatListy args "()" docParenL docParenR Unboxed -> wrapPatListy args "(##)" docParenHashLSep docParenHashRSep -#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ AsPat _ asName asPat -> do -#else - AsPat asName asPat -> do -#endif -- bind@nestedpat -> expr wrapPatPrepend asPat (docLit $ lrdrNameToText asName <> Text.pack "@") #if MIN_VERSION_ghc(8,8,0) /* ghc-8.8 */ SigPat _ pat1 (HsWC _ (HsIB _ ty1)) -> do -#elif MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ +#else SigPat (HsWC _ (HsIB _ ty1)) pat1 -> do -#else /* ghc-8.4 */ - SigPatIn pat1 (HsWC _ (HsIB _ ty1 _)) -> do #endif -- i :: Int -> expr patDocs <- layoutPat pat1 @@ -224,33 +196,17 @@ layoutPat (ghcDL -> lpat@(L _ pat)) = docWrapNode lpat $ case pat of , docForceSingleline tyDoc ] return $ xR Seq.|> xN' -#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ ListPat _ elems -> -#else - ListPat elems _ _ -> -#endif -- [] -> expr1 -- [nestedpat1, nestedpat2, nestedpat3] -> expr2 wrapPatListy elems "[]" docBracketL docBracketR -#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ BangPat _ pat1 -> do -#else - BangPat pat1 -> do -#endif -- !nestedpat -> expr wrapPatPrepend pat1 (docLit $ Text.pack "!") -#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ LazyPat _ pat1 -> do -#else - LazyPat pat1 -> do -#endif -- ~nestedpat -> expr wrapPatPrepend pat1 (docLit $ Text.pack "~") -#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ NPat _ llit@(L _ ol) mNegative _ -> do -#else - NPat llit@(L _ ol) mNegative _ _ -> do -#endif -- -13 -> expr litDoc <- docWrapNode llit $ allocateNode $ overLitValBriDoc $ GHC.ol_val ol negDoc <- docLit $ Text.pack "-" diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Stmt.hs b/src/Language/Haskell/Brittany/Internal/Layouters/Stmt.hs index 60ba54b..5427d7a 100644 --- a/src/Language/Haskell/Brittany/Internal/Layouters/Stmt.hs +++ b/src/Language/Haskell/Brittany/Internal/Layouters/Stmt.hs @@ -38,17 +38,9 @@ layoutStmt lstmt@(L _ stmt) = do indentAmount :: Int <- mAsk <&> _conf_layout .> _lconfig_indentAmount .> confUnpack docWrapNode lstmt $ case stmt of -#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ LastStmt _ body False _ -> do -#else - LastStmt body False _ -> do -#endif layoutExpr body -#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ BindStmt _ lPat expr _ _ -> do -#else - BindStmt lPat expr _ _ _ -> do -#endif patDoc <- fmap return $ colsWrapPat =<< layoutPat lPat expDoc <- docSharedWrapper layoutExpr expr docAlt @@ -67,11 +59,7 @@ layoutStmt lstmt@(L _ stmt) = do $ docPar (docLit $ Text.pack "<-") (expDoc) ] ] -#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ LetStmt _ binds -> do -#else - LetStmt binds -> do -#endif let isFree = indentPolicy == IndentPolicyFree let indentFourPlus = indentAmount >= 4 layoutLocalBinds binds >>= \case @@ -116,11 +104,7 @@ layoutStmt lstmt@(L _ stmt) = do $ docAddBaseY BrIndentRegular $ docPar (docLit $ Text.pack "let") (docSetBaseAndIndent $ docLines $ return <$> bindDocs) -#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ RecStmt _ stmts _ _ _ _ _ -> runFilteredAlternative $ do -#else - RecStmt stmts _ _ _ _ _ _ _ _ _ -> runFilteredAlternative $ do -#endif -- rec stmt1 -- stmt2 -- stmt3 @@ -136,11 +120,7 @@ layoutStmt lstmt@(L _ stmt) = do addAlternative $ docAddBaseY BrIndentRegular $ docPar (docLit (Text.pack "rec")) (docLines $ layoutStmt <$> stmts) -#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ BodyStmt _ expr _ _ -> do -#else - BodyStmt expr _ _ _ -> do -#endif expDoc <- docSharedWrapper layoutExpr expr docAddBaseY BrIndentRegular $ expDoc _ -> briDocByExactInlineOnly "some unknown statement" lstmt diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Type.hs b/src/Language/Haskell/Brittany/Internal/Layouters/Type.hs index a2b55d7..3437fcd 100644 --- a/src/Language/Haskell/Brittany/Internal/Layouters/Type.hs +++ b/src/Language/Haskell/Brittany/Internal/Layouters/Type.hs @@ -42,16 +42,12 @@ import DataTreePrint layoutType :: ToBriDoc HsType layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of -- _ | traceShow (ExactPrint.Types.mkAnnKey ltype) False -> error "impossible" -#if MIN_VERSION_ghc(8,6,0) HsTyVar _ promoted name -> do -#else /* ghc-8.4 */ - HsTyVar promoted name -> do -#endif t <- lrdrNameToTextAnnTypeEqualityIsSpecial name case promoted of #if MIN_VERSION_ghc(8,8,0) IsPromoted -> docSeq -#else /* ghc-8.4 8.6 */ +#else /* ghc-8.6 */ Promoted -> docSeq #endif [ docSeparator @@ -61,10 +57,8 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of NotPromoted -> docWrapNode name $ docLit t #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 + HsForAllTy _ bndrs (L _ (HsQualTy _ (L _ cntxts) typ2)) -> do #endif typeDoc <- docSharedWrapper layoutType typ2 tyVarDocs <- layoutTyVarBndrs bndrs @@ -153,10 +147,8 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of ] #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 + HsForAllTy _ bndrs typ2 -> do #endif typeDoc <- layoutType typ2 tyVarDocs <- layoutTyVarBndrs bndrs @@ -212,11 +204,7 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of ] ) ] -#if MIN_VERSION_ghc(8,6,0) HsQualTy _ lcntxts@(L _ cntxts) typ1 -> do -#else - HsQualTy lcntxts@(L _ cntxts) typ1 -> do -#endif typeDoc <- docSharedWrapper layoutType typ1 cntxtDocs <- cntxts `forM` docSharedWrapper layoutType let @@ -266,11 +254,7 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of ] ) ] -#if MIN_VERSION_ghc(8,6,0) HsFunTy _ typ1 typ2 -> do -#else - HsFunTy typ1 typ2 -> do -#endif typeDoc1 <- docSharedWrapper layoutType typ1 typeDoc2 <- docSharedWrapper layoutType typ2 let maybeForceML = case typ2 of @@ -294,11 +278,7 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of ] ) ] -#if MIN_VERSION_ghc(8,6,0) HsParTy _ typ1 -> do -#else - HsParTy typ1 -> do -#endif typeDoc1 <- docSharedWrapper layoutType typ1 docAlt [ docSeq @@ -313,7 +293,6 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of ]) (docLit $ Text.pack ")") ] -#if MIN_VERSION_ghc(8,6,0) HsAppTy _ typ1@(L _ HsAppTy{}) typ2 -> do let gather :: [LHsType GhcPs] -> LHsType GhcPs -> (LHsType GhcPs, [LHsType GhcPs]) gather list = \case @@ -341,65 +320,7 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of typeDoc1 (docEnsureIndent BrIndentRegular typeDoc2) ] -#else - HsAppTy typ1 typ2 -> do - typeDoc1 <- docSharedWrapper layoutType typ1 - typeDoc2 <- docSharedWrapper layoutType typ2 - docAlt - [ docSeq - [ docForceSingleline typeDoc1 - , docSeparator - , docForceSingleline typeDoc2 - ] - , docPar - typeDoc1 - (docEnsureIndent BrIndentRegular typeDoc2) - ] - HsAppsTy [] -> error "HsAppsTy []" - HsAppsTy [L _ (HsAppPrefix typ1)] -> do - typeDoc1 <- docSharedWrapper layoutType typ1 - typeDoc1 - HsAppsTy [lname@(L _ (HsAppInfix name))] -> do - -- this redirection is somewhat hacky, but whatever. - -- TODO: a general problem when doing deep inspections on - -- the type (and this is not the only instance) - -- is that we potentially omit annotations on some of - -- the middle constructors. i have no idea under which - -- circumstances exactly important annotations (comments) - -- would be assigned to such constructors. - typeDoc1 <- -- docSharedWrapper layoutType $ (L l $ HsTyVar name) - lrdrNameToTextAnnTypeEqualityIsSpecialAndRespectTick lname name - docLit typeDoc1 - HsAppsTy (L _ (HsAppPrefix typHead):typRestA) - | Just typRest <- mapM (\case L _ (HsAppPrefix t) -> Just t - _ -> Nothing) typRestA -> do - docHead <- docSharedWrapper layoutType typHead - docRest <- docSharedWrapper layoutType `mapM` typRest - docAlt - [ docSeq - $ docForceSingleline docHead : (docRest >>= \d -> - [ docSeparator, docForceSingleline d ]) - , docPar docHead (docLines $ docEnsureIndent BrIndentRegular <$> docRest) - ] - HsAppsTy (typHead:typRest) -> do - docHead <- docSharedWrapper layoutAppType typHead - docRest <- docSharedWrapper layoutAppType `mapM` typRest - docAlt - [ docSeq - $ docForceSingleline docHead : (docRest >>= \d -> - [ docSeparator, docForceSingleline d ]) - , docPar docHead (docLines $ docEnsureIndent BrIndentRegular <$> docRest) - ] - where - layoutAppType (L _ (HsAppPrefix t)) = layoutType t - layoutAppType lt@(L _ (HsAppInfix t)) = - docLit =<< lrdrNameToTextAnnTypeEqualityIsSpecialAndRespectTick lt t -#endif -#if MIN_VERSION_ghc(8,6,0) HsListTy _ typ1 -> do -#else - HsListTy typ1 -> do -#endif typeDoc1 <- docSharedWrapper layoutType typ1 docAlt [ docSeq @@ -414,29 +335,7 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of ]) (docLit $ Text.pack "]") ] -#if MIN_VERSION_ghc(8,6,0) -#else - HsPArrTy typ1 -> do - typeDoc1 <- docSharedWrapper layoutType typ1 - docAlt - [ docSeq - [ docWrapNodeRest ltype $ docLit $ Text.pack "[:" - , docForceSingleline typeDoc1 - , docLit $ Text.pack ":]" - ] - , docPar - ( docCols ColTyOpPrefix - [ docWrapNodeRest ltype $ docLit $ Text.pack "[:" - , docAddBaseY (BrIndentSpecial 2) $ typeDoc1 - ]) - (docLit $ Text.pack ":]") - ] -#endif -#if MIN_VERSION_ghc(8,6,0) HsTupleTy _ tupleSort typs -> case tupleSort of -#else - HsTupleTy tupleSort typs -> case tupleSort of -#endif HsUnboxedTuple -> unboxed HsBoxedTuple -> simple HsConstraintTuple -> simple @@ -539,11 +438,7 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of -- } -- , _layouter_ast = ltype -- } -#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ HsIParamTy _ (L _ (HsIPName ipName)) typ1 -> do -#else /* ghc-8.4 */ - HsIParamTy (L _ (HsIPName ipName)) typ1 -> do -#endif typeDoc1 <- docSharedWrapper layoutType typ1 docAlt [ docSeq @@ -562,33 +457,8 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of , docAddBaseY (BrIndentSpecial 2) typeDoc1 ]) ] -#if MIN_VERSION_ghc(8,6,0) -#else - HsEqTy typ1 typ2 -> do - typeDoc1 <- docSharedWrapper layoutType typ1 - typeDoc2 <- docSharedWrapper layoutType typ2 - docAlt - [ docSeq - [ docForceSingleline typeDoc1 - , docWrapNodeRest ltype - $ docLit $ Text.pack " ~ " - , docForceSingleline typeDoc2 - ] - , docPar - typeDoc1 - ( docCols ColTyOpPrefix - [ docWrapNodeRest ltype - $ docLit $ Text.pack "~ " - , docAddBaseY (BrIndentSpecial 2) typeDoc2 - ]) - ] -#endif -- TODO: test KindSig -#if MIN_VERSION_ghc(8,6,0) HsKindSig _ typ1 kind1 -> do -#else - HsKindSig typ1 kind1 -> do -#endif typeDoc1 <- docSharedWrapper layoutType typ1 kindDoc1 <- docSharedWrapper layoutType kind1 hasParens <- hasAnnKeyword ltype AnnOpenP @@ -738,32 +608,22 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of ] HsExplicitTupleTy{} -> -- TODO briDocByExactInlineOnly "HsExplicitTupleTy{}" ltype -#if MIN_VERSION_ghc(8,6,0) HsTyLit _ lit -> case lit of -#else - HsTyLit lit -> case lit of -#endif HsNumTy (SourceText srctext) _ -> docLit $ Text.pack srctext HsNumTy NoSourceText _ -> error "overLitValBriDoc: literal with no SourceText" HsStrTy (SourceText srctext) _ -> docLit $ Text.pack srctext HsStrTy NoSourceText _ -> error "overLitValBriDoc: literal with no SourceText" -#if !MIN_VERSION_ghc(8,6,0) - HsCoreTy{} -> -- TODO - briDocByExactInlineOnly "HsCoreTy{}" ltype -#endif HsWildCardTy _ -> docLit $ Text.pack "_" HsSumTy{} -> -- TODO briDocByExactInlineOnly "HsSumTy{}" ltype -#if MIN_VERSION_ghc(8,6,0) HsStarTy _ isUnicode -> do if isUnicode then docLit $ Text.pack "\x2605" -- Unicode star else docLit $ Text.pack "*" XHsType{} -> error "brittany internal error: XHsType" -#endif #if MIN_VERSION_ghc(8,8,0) HsAppKindTy _ ty kind -> do t <- docSharedWrapper layoutType ty @@ -785,18 +645,11 @@ layoutTyVarBndrs :: [LHsTyVarBndr GhcPs] -> ToBriDocM [(Text, Maybe (ToBriDocM BriDocNumbered))] layoutTyVarBndrs = mapM $ \case -#if MIN_VERSION_ghc(8,6,0) (L _ (UserTyVar _ name)) -> return $ (lrdrNameToText name, Nothing) (L _ (KindedTyVar _ lrdrName kind)) -> do d <- docSharedWrapper layoutType kind return $ (lrdrNameToText lrdrName, Just $ d) (L _ (XTyVarBndr{})) -> error "brittany internal error: XTyVarBndr" -#else - (L _ (UserTyVar name)) -> return $ (lrdrNameToText name, Nothing) - (L _ (KindedTyVar lrdrName kind)) -> do - d <- docSharedWrapper layoutType kind - return $ (lrdrNameToText lrdrName, Just $ d) -#endif -- there is no specific reason this returns a list instead of a single -- BriDoc node. diff --git a/src/Language/Haskell/Brittany/Internal/Prelude.hs b/src/Language/Haskell/Brittany/Internal/Prelude.hs index e9a6979..b33e339 100644 --- a/src/Language/Haskell/Brittany/Internal/Prelude.hs +++ b/src/Language/Haskell/Brittany/Internal/Prelude.hs @@ -407,7 +407,7 @@ todo = error "todo" #if MIN_VERSION_ghc(8,8,0) ghcDL :: GHC.HasSrcSpan a => a -> GHC.Located (GHC.SrcSpanLess a) ghcDL = GHC.dL -#else /* ghc-8.4 8.6 */ +#else /* ghc-8.6 */ ghcDL :: GHC.Located a -> GHC.Located a ghcDL x = x #endif diff --git a/src/Language/Haskell/Brittany/Internal/Utils.hs b/src/Language/Haskell/Brittany/Internal/Utils.hs index 4b4061e..5ee7ed2 100644 --- a/src/Language/Haskell/Brittany/Internal/Utils.hs +++ b/src/Language/Haskell/Brittany/Internal/Utils.hs @@ -304,11 +304,8 @@ lines' s = case break (== '\n') s of #if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */ absurdExt :: HsExtension.NoExtCon -> a absurdExt = HsExtension.noExtCon -#elif MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ +#else -- | A method to dismiss NoExt patterns for total matches absurdExt :: HsExtension.NoExt -> a absurdExt = error "cannot construct NoExt" -#else -absurdExt :: () -absurdExt = () #endif diff --git a/stack-8.4.3.yaml b/stack-8.4.3.yaml deleted file mode 100644 index f925568..0000000 --- a/stack-8.4.3.yaml +++ /dev/null @@ -1,4 +0,0 @@ -resolver: lts-12.12 - -extra-deps: - - ghc-exactprint-0.5.8.1 diff --git a/stack-8.4.3.yaml.lock b/stack-8.4.3.yaml.lock deleted file mode 100644 index b4a4818..0000000 --- a/stack-8.4.3.yaml.lock +++ /dev/null @@ -1,19 +0,0 @@ -# This file was autogenerated by Stack. -# You should not edit this file by hand. -# For more information, please see the documentation at: -# https://docs.haskellstack.org/en/stable/lock_files - -packages: -- completed: - hackage: ghc-exactprint-0.5.8.1@sha256:f76eed0976b854ce03928796e9cff97769e304618ca99bc0f6cdccab31e539d0,7728 - pantry-tree: - size: 83871 - sha256: 14febc191ef8b0d1f218d13e8db9ed20395f10a5b3d8aa2c0d45869a037420a2 - original: - hackage: ghc-exactprint-0.5.8.1 -snapshots: -- completed: - size: 504336 - url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/12/12.yaml - sha256: 11db5c37144d13fe6b56cd511050b4e6ffe988f6edb8e439c2432fc9fcdf50c3 - original: lts-12.12