diff --git a/brittany.cabal b/brittany.cabal
index da69f91..9f04fff 100644
--- a/brittany.cabal
+++ b/brittany.cabal
@@ -83,12 +83,12 @@ library {
-fno-warn-redundant-constraints
}
build-depends:
- { base >=4.9 && <4.12
- , ghc >=8.0.1 && <8.5
+ { base >=4.9 && <4.13
+ , ghc >=8.0.1 && <8.7
, ghc-paths >=0.1.0.9 && <0.2
, ghc-exactprint >=0.5.8 && <0.5.9
, transformers >=0.5.2.0 && <0.6
- , containers >=0.5.7.1 && <0.6
+ , containers >=0.5.7.1 && <0.7
, mtl >=2.2.1 && <2.3
, text >=1.2 && <1.3
, multistate >=0.7.1.1 && <0.9
@@ -111,7 +111,7 @@ library {
, semigroups >=0.18.2 && <0.19
, cmdargs >=0.10.14 && <0.11
, czipwith >=1.0.1.0 && <1.1
- , ghc-boot-th >=8.0.1 && <8.5
+ , ghc-boot-th >=8.0.1 && <8.7
, 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 5b6e7ef..9720106 100644
--- a/src/Language/Haskell/Brittany/Internal.hs
+++ b/src/Language/Haskell/Brittany/Internal.hs
@@ -487,10 +487,17 @@ ppModule lmod@(L _loc _m@(HsModule _name _exports _ decls _ _)) = do
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
@@ -564,15 +571,26 @@ 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 7c582f1..0c4f901 100644
--- a/src/Language/Haskell/Brittany/Internal/ExactPrintUtils.hs
+++ b/src/Language/Haskell/Brittany/Internal/ExactPrintUtils.hs
@@ -197,9 +197,17 @@ commentAnnFixTransform modul = SYB.everything (>>) genF modul
genF = (\_ -> return ()) `SYB.extQ` exprF
exprF :: Located (HsExpr GhcPs) -> ExactPrint.Transform ()
exprF lexpr@(L _ expr) = case expr of
- RecordCon _lname _ _ (HsRecFields fs@(_:_) Nothing) ->
+#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)
- RecordUpd _lname 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 ()
@@ -280,13 +288,13 @@ withTransformedAnns
=> ast
-> MultiRWSS.MultiRWS '[Config, ExactPrint.Anns] w s a
-> MultiRWSS.MultiRWS '[Config, ExactPrint.Anns] w s a
-withTransformedAnns ast m = do
- -- TODO: implement `local` for MultiReader/MultiRWS
- readers@(conf :+: anns :+: HNil) <- MultiRWSS.mGetRawR
- MultiRWSS.mPutRawR (conf :+: f anns :+: HNil)
- x <- m
- MultiRWSS.mPutRawR readers
- pure x
+withTransformedAnns ast m = MultiRWSS.mGetRawR >>= \case
+ readers@(conf :+: anns :+: HNil) -> do
+ -- TODO: implement `local` for MultiReader/MultiRWS
+ MultiRWSS.mPutRawR (conf :+: f anns :+: HNil)
+ x <- m
+ MultiRWSS.mPutRawR readers
+ pure x
where
f anns =
let ((), (annsBalanced, _), _) =
diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Decl.hs b/src/Language/Haskell/Brittany/Internal/Layouters/Decl.hs
index 2616312..37724f6 100644
--- a/src/Language/Haskell/Brittany/Internal/Layouters/Decl.hs
+++ b/src/Language/Haskell/Brittany/Internal/Layouters/Decl.hs
@@ -55,28 +55,43 @@ 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
+ Left ns -> docLines $ return <$> ns
+ Right n -> return n
+ TyClD _ tycl -> withTransformedAnns d $ layoutTyCl (L loc tycl)
+ InstD _ (TyFamInstD{}) -> layoutTyFamInstDWorkaround d
+ 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{}) -> do
- -- this is a (temporary (..)) workaround for "type instance" decls
- -- that do not round-trip through exactprint properly.
- let fixer s = case List.stripPrefix "type " s of
- Just rest | not ("instance" `isPrefixOf` rest) ->
- "type instance " ++ rest
- _ -> s
- str <- mAsk <&> \anns ->
- intercalate "\n" $ fmap fixer $ lines' $ ExactPrint.exactPrint d anns
- allocateNode $ BDFExternal (ExactPrint.mkAnnKey d)
- (foldedAnnKeys d)
- False
- (Text.pack str)
+ InstD (TyFamInstD{}) -> layoutTyFamInstDWorkaround d
InstD (ClsInstD inst) -> withTransformedAnns d $ layoutClsInst (L loc inst)
- _ -> briDocByExactNoComment d
+ _ -> briDocByExactNoComment d
+#endif
+layoutTyFamInstDWorkaround :: ToBriDoc HsDecl
+layoutTyFamInstDWorkaround d = do
+ -- this is a (temporary (..)) workaround for "type instance" decls
+ -- that do not round-trip through exactprint properly.
+ let fixer s = case List.stripPrefix "type " s of
+ Just rest | not ("instance" `isPrefixOf` rest) ->
+ "type instance " ++ rest
+ _ -> s
+ str <- mAsk <&> \anns ->
+ intercalate "\n" $ fmap fixer $ lines' $ ExactPrint.exactPrint d anns
+ allocateNode $ BDFExternal (ExactPrint.mkAnnKey d)
+ (foldedAnnKeys d)
+ False
+ (Text.pack str)
--------------------------------------------------------------------------------
-- Sig
@@ -84,12 +99,18 @@ layoutDecl d@(L loc decl) = case decl of
layoutSig :: ToBriDoc Sig
layoutSig lsig@(L _loc sig) = case sig of
-#if MIN_VERSION_ghc(8,2,0) /* ghc-8.2 */
+#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
+ TypeSig _ names (HsWC _ (HsIB _ typ)) -> layoutNamesAndType names typ
+#elif MIN_VERSION_ghc(8,2,0) /* ghc-8.2 8.4 */
TypeSig names (HsWC _ (HsIB _ typ _)) -> layoutNamesAndType names typ
#else /* ghc-8.0 */
TypeSig names (HsIB _ (HsWC _ _ typ)) -> layoutNamesAndType 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
@@ -106,7 +127,9 @@ layoutSig lsig@(L _loc sig) = case sig of
$ Text.pack ("{-# " ++ specStr ++ conlikeStr ++ phaseStr)
<> nameStr
<> Text.pack " #-}"
-#if MIN_VERSION_ghc(8,2,0) /* ghc-8.2 */
+#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
+ ClassOpSig _ False names (HsIB _ typ) -> layoutNamesAndType names typ
+#elif MIN_VERSION_ghc(8,2,0) /* ghc-8.2 8.4 */
ClassOpSig False names (HsIB _ typ _) -> layoutNamesAndType names typ
#else /* ghc-8.0 */
ClassOpSig False names (HsIB _ typ) -> layoutNamesAndType names typ
@@ -152,7 +175,6 @@ layoutSig lsig@(L _loc sig) = case sig of
)
]
-
specStringCompat
:: MonadMultiWriter [BrittanyError] m => LSig GhcPs -> InlineSpec -> m String
#if MIN_VERSION_ghc(8,4,0)
@@ -171,8 +193,16 @@ specStringCompat _ = \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
@@ -191,7 +221,11 @@ 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 <-
@@ -200,7 +234,11 @@ 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
@@ -229,7 +267,11 @@ 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 ]
@@ -238,23 +280,36 @@ 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)
- x@(HsIPBinds _ipBinds) ->
+#endif
+ x@(HsIPBinds{}) ->
Just . (: []) <$> unknownNodeError "HsIPBinds" (L noSrcSpan x)
- EmptyLocalBinds -> return $ Nothing
+ EmptyLocalBinds{} -> return $ Nothing
-- TODO: we don't need the `LHsExpr GhcPs` anymore, now that there is
-- parSpacing stuff.B
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
@@ -263,7 +318,11 @@ layoutPatternBind
-> ToBriDocM BriDocNumbered
layoutPatternBind mIdStr 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
let mIdStr' = fixPatternBindIdentifier match <$> mIdStr
@@ -629,7 +688,12 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs mWhereDocs ha
layoutTyCl :: ToBriDoc TyClDecl
layoutTyCl ltycl@(L _loc tycl) = case tycl of
-#if MIN_VERSION_ghc(8,2,0)
+#if MIN_VERSION_ghc(8,6,0)
+ SynDecl _ name vars fixity typ -> do
+ let isInfix = case fixity of
+ Prefix -> False
+ Infix -> True
+#elif MIN_VERSION_ghc(8,2,0)
SynDecl name vars fixity typ _ -> do
let isInfix = case fixity of
Prefix -> False
@@ -700,10 +764,19 @@ 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.0 8.2 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.0 8.2 8.4 */
KindedTyVar name kind -> do
+#endif
nameStr <- lrdrNameToTextAnn name
docSeq
$ [ docSeparator | needsSep ]
@@ -736,8 +809,21 @@ layoutClsInst lcid@(L _ cid) = docLines
]
where
layoutInstanceHead :: ToBriDocM BriDocNumbered
+#if MIN_VERSION_ghc(8,6,0) /* 8.6 */
layoutInstanceHead =
- briDocByExactNoComment $ InstD . ClsInstD . removeChildren <$> lcid
+ briDocByExactNoComment
+ $ InstD NoExt
+ . ClsInstD NoExt
+ . removeChildren
+ <$> lcid
+#else
+ layoutInstanceHead =
+ briDocByExactNoComment
+ $ InstD
+ . ClsInstD
+ . removeChildren
+ <$> lcid
+#endif
removeChildren :: ClsInstDecl p -> ClsInstDecl p
removeChildren c = c
diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs b/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs
index 3ade42e..cab2baa 100644
--- a/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs
+++ b/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs
@@ -37,9 +37,17 @@ 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
@@ -51,15 +59,35 @@ layoutExpr lexpr@(L _ expr) = do
HsIPVar{} -> do
-- TODO
briDocByExactInlineOnly "HsOverLabel{}" lexpr
- HsOverLit (OverLit olit _ _ _) -> do
- allocateNode $ overLitValBriDoc olit
+#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
- , GRHSs [lgrhs] llocals <- m_grhss match
- , L _ EmptyLocalBinds <- llocals
- , L _ (GRHS [] body) <- lgrhs
+#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 <- pats `forM` \p -> fmap return $ colsWrapPat =<< layoutPat p
bodyDoc <- docAddBaseY BrIndentRegular <$> docSharedWrapper layoutExpr body
@@ -105,9 +133,13 @@ layoutExpr lexpr@(L _ expr) = do
]
HsLam{} ->
unknownNodeError "HsLam too complex" lexpr
-#if MIN_VERSION_ghc(8,2,0) /* ghc-8.2 */
+#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
+ HsLamCase _ XMatchGroup{} ->
+ error "brittany internal error: HsLamCase XMatchGroup"
+ HsLamCase _ (MG _ lmatches@(L _ matches) _) -> do
+#elif MIN_VERSION_ghc(8,2,0) /* ghc-8.2 8.4*/
HsLamCase (MG lmatches@(L _ matches) _ _ _) -> do
-#else /* ghc-8.0 */
+#else /* ghc-8.0 */
HsLamCase _ (MG lmatches@(L _ matches) _ _ _) -> do
#endif
binderDoc <- docLit $ Text.pack "->"
@@ -116,14 +148,26 @@ layoutExpr lexpr@(L _ expr) = do
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
@@ -168,7 +212,11 @@ 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
@@ -206,9 +254,13 @@ layoutExpr lexpr@(L _ expr) = do
expDoc1
expDoc2
]
-#if MIN_VERSION_ghc(8,2,0) /* ghc-8.2 */
+#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
+ HsAppType XHsWildCardBndrs{} _ ->
+ error "brittany internal error: HsAppType XHsWildCardBndrs"
+ HsAppType (HsWC _ ty1) exp1 -> do
+#elif MIN_VERSION_ghc(8,2,0) /* ghc-8.2 8.4 */
HsAppType exp1 (HsWC _ ty1) -> do
-#else /* ghc-8.0 */
+#else /* ghc-8.0 */
HsAppType exp1 (HsWC _ _ ty1) -> do
#endif
t <- docSharedWrapper layoutType ty1
@@ -224,13 +276,23 @@ layoutExpr lexpr@(L _ expr) = do
e
(docSeq [docLit $ Text.pack "@", t ])
]
+#if !MIN_VERSION_ghc(8,6,0) /* ghc-8.0 8.2 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
@@ -244,11 +306,19 @@ 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
@@ -286,15 +356,27 @@ 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
runFilteredAlternative $ do
-- one-line
addAlternative
@@ -334,12 +416,20 @@ layoutExpr lexpr@(L _ expr) = do
$ docPar
expDocLeft
(docCols ColOpPrefix [appSep expDocOp, docSetBaseY expDocRight])
+#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
@@ -355,18 +445,37 @@ 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,6,0) /* ghc-8.6 */
+ 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
$ \(arg, exprM) -> docWrapNode arg $ maybe docEmpty layoutExpr exprM
@@ -408,7 +517,13 @@ 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"
+ 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
@@ -432,7 +547,11 @@ 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
@@ -552,7 +671,11 @@ 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.
mBindDocs <- mapM (fmap (fmap return) . docWrapNodeRest lexpr . return)
@@ -655,60 +778,65 @@ layoutExpr lexpr@(L _ expr) = do
]
_ -> docSeq [appSep $ docLit $ Text.pack "let in", expDoc1]
-- docSeq [appSep $ docLit "let in", expDoc1]
- HsDo DoExpr (L _ stmts) _ -> do
- stmtDocs <- docSharedWrapper layoutStmt `mapM` stmts
- docSetParSpacing
- $ docAddBaseY BrIndentRegular
- $ docPar
- (docLit $ Text.pack "do")
- (docSetBaseAndIndent $ docNonBottomSpacing $ docLines stmtDocs)
- HsDo MDoExpr (L _ stmts) _ -> do
- stmtDocs <- docSharedWrapper layoutStmt `mapM` stmts
- docSetParSpacing
- $ docAddBaseY BrIndentRegular
- $ docPar
- (docLit $ Text.pack "mdo")
- (docSetBaseAndIndent $ docNonBottomSpacing $ docLines stmtDocs)
- HsDo x (L _ stmts) _ | case x of { ListComp -> True
- ; MonadComp -> True
- ; _ -> False } -> do
- stmtDocs <- docSharedWrapper layoutStmt `mapM` stmts
- hasComments <- hasAnyCommentsBelow lexpr
- runFilteredAlternative $ do
- addAlternativeCond (not hasComments)
- $ docSeq
- [ docNodeAnnKW lexpr Nothing
- $ appSep
- $ docLit
- $ Text.pack "["
- , docNodeAnnKW lexpr (Just AnnOpenS)
- $ appSep
- $ docForceSingleline
- $ List.last stmtDocs
- , appSep $ docLit $ Text.pack "|"
- , docSeq $ List.intersperse docCommaSep
- $ docForceSingleline <$> List.init stmtDocs
- , docLit $ Text.pack " ]"
- ]
- addAlternative $
- let
- start = docCols ColListComp
- [ docNodeAnnKW lexpr Nothing
- $ appSep $ docLit $ Text.pack "["
- , docSetBaseY
- $ docNodeAnnKW lexpr (Just AnnOpenS)
- $ List.last stmtDocs
- ]
- (s1:sM) = List.init stmtDocs
- line1 = docCols ColListComp
- [appSep $ docLit $ Text.pack "|", s1]
- lineM = sM <&> \d ->
- docCols ColListComp [docCommaSep, d]
- end = docLit $ Text.pack "]"
- in docSetBaseY $ docLines $ [start, line1] ++ lineM ++ [end]
- HsDo{} -> do
- -- TODO
- unknownNodeError "HsDo{} no comp" lexpr
+#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
+ $ docAddBaseY BrIndentRegular
+ $ docPar
+ (docLit $ Text.pack "do")
+ (docSetBaseAndIndent $ docNonBottomSpacing $ docLines stmtDocs)
+ MDoExpr -> do
+ stmtDocs <- docSharedWrapper layoutStmt `mapM` stmts
+ docSetParSpacing
+ $ docAddBaseY BrIndentRegular
+ $ docPar
+ (docLit $ Text.pack "mdo")
+ (docSetBaseAndIndent $ docNonBottomSpacing $ docLines stmtDocs)
+ x | case x of { ListComp -> True
+ ; MonadComp -> True
+ ; _ -> False } -> do
+ stmtDocs <- docSharedWrapper layoutStmt `mapM` stmts
+ hasComments <- hasAnyCommentsBelow lexpr
+ runFilteredAlternative $ do
+ addAlternativeCond (not hasComments)
+ $ docSeq
+ [ docNodeAnnKW lexpr Nothing
+ $ appSep
+ $ docLit
+ $ Text.pack "["
+ , docNodeAnnKW lexpr (Just AnnOpenS)
+ $ appSep
+ $ docForceSingleline
+ $ List.last stmtDocs
+ , appSep $ docLit $ Text.pack "|"
+ , docSeq $ List.intersperse docCommaSep
+ $ docForceSingleline <$> List.init stmtDocs
+ , docLit $ Text.pack " ]"
+ ]
+ addAlternative $
+ let
+ start = docCols ColListComp
+ [ docNodeAnnKW lexpr Nothing
+ $ appSep $ docLit $ Text.pack "["
+ , docSetBaseY
+ $ docNodeAnnKW lexpr (Just AnnOpenS)
+ $ List.last stmtDocs
+ ]
+ (s1:sM) = List.init stmtDocs
+ line1 = docCols ColListComp
+ [appSep $ docLit $ Text.pack "|", s1]
+ lineM = sM <&> \d ->
+ docCols ColListComp [docCommaSep, d]
+ end = docLit $ Text.pack "]"
+ in docSetBaseY $ docLines $ [start, line1] ++ lineM ++ [end]
+ _ -> do
+ -- TODO
+ unknownNodeError "HsDo{} unknown stmtCtx" lexpr
ExplicitList _ _ elems@(_:_) -> do
elemDocs <- elems `forM` docSharedWrapper layoutExpr
hasComments <- hasAnyCommentsBelow lexpr
@@ -749,80 +877,101 @@ 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.0 8.2 8.4 */
ExplicitPArr{} -> do
-- TODO
briDocByExactInlineOnly "ExplicitPArr{}" lexpr
- RecordCon lname _ _ (HsRecFields fields Nothing) -> do
- let nameDoc = docWrapNode lname $ docLit $ lrdrNameToText lname
- rFs <- fields
- `forM` \lfield@(L _ (HsRecField (L _ (FieldOcc lnameF _)) rFExpr pun)) -> do
- rFExpDoc <- if pun
- then return Nothing
- else Just <$> docSharedWrapper layoutExpr rFExpr
- return $ (lfield, lrdrNameToText lnameF, rFExpDoc)
- recordExpression indentPolicy lexpr nameDoc rFs
-
- RecordCon lname _ _ (HsRecFields [] (Just 0)) -> do
- let t = lrdrNameToText lname
- docWrapNode lname $ docLit $ t <> Text.pack " { .. }"
- RecordCon lname _ _ (HsRecFields fs@(_:_) (Just dotdoti)) | dotdoti == length fs -> do
- -- TODO this should be consolidated into `recordExpression`
- let nameDoc = docWrapNode lname $ docLit $ lrdrNameToText lname
- ((fd1l, fd1n, fd1e):fdr) <- fs `forM` \fieldl@(L _ (HsRecField (L _ (FieldOcc lnameF _)) fExpr pun)) -> do
- fExpDoc <- if pun
- then return Nothing
- else Just <$> docSharedWrapper layoutExpr fExpr
- return (fieldl, lrdrNameToText lnameF, fExpDoc)
- let line1 wrapper =
- [ appSep $ docLit $ Text.pack "{"
- , docWrapNodePrior fd1l $ appSep $ docLit fd1n
- , case fd1e of
- Just x -> docSeq
- [ appSep $ docLit $ Text.pack "="
- , docWrapNodeRest fd1l $ wrapper x
- ]
- Nothing -> docEmpty
+#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
+ return $ (lfield, lrdrNameToText lnameF, rFExpDoc)
+ recordExpression indentPolicy lexpr nameDoc rFs
+ HsRecFields [] (Just 0) -> do
+ let t = lrdrNameToText lname
+ docWrapNode lname $ docLit $ t <> Text.pack " { .. }"
+ HsRecFields fs@(_:_) (Just dotdoti) | dotdoti == length fs -> do
+ -- TODO this should be consolidated into `recordExpression`
+ 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)
+ let ((fd1l, fd1n, fd1e):fdr) = fieldDocs
+ let line1 wrapper =
+ [ appSep $ docLit $ Text.pack "{"
+ , docWrapNodePrior fd1l $ appSep $ docLit fd1n
+ , case fd1e of
+ Just x -> docSeq
+ [ appSep $ docLit $ Text.pack "="
+ , docWrapNodeRest fd1l $ wrapper x
+ ]
+ Nothing -> docEmpty
+ ]
+ let lineR wrapper = fdr <&> \(lfield, fText, fDoc) ->
+ [ docCommaSep
+ , appSep $ docLit fText
+ , case fDoc of
+ Just x -> docWrapNode lfield $ docSeq
+ [ appSep $ docLit $ Text.pack "="
+ , wrapper x
+ ]
+ Nothing -> docEmpty
+ ]
+ let lineDot =
+ [ docCommaSep
+ , docLit $ Text.pack ".."
+ ]
+ let lineN =
+ [ docNodeAnnKW lexpr (Just AnnOpenC) docEmpty
+ , docLit $ Text.pack "}"
+ ]
+ docAlt -- TODO: make this addFilteredAlternative and a hanging layout when Free
+ [ docSeq
+ $ [docNodeAnnKW lexpr Nothing nameDoc, docSeparator]
+ ++ line1 docForceSingleline
+ ++ join (lineR docForceSingleline)
+ ++ lineDot
+ ++ [docSeparator]
+ ++ lineN
+ , docSetParSpacing
+ $ docAddBaseY BrIndentRegular
+ $ docPar
+ (docNodeAnnKW lexpr Nothing nameDoc)
+ ( docNonBottomSpacing
+ $ docLines
+ $ [docCols ColRec $ line1 (docAddBaseY BrIndentRegular)]
+ ++ (docCols ColRec <$> lineR (docAddBaseY BrIndentRegular))
+ ++ [docSeq lineDot, docSeq lineN]
+ )
]
- let lineR wrapper = fdr <&> \(lfield, fText, fDoc) ->
- [ docCommaSep
- , appSep $ docLit fText
- , case fDoc of
- Just x -> docWrapNode lfield $ docSeq
- [ appSep $ docLit $ Text.pack "="
- , wrapper x
- ]
- Nothing -> docEmpty
- ]
- let lineDot =
- [ docCommaSep
- , docLit $ Text.pack ".."
- ]
- let lineN =
- [ docNodeAnnKW lexpr (Just AnnOpenC) docEmpty
- , docLit $ Text.pack "}"
- ]
- docAlt -- TODO: make this addFilteredAlternative and a hanging layout when Free
- [ docSeq
- $ [docNodeAnnKW lexpr Nothing nameDoc, docSeparator]
- ++ line1 docForceSingleline
- ++ join (lineR docForceSingleline)
- ++ lineDot
- ++ [docSeparator]
- ++ lineN
- , docSetParSpacing
- $ docAddBaseY BrIndentRegular
- $ docPar
- (docNodeAnnKW lexpr Nothing nameDoc)
- ( docNonBottomSpacing
- $ docLines
- $ [docCols ColRec $ line1 (docAddBaseY BrIndentRegular)]
- ++ (docCols ColRec <$> lineR (docAddBaseY BrIndentRegular))
- ++ [docSeq lineDot, docSeq lineN]
- )
- ]
- RecordCon{} ->
- unknownNodeError "RecordCon with puns" lexpr
+ _ -> 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
@@ -830,10 +979,23 @@ 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 indentPolicy lexpr rExprDoc rFs
-#if MIN_VERSION_ghc(8,2,0) /* ghc-8.2 */
+#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
+ ExprWithTySig (HsWC _ XHsImplicitBndrs{}) _ ->
+ error "brittany internal error: ExprWithTySig HsWC XHsImplicitBndrs"
+ ExprWithTySig XHsWildCardBndrs{} _ ->
+ error "brittany internal error: ExprWithTySig XHsWildCardBndrs"
+ ExprWithTySig (HsWC _ (HsIB _ typ1)) exp1 -> do
+#elif MIN_VERSION_ghc(8,2,0) /* ghc-8.2 8,4 */
ExprWithTySig exp1 (HsWC _ (HsIB _ typ1 _)) -> do
#else /* ghc-8.0 */
ExprWithTySig exp1 (HsIB _ (HsWC _ _ typ1)) -> do
@@ -845,9 +1007,11 @@ layoutExpr lexpr@(L _ expr) = do
, appSep $ docLit $ Text.pack "::"
, typDoc
]
+#if !MIN_VERSION_ghc(8,6,0) /* ghc-8.0 8.2 8.4 */
ExprWithTySigOut{} -> do
-- TODO
briDocByExactInlineOnly "ExprWithTySigOut{}" lexpr
+#endif
ArithSeq _ Nothing info ->
case info of
From e1 -> do
@@ -892,9 +1056,11 @@ layoutExpr lexpr@(L _ expr) = do
]
ArithSeq{} ->
briDocByExactInlineOnly "ArithSeq" lexpr
+#if !MIN_VERSION_ghc(8,6,0) /* ghc-8.0 8.2 8.4 */
PArrSeq{} -> do
-- TODO
briDocByExactInlineOnly "PArrSeq{}" lexpr
+#endif
HsSCC{} -> do
-- TODO
briDocByExactInlineOnly "HsSCC{}" lexpr
@@ -936,7 +1102,11 @@ layoutExpr lexpr@(L _ expr) = do
briDocByExactInlineOnly "HsTickPragma{}" lexpr
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
@@ -958,6 +1128,9 @@ layoutExpr lexpr@(L _ expr) = do
-- TODO
briDocByExactInlineOnly "ExplicitSum{}" lexpr
#endif
+#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)
@@ -1073,7 +1246,6 @@ recordExpression indentPolicy lexpr nameDoc rFs@((rF1f, rF1n, rF1e):rFr) =
in [line1] ++ lineR ++ [lineN]
)
-
#if MIN_VERSION_ghc(8,4,0) /* ghc-8.4 */
litBriDoc :: HsLit GhcPs -> BriDocFInt
litBriDoc = \case
diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/IE.hs b/src/Language/Haskell/Brittany/Internal/Layouters/IE.hs
index 42329cf..0407a3c 100644
--- a/src/Language/Haskell/Brittany/Internal/Layouters/IE.hs
+++ b/src/Language/Haskell/Brittany/Internal/Layouters/IE.hs
@@ -39,12 +39,32 @@ prepareName = id
layoutIE :: ToBriDoc IE
layoutIE lie@(L _ ie) = docWrapNode lie $ case ie of
- IEVar x -> layoutWrapped lie x
+#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 <- hasAnyCommentsBelow lie
runFilteredAlternative $ do
addAlternativeCond (not hasComments)
@@ -68,7 +88,11 @@ layoutIE lie@(L _ ie) = docWrapNode lie $ case ie of
$ [docSeq [docParenLSep, docWrapNode n1 $ nameDoc n1]]
++ map layoutItem nMs
++ [docSeq [docCommaSep, docWrapNodeRest lie $ 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 fc43ecf..bcce106 100644
--- a/src/Language/Haskell/Brittany/Internal/Layouters/Import.hs
+++ b/src/Language/Haskell/Brittany/Internal/Layouters/Import.hs
@@ -43,7 +43,11 @@ prepModName = id
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 f409c30..e77856c 100644
--- a/src/Language/Haskell/Brittany/Internal/Layouters/Pattern.hs
+++ b/src/Language/Haskell/Brittany/Internal/Layouters/Pattern.hs
@@ -13,7 +13,7 @@ where
import Language.Haskell.Brittany.Internal.Types
import Language.Haskell.Brittany.Internal.LayouterBasics
-import GHC ( Located, runGhc, GenLocated(L), moduleNameString )
+import GHC ( Located, runGhc, GenLocated(L), moduleNameString, ol_val )
import HsSyn
import Name
import BasicTypes
@@ -37,11 +37,25 @@ layoutPat :: ToBriDocC (Pat GhcPs) (Seq BriDocNumbered)
layoutPat lpat@(L _ pat) = docWrapNode lpat $ case pat of
WildPat _ -> fmap Seq.singleton $ docLit $ Text.pack "_"
-- _ -> expr
- VarPat n -> fmap Seq.singleton $ docLit $ lrdrNameToText n
+#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
+ VarPat _ n ->
+#else /* ghc-8.0 8.2 8.4 */
+ VarPat n ->
+#endif
+ fmap Seq.singleton $ docLit $ lrdrNameToText n
-- abc -> expr
- LitPat lit -> fmap Seq.singleton $ allocateNode $ litBriDoc lit
+#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
+ LitPat _ lit ->
+#else /* ghc-8.0 8.2 8.4 */
+ LitPat lit ->
+#endif
+ fmap Seq.singleton $ allocateNode $ litBriDoc lit
-- 0 -> expr
+#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
+ ParPat _ inner -> do
+#else /* ghc-8.0 8.2 8.4 */
ParPat inner -> do
+#endif
-- (nestedpat) -> expr
left <- docLit $ Text.pack "("
right <- docLit $ Text.pack ")"
@@ -89,7 +103,12 @@ layoutPat lpat@(L _ pat) = docWrapNode lpat $ case pat of
-- Abc { a = locA, b = locB, c = locC } -> expr1
-- Abc { a, b, c } -> expr2
let t = lrdrNameToText lname
- fds <- fs `forM` \(L _ (HsRecField (L _ (FieldOcc lnameF _)) fPat pun)) -> do
+ 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
@@ -118,7 +137,12 @@ layoutPat lpat@(L _ pat) = docWrapNode lpat $ case pat of
ConPatIn lname (RecCon (HsRecFields fs@(_:_) (Just dotdoti))) | dotdoti == length fs -> do
-- Abc { a = locA, .. }
let t = lrdrNameToText lname
- fds <- fs `forM` \(L _ (HsRecField (L _ (FieldOcc lnameF _)) fPat pun)) -> do
+ 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
@@ -136,18 +160,28 @@ layoutPat 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,2,0) /* ghc-8.2 */
+#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
+ SigPat (HsWC _ (HsIB _ ty1)) pat1 -> do
+#elif MIN_VERSION_ghc(8,2,0) /* ghc-8.2 8.4 */
SigPatIn pat1 (HsWC _ (HsIB _ ty1 _)) -> do
-#else /* ghc-8.0 */
+#else /* ghc-8.0 */
SigPatIn pat1 (HsIB _ (HsWC _ _ ty1)) -> do
#endif
-- i :: Int -> expr
@@ -169,19 +203,35 @@ layoutPat 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 "~")
- NPat llit@(L _ (OverLit olit _ _ _)) mNegative _ _ -> do
+#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 olit
+ litDoc <- docWrapNode llit $ allocateNode $ overLitValBriDoc $ GHC.ol_val ol
negDoc <- docLit $ Text.pack "-"
pure $ case mNegative of
Just{} -> Seq.fromList [negDoc, litDoc]
diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Stmt.hs b/src/Language/Haskell/Brittany/Internal/Layouters/Stmt.hs
index 7a9b922..3fd5f8a 100644
--- a/src/Language/Haskell/Brittany/Internal/Layouters/Stmt.hs
+++ b/src/Language/Haskell/Brittany/Internal/Layouters/Stmt.hs
@@ -34,9 +34,17 @@ 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
@@ -52,7 +60,11 @@ 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
@@ -97,7 +109,11 @@ 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
@@ -113,7 +129,11 @@ 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 5e97d5b..5bbbc4c 100644
--- a/src/Language/Haskell/Brittany/Internal/Layouters/Type.hs
+++ b/src/Language/Haskell/Brittany/Internal/Layouters/Type.hs
@@ -23,6 +23,7 @@ import HsSyn
import Name
import Outputable ( ftext, showSDocUnsafe )
import BasicTypes
+import qualified SrcLoc
import DataTreePrint
@@ -31,7 +32,17 @@ 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 */
+#if MIN_VERSION_ghc(8,6,0)
+ HsTyVar _ promoted name -> do
+ t <- lrdrNameToTextAnn name
+ case promoted of
+ Promoted -> docSeq
+ [ docSeparator
+ , docTick
+ , docWrapNode name $ docLit t
+ ]
+ NotPromoted -> docWrapNode name $ docLit t
+#elif MIN_VERSION_ghc(8,2,0) /* ghc-8.2 */
HsTyVar promoted name -> do
t <- lrdrNameToTextAnn name
case promoted of
@@ -46,13 +57,25 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
t <- lrdrNameToTextAnn name
docWrapNode name $ docLit t
#endif
+#if MIN_VERSION_ghc(8,6,0)
+ HsForAllTy _ bndrs (L _ (HsQualTy _ (L _ cntxts) typ2)) -> do
+#else
HsForAllTy bndrs (L _ (HsQualTy (L _ cntxts) typ2)) -> do
+#endif
typeDoc <- docSharedWrapper layoutType typ2
tyVarDocs <- bndrs `forM` \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
cntxtDocs <- cntxts `forM` docSharedWrapper layoutType
let maybeForceML = case typ2 of
(L _ HsFunTy{}) -> docForceMultiline
@@ -143,13 +166,25 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
]
)
]
+#if MIN_VERSION_ghc(8,6,0)
+ HsForAllTy _ bndrs typ2 -> do
+#else
HsForAllTy bndrs typ2 -> do
+#endif
typeDoc <- layoutType typ2
tyVarDocs <- bndrs `forM` \case
+#if MIN_VERSION_ghc(8,6,0)
+ (L _ (UserTyVar _ name)) -> return $ (lrdrNameToText name, Nothing)
+ (L _ (KindedTyVar _ lrdrName kind)) -> do
+ d <- layoutType kind
+ return $ (lrdrNameToText lrdrName, Just $ return d)
+ (L _ (XTyVarBndr{})) -> error "brittany internal error: XTyVarBndr"
+#else
(L _ (UserTyVar name)) -> return $ (lrdrNameToText name, Nothing)
(L _ (KindedTyVar lrdrName kind)) -> do
d <- layoutType kind
return $ (lrdrNameToText lrdrName, Just $ return d)
+#endif
let maybeForceML = case typ2 of
(L _ HsFunTy{}) -> docForceMultiline
_ -> id
@@ -210,7 +245,11 @@ 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
@@ -260,7 +299,11 @@ 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
@@ -284,7 +327,11 @@ 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
@@ -299,6 +346,35 @@ 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
+ L _ (HsAppTy _ ty1 ty2) -> gather (ty2:list) ty1
+ final -> (final, list)
+ let (typHead, typRest) = gather [typ2] typ1
+ docHead <- docSharedWrapper layoutType typHead
+ docRest <- docSharedWrapper layoutType `mapM` typRest
+ docAlt
+ [ docSeq
+ $ docForceSingleline docHead : (docRest >>= \d ->
+ [ docSeparator, docForceSingleline d ])
+ , docPar docHead (docLines $ docEnsureIndent BrIndentRegular <$> docRest)
+ ]
+ HsAppTy _ typ1 typ2 -> do
+ typeDoc1 <- docSharedWrapper layoutType typ1
+ typeDoc2 <- docSharedWrapper layoutType typ2
+ docAlt
+ [ docSeq
+ [ docForceSingleline typeDoc1
+ , docSeparator
+ , docForceSingleline typeDoc2
+ ]
+ , docPar
+ typeDoc1
+ (docEnsureIndent BrIndentRegular typeDoc2)
+ ]
+#else
HsAppTy typ1 typ2 -> do
typeDoc1 <- docSharedWrapper layoutType typ1
typeDoc2 <- docSharedWrapper layoutType typ2
@@ -351,7 +427,12 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
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
@@ -366,6 +447,8 @@ 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
@@ -381,13 +464,19 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
])
(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
HsBoxedOrConstraintTuple -> simple
where
- unboxed = if null typs then error "unboxed unit?" else unboxedL
+ unboxed = if null typs then error "brittany internal error: unboxed unit"
+ else unboxedL
simple = if null typs then unitL else simpleL
unitL = docLit $ Text.pack "()"
simpleL = do
@@ -480,9 +569,11 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
-- }
-- , _layouter_ast = ltype
-- }
-#if MIN_VERSION_ghc(8,2,0) /* ghc-8.2 */
+#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
+ HsIParamTy _ (L _ (HsIPName ipName)) typ1 -> do
+#elif MIN_VERSION_ghc(8,2,0) /* ghc-8.2 8.4 */
HsIParamTy (L _ (HsIPName ipName)) typ1 -> do
-#else /* ghc-8.0 */
+#else /* ghc-8.0 */
HsIParamTy (HsIPName ipName) typ1 -> do
#endif
typeDoc1 <- docSharedWrapper layoutType typ1
@@ -503,6 +594,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
@@ -521,8 +614,13 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
, 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
@@ -640,7 +738,11 @@ 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
#if MIN_VERSION_ghc(8,2,0) /* ghc-8.2 */
HsNumTy (SourceText srctext) _ -> docLit $ Text.pack srctext
HsNumTy NoSourceText _ ->
@@ -652,11 +754,20 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
HsNumTy srctext _ -> docLit $ Text.pack srctext
HsStrTy srctext _ -> docLit $ Text.pack srctext
#endif
+#if !MIN_VERSION_ghc(8,6,0)
HsCoreTy{} -> -- TODO
briDocByExactInlineOnly "HsCoreTy{}" ltype
+#endif
HsWildCardTy _ ->
docLit $ Text.pack "_"
#if MIN_VERSION_ghc(8,2,0) /* ghc-8.2 */
HsSumTy{} -> -- TODO
briDocByExactInlineOnly "HsSumTy{}" ltype
#endif
+#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
diff --git a/src/Language/Haskell/Brittany/Internal/Transformations/Alt.hs b/src/Language/Haskell/Brittany/Internal/Transformations/Alt.hs
index b73fc77..b9458fb 100644
--- a/src/Language/Haskell/Brittany/Internal/Transformations/Alt.hs
+++ b/src/Language/Haskell/Brittany/Internal/Transformations/Alt.hs
@@ -203,6 +203,7 @@ transformAlts =
AltLineModeStateForceSL{} -> p == VerticalSpacingParNone
AltLineModeStateForceML{} -> p /= VerticalSpacingParNone
AltLineModeStateContradiction -> False
+ -- TODO: use COMPLETE pragma instead?
lineCheck _ = error "ghc exhaustive check is insufficient"
lconf <- _conf_layout <$> mAsk
#if INSERTTRACESALT
@@ -462,7 +463,8 @@ getSpacing !bridoc = rec bridoc
$ LineModeValid
$ VerticalSpacing 0 VerticalSpacingParNone False
BDFLines ls@(_:_) -> do
- lSps@(mVs:_) <- rec `mapM` ls
+ lSps <- rec `mapM` ls
+ let (mVs:_) = lSps -- separated into let to avoid MonadFail
return $ [ VerticalSpacing lsp (VerticalSpacingParSome $ lineMax) False
| VerticalSpacing lsp _ _ <- mVs
, lineMax <- getMaxVS $ maxVs $ lSps