From b39997fcfaf9d536823c062067e779a576b8df47 Mon Sep 17 00:00:00 2001 From: Lennart Spitzner Date: Sat, 5 Aug 2017 17:34:53 +0200 Subject: [PATCH] Adapt for ghc-8.2 Could it be so simple? --- brittany.cabal | 6 +-- .../Brittany/Internal/Layouters/Decl.hs | 4 ++ .../Brittany/Internal/Layouters/Expr.hs | 47 +++++++++++++++++++ .../Brittany/Internal/Layouters/Pattern.hs | 4 ++ .../Brittany/Internal/Layouters/Type.hs | 28 ++++++++--- 5 files changed, 80 insertions(+), 9 deletions(-) diff --git a/brittany.cabal b/brittany.cabal index 6420d7d..3231c23 100644 --- a/brittany.cabal +++ b/brittany.cabal @@ -87,8 +87,8 @@ library { ghc-options: -O0 -Werror -fobject-code } build-depends: - { base >=4.9 && <4.10 - , ghc >=8.0.1 && <8.1 + { base >=4.9 && <4.11 + , ghc >=8.0.1 && <8.3 , ghc-paths >=0.1.0.9 && <0.2 , ghc-exactprint >=0.5.3.0 && <0.6 , transformers >=0.5.2.0 && <0.6 @@ -116,7 +116,7 @@ library { , semigroups >=0.18.2 && <0.19 , cmdargs >=0.10.14 && <0.11 , czipwith >=1.0.0.0 && <1.1 - , ghc-boot-th >=8.0.1 && <8.1 + , ghc-boot-th >=8.0.1 && <8.3 } default-extensions: { CPP diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Decl.hs b/src/Language/Haskell/Brittany/Internal/Layouters/Decl.hs index 2cac911..5073eab 100644 --- a/src/Language/Haskell/Brittany/Internal/Layouters/Decl.hs +++ b/src/Language/Haskell/Brittany/Internal/Layouters/Decl.hs @@ -43,7 +43,11 @@ import Bag ( mapBagM ) layoutSig :: ToBriDoc Sig layoutSig lsig@(L _loc sig) = case sig of +#if MIN_VERSION_ghc(8,2,0) /* ghc-8.2 */ + TypeSig names (HsWC _ (HsIB _ typ _)) -> docWrapNode lsig $ do +#else /* ghc-8.0 */ TypeSig names (HsIB _ (HsWC _ _ typ)) -> docWrapNode lsig $ do +#endif nameStrs <- names `forM` lrdrNameToTextAnn let nameStr = Text.intercalate (Text.pack ", ") $ nameStrs typeDoc <- docSharedWrapper layoutType typ diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs b/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs index 6451513..253d475 100644 --- a/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs +++ b/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs @@ -94,7 +94,11 @@ layoutExpr lexpr@(L _ expr) = docWrapNode lexpr $ case expr of ] HsLam{} -> unknownNodeError "HsLam too complex" lexpr +#if MIN_VERSION_ghc(8,2,0) /* ghc-8.2 */ + HsLamCase (MG lmatches@(L _ matches) _ _ _) -> do +#else /* ghc-8.0 */ HsLamCase _ (MG lmatches@(L _ matches) _ _ _) -> do +#endif binderDoc <- docLit $ Text.pack "->" funcPatDocs <- docWrapNode lmatches $ layoutPatternBind Nothing binderDoc `mapM` matches docSetParSpacing $ docAddBaseY BrIndentRegular $ docPar @@ -167,7 +171,11 @@ layoutExpr lexpr@(L _ expr) = docWrapNode lexpr $ case expr of expDoc1 expDoc2 ] +#if MIN_VERSION_ghc(8,2,0) /* ghc-8.2 */ + HsAppType exp1 (HsWC _ ty1) -> do +#else /* ghc-8.0 */ HsAppType exp1 (HsWC _ _ ty1) -> do +#endif t <- docSharedWrapper layoutType ty1 e <- docSharedWrapper layoutExpr exp1 docAlt @@ -791,7 +799,11 @@ layoutExpr lexpr@(L _ expr) = docWrapNode lexpr $ case expr of ] in [line1] ++ lineR ++ [lineN]) ] +#if MIN_VERSION_ghc(8,2,0) /* ghc-8.2 */ + ExprWithTySig exp1 (HsWC _ (HsIB _ typ1 _)) -> do +#else /* ghc-8.0 */ ExprWithTySig exp1 (HsIB _ (HsWC _ _ typ1)) -> do +#endif expDoc <- docSharedWrapper layoutExpr exp1 typDoc <- docSharedWrapper layoutType typ1 docSeq @@ -902,7 +914,41 @@ layoutExpr lexpr@(L _ expr) = docWrapNode lexpr $ case expr of HsWrap{} -> do -- TODO briDocByExactInlineOnly "HsWrap{}" lexpr +#if MIN_VERSION_ghc(8,2,0) /* ghc-8.2 */ + HsConLikeOut{} -> do + -- TODO + briDocByExactInlineOnly "HsWrap{}" lexpr + ExplicitSum{} -> do + -- TODO + briDocByExactInlineOnly "ExplicitSum{}" lexpr +#endif + +#if MIN_VERSION_ghc(8,2,0) /* ghc-8.2 */ +litBriDoc :: HsLit -> BriDocFInt +litBriDoc = \case + HsChar (SourceText t) _c -> BDFLit $ Text.pack t -- BDFLit $ Text.pack $ ['\'', c, '\''] + HsCharPrim (SourceText t) _c -> BDFLit $ Text.pack t -- BDFLit $ Text.pack $ ['\'', c, '\''] + HsString (SourceText t) _fastString -> BDFLit $ Text.pack t -- BDFLit $ Text.pack $ FastString.unpackFS fastString + HsStringPrim (SourceText t) _byteString -> BDFLit $ Text.pack t -- BDFLit $ Text.pack $ Data.ByteString.Char8.unpack byteString + HsInt (SourceText t) _i -> BDFLit $ Text.pack t -- BDFLit $ Text.pack $ show i + HsIntPrim (SourceText t) _i -> BDFLit $ Text.pack t -- BDFLit $ Text.pack $ show i + HsWordPrim (SourceText t) _i -> BDFLit $ Text.pack t -- BDFLit $ Text.pack $ show i + HsInt64Prim (SourceText t) _i -> BDFLit $ Text.pack t -- BDFLit $ Text.pack $ show i + HsWord64Prim (SourceText t) _i -> BDFLit $ Text.pack t -- BDFLit $ Text.pack $ show i + HsInteger (SourceText t) _i _type -> BDFLit $ Text.pack t -- BDFLit $ Text.pack $ show i + HsRat (FL t _) _type -> BDFLit $ Text.pack t + HsFloatPrim (FL t _) -> BDFLit $ Text.pack t + HsDoublePrim (FL t _) -> BDFLit $ Text.pack t + _ -> error "litBriDoc: literal with no SourceText" + +overLitValBriDoc :: OverLitVal -> BriDocFInt +overLitValBriDoc = \case + HsIntegral (SourceText t) _ -> BDFLit $ Text.pack t + HsFractional (FL t _) -> BDFLit $ Text.pack t + HsIsString (SourceText t) _ -> BDFLit $ Text.pack t + _ -> error "overLitValBriDoc: literal with no SourceText" +#else litBriDoc :: HsLit -> BriDocFInt litBriDoc = \case HsChar t _c -> BDFLit $ Text.pack t -- BDFLit $ Text.pack $ ['\'', c, '\''] @@ -924,3 +970,4 @@ overLitValBriDoc = \case HsIntegral t _ -> BDFLit $ Text.pack t HsFractional (FL t _) -> BDFLit $ Text.pack t HsIsString t _ -> BDFLit $ Text.pack t +#endif diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Pattern.hs b/src/Language/Haskell/Brittany/Internal/Layouters/Pattern.hs index 77915f8..40624c2 100644 --- a/src/Language/Haskell/Brittany/Internal/Layouters/Pattern.hs +++ b/src/Language/Haskell/Brittany/Internal/Layouters/Pattern.hs @@ -102,7 +102,11 @@ layoutPat lpat@(L _ pat) = docWrapNode lpat $ case pat of Unboxed -> wrapPatListy args "(#" "#)" AsPat asName asPat -> do wrapPatPrepend asPat (docLit $ lrdrNameToText asName <> Text.pack "@") +#if MIN_VERSION_ghc(8,2,0) /* ghc-8.2 */ + SigPatIn pat1 (HsWC _ (HsIB _ ty1 _)) -> do +#else /* ghc-8.0 */ SigPatIn pat1 (HsIB _ (HsWC _ _ ty1)) -> do +#endif patDocs <- layoutPat pat1 tyDoc <- docSharedWrapper layoutType ty1 case Seq.viewr patDocs of diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Type.hs b/src/Language/Haskell/Brittany/Internal/Layouters/Type.hs index 0ca6ab7..f72594c 100644 --- a/src/Language/Haskell/Brittany/Internal/Layouters/Type.hs +++ b/src/Language/Haskell/Brittany/Internal/Layouters/Type.hs @@ -27,7 +27,11 @@ 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,2,0) /* ghc-8.2 */ + HsTyVar _ name -> do +#else /* ghc-8.0 */ HsTyVar name -> do +#endif t <- lrdrNameToTextAnn name docWrapNode name $ docLit t HsForAllTy bndrs (L _ (HsQualTy (L _ cntxts@(_:_)) typ2)) -> do @@ -463,7 +467,11 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of -- } -- , _layouter_ast = ltype -- } +#if MIN_VERSION_ghc(8,2,0) /* ghc-8.2 */ + HsIParamTy (L _ (HsIPName ipName)) typ1 -> do +#else /* ghc-8.0 */ HsIParamTy (HsIPName ipName) typ1 -> do +#endif typeDoc1 <- docSharedWrapper layoutType typ1 docAlt [ docSeq @@ -571,12 +579,16 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of -- , _layouter_ast = ltype -- } HsSpliceTy{} -> -- TODO - briDocByExactInlineOnly "" ltype + briDocByExactInlineOnly "HsSpliceTy{}" ltype HsDocTy{} -> -- TODO - briDocByExactInlineOnly "" ltype + briDocByExactInlineOnly "HsDocTy{}" ltype HsRecTy{} -> -- TODO - briDocByExactInlineOnly "" ltype + briDocByExactInlineOnly "HsRecTy{}" ltype +#if MIN_VERSION_ghc(8,2,0) /* ghc-8.2 */ + HsExplicitListTy _ _ typs -> do +#else /* ghc-8.0 */ HsExplicitListTy _ typs -> do +#endif typDocs <- docSharedWrapper layoutType `mapM` typs docAlt [ docSeq @@ -586,10 +598,14 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of -- TODO ] HsExplicitTupleTy{} -> -- TODO - briDocByExactInlineOnly "" ltype + briDocByExactInlineOnly "HsExplicitTupleTy{}" ltype HsTyLit{} -> -- TODO - briDocByExactInlineOnly "" ltype + briDocByExactInlineOnly "HsTyLit{}" ltype HsCoreTy{} -> -- TODO - briDocByExactInlineOnly "" ltype + briDocByExactInlineOnly "HsCoreTy{}" ltype HsWildCardTy _ -> docLit $ Text.pack "_" +#if MIN_VERSION_ghc(8,2,0) /* ghc-8.2 */ + HsSumTy{} -> -- TODO + briDocByExactInlineOnly "HsSumTy{}" ltype +#endif