Adapt for ghc-8.2

Could it be so simple?
pull/51/head
Lennart Spitzner 2017-08-05 17:34:53 +02:00
parent ccb59ef803
commit b39997fcfa
5 changed files with 80 additions and 9 deletions

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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