diff --git a/brittany.cabal b/brittany.cabal index 8e8dac7..d9180aa 100644 --- a/brittany.cabal +++ b/brittany.cabal @@ -1,5 +1,5 @@ name: brittany -version: 0.11.0.0 +version: 0.11.0.0.1 synopsis: Haskell source code formatter description: { See . @@ -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.6.0 && <0.5.7 + , ghc-exactprint >=0.5.6.0 && <0.5.8 , 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 375c779..ea70c1d 100644 --- a/src/Language/Haskell/Brittany/Internal/ExactPrintUtils.hs +++ b/src/Language/Haskell/Brittany/Internal/ExactPrintUtils.hs @@ -191,9 +191,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 () diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Decl.hs b/src/Language/Haskell/Brittany/Internal/Layouters/Decl.hs index ee0596f..225f1a0 100644 --- a/src/Language/Haskell/Brittany/Internal/Layouters/Decl.hs +++ b/src/Language/Haskell/Brittany/Internal/Layouters/Decl.hs @@ -47,30 +47,44 @@ import Bag ( mapBagM ) 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 + InstD _ (TyFamInstD{}) -> layoutTyFamInstDWorkaround d + _ -> 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 - 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) - _ -> briDocByExactNoComment d + InstD (TyFamInstD{}) -> layoutTyFamInstDWorkaround 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) 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)) -> docWrapNode lsig $ do +#elif MIN_VERSION_ghc(8,2,0) /* ghc-8.2 8.4 */ TypeSig names (HsWC _ (HsIB _ typ _)) -> docWrapNode lsig $ do #else /* ghc-8.0 */ TypeSig names (HsIB _ (HsWC _ _ typ)) -> docWrapNode lsig $ do @@ -112,7 +126,11 @@ layoutSig lsig@(L _loc sig) = case sig of ] ) ] +#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 @@ -149,8 +167,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 @@ -164,7 +190,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 <- @@ -173,7 +203,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 @@ -201,7 +235,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 ] @@ -211,21 +249,34 @@ 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{}" x - x@(HsIPBinds _ipBinds) -> Just . (:[]) <$> unknownNodeError "HsIPBinds" x - EmptyLocalBinds -> return $ Nothing +#endif + x@HsIPBinds{} -> Just . (:[]) <$> unknownNodeError "HsIPBinds" x + 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 @@ -234,7 +285,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 diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs b/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs index 7cbd3c2..dced8e9 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 "->" @@ -115,14 +147,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 @@ -167,7 +211,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 @@ -205,9 +253,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 @@ -223,13 +275,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 @@ -243,11 +305,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 @@ -285,15 +355,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 @@ -333,12 +415,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 @@ -354,18 +444,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 @@ -407,7 +516,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 $ layoutPatternBind Nothing binderDoc `mapM` matches @@ -430,7 +545,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 @@ -550,7 +669,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) @@ -653,60 +776,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 @@ -747,239 +875,276 @@ 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 [] Nothing) -> do - let t = lrdrNameToText lname - docWrapNode lname $ docSeq - [ docNodeAnnKW lexpr (Just AnnOpenC) $ docLit $ t <> Text.pack "{" - , docLit $ Text.pack "}" - ] - RecordCon lname _ _ (HsRecFields fs@(_:_) Nothing) -> do - -- TODO: the layouter for RecordUpd is slightly more clever. Should - -- probably copy the approach from there. - 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 - ] - 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 lineN = - [ docNodeAnnKW lexpr (Just AnnOpenC) docEmpty +#endif +#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ + RecordCon _ lname fields -> +#else + RecordCon lname _ _ fields -> +#endif + case fields of + (HsRecFields [] Nothing) -> do + let t = lrdrNameToText lname + docWrapNode lname $ docSeq + [ docNodeAnnKW lexpr (Just AnnOpenC) $ docLit $ t <> Text.pack "{" , 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) - ++ [docSeparator] - ++ lineN - , docSetParSpacing - $ docAddBaseY BrIndentRegular - $ docPar - (docNodeAnnKW lexpr Nothing nameDoc) - ( docNonBottomSpacing - $ docLines - $ [docCols ColRecUpdate $ line1 (docAddBaseY BrIndentRegular)] - ++ (docCols ColRecUpdate <$> lineR (docAddBaseY BrIndentRegular)) - ++ [docSeq lineN] - ) - ] - 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 - 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 - ] - 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 ColRecUpdate $ line1 (docAddBaseY BrIndentRegular)] - ++ (docCols ColRecUpdate <$> lineR (docAddBaseY BrIndentRegular)) - ++ [docSeq lineDot, docSeq lineN] - ) - ] - RecordCon{} -> - unknownNodeError "RecordCon with puns" lexpr - RecordUpd rExpr [] _ _ _ _ -> do - rExprDoc <- docSharedWrapper layoutExpr rExpr - docSeq [rExprDoc, docLit $ Text.pack "{}"] - RecordUpd rExpr fields@(_:_) _ _ _ _ -> do - rExprDoc <- docSharedWrapper layoutExpr rExpr - rFs@((rF1f, rF1n, rF1e):rFr) <- fields - `forM` \lfield@(L _ (HsRecField (L _ ambName) rFExpr pun)) -> do - rFExpDoc <- if pun - then return Nothing - else Just <$> docSharedWrapper layoutExpr rFExpr - return $ case ambName of - Unambiguous n _ -> (lfield, lrdrNameToText n, rFExpDoc) - Ambiguous n _ -> (lfield, lrdrNameToText n, rFExpDoc) - runFilteredAlternative $ do - -- container { fieldA = blub, fieldB = blub } - addAlternative - $ docSeq - [ docNodeAnnKW lexpr Nothing $ appSep $ docForceSingleline rExprDoc - , appSep $ docLit $ Text.pack "{" - , appSep $ docSeq $ List.intersperse docCommaSep - $ rFs <&> \case - (lfield, fieldStr, Just fieldDoc) -> - docWrapNode lfield $ docSeq - [ appSep $ docLit fieldStr - , appSep $ docLit $ Text.pack "=" - , docForceSingleline fieldDoc - ] - (lfield, fieldStr, Nothing) -> - docWrapNode lfield $ docLit fieldStr - , docLit $ Text.pack "}" - ] - -- hanging single-line fields - -- container { fieldA = blub - -- , fieldB = blub - -- } - addAlternativeCond (indentPolicy == IndentPolicyFree) - $ docSeq - [ docNodeAnnKW lexpr Nothing $ appSep rExprDoc - , docSetBaseY $ docLines $ let - line1 = docCols ColRecUpdate + (HsRecFields fs@(_:_) Nothing) -> do + -- TODO: the layouter for RecordUpd is slightly more clever. Should + -- probably copy the approach from there. + let nameDoc = docWrapNode lname $ docLit $ lrdrNameToText lname + ((fd1l, fd1n, fd1e):fdr) <- 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 line1 wrapper = [ appSep $ docLit $ Text.pack "{" - , docWrapNodePrior rF1f $ appSep $ docLit rF1n - , case rF1e of - Just x -> docWrapNodeRest rF1f $ docSeq - [ appSep $ docLit $ Text.pack "=" - , docForceSingleline x - ] + , docWrapNodePrior fd1l $ appSep $ docLit fd1n + , case fd1e of + Just x -> docSeq + [ appSep $ docLit $ Text.pack "=" + , docWrapNodeRest fd1l $ wrapper x + ] Nothing -> docEmpty ] - lineR = rFr <&> \(lfield, fText, fDoc) -> docWrapNode lfield $ docCols ColRecUpdate + let lineR wrapper = fdr <&> \(lfield, fText, fDoc) -> [ docCommaSep , appSep $ docLit fText , case fDoc of - Just x -> docSeq [ appSep $ docLit $ Text.pack "=" - , docForceSingleline x - ] + Just x -> docWrapNode lfield $ docSeq + [ appSep $ docLit $ Text.pack "=" + , wrapper x + ] Nothing -> docEmpty ] - lineN = docSeq + let lineN = [ docNodeAnnKW lexpr (Just AnnOpenC) docEmpty , docLit $ Text.pack "}" ] - in [line1] ++ lineR ++ [lineN] - ] - -- non-hanging with expressions placed to the right of the names - -- container - -- { fieldA = blub - -- , fieldB = potentially - -- multiline - -- } - addAlternative - $ docSetParSpacing - $ docAddBaseY BrIndentRegular - $ docPar - (docNodeAnnKW lexpr Nothing rExprDoc) - (docNonBottomSpacing $ docLines $ let - expressionWrapper = case indentPolicy of - IndentPolicyLeft -> docForceParSpacing - IndentPolicyMultiple -> docForceParSpacing - IndentPolicyFree -> docSetBaseY - line1 = docCols ColRecUpdate - [ appSep $ docLit $ Text.pack "{" - , docWrapNodePrior rF1f $ appSep $ docLit rF1n - , docWrapNodeRest rF1f $ case rF1e of - Just x -> docAlt - [ docSeq [ appSep $ docLit $ Text.pack "=" - , expressionWrapper x - ] - , docAddBaseY BrIndentRegular - $ docPar (docLit $ Text.pack "=") x - ] - Nothing -> docEmpty - ] - lineR = rFr <&> \(lfield, fText, fDoc) -> docWrapNode lfield - $ docCols ColRecUpdate - [ docCommaSep - , appSep $ docLit fText - , case fDoc of - Just x -> docAlt - [ docSeq [ appSep $ docLit $ Text.pack "=" - , expressionWrapper x - ] - , docAddBaseY BrIndentRegular - $ docPar (docLit $ Text.pack "=") x - ] - Nothing -> docEmpty - ] - lineN = docSeq - [ docNodeAnnKW lexpr (Just AnnOpenC) docEmpty - , docLit $ Text.pack "}" - ] - in [line1] ++ lineR ++ [lineN] - ) -#if MIN_VERSION_ghc(8,2,0) /* ghc-8.2 */ + docAlt -- TODO: make this addFilteredAlternative and a hanging layout when Free + [ docSeq + $ [docNodeAnnKW lexpr Nothing nameDoc, docSeparator] + ++ line1 docForceSingleline + ++ join (lineR docForceSingleline) + ++ [docSeparator] + ++ lineN + , docSetParSpacing + $ docAddBaseY BrIndentRegular + $ docPar + (docNodeAnnKW lexpr Nothing nameDoc) + ( docNonBottomSpacing + $ docLines + $ [docCols ColRecUpdate $ line1 (docAddBaseY BrIndentRegular)] + ++ (docCols ColRecUpdate <$> lineR (docAddBaseY BrIndentRegular)) + ++ [docSeq lineN] + ) + ] + (HsRecFields [] (Just 0)) -> do + let t = lrdrNameToText lname + docWrapNode lname $ docLit $ t <> Text.pack " { .. }" + (HsRecFields fs@(_:_) (Just dotdoti)) | dotdoti == length fs -> do + let nameDoc = docWrapNode lname $ docLit $ lrdrNameToText lname + ((fd1l, fd1n, fd1e):fdr) <- 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 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 ColRecUpdate $ line1 (docAddBaseY BrIndentRegular)] + ++ (docCols ColRecUpdate <$> lineR (docAddBaseY BrIndentRegular)) + ++ [docSeq lineDot, docSeq lineN] + ) + ] + _ -> + unknownNodeError "RecordCon with puns" lexpr +#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ + RecordUpd _ rExpr fields -> +#else + RecordUpd rExpr fields _ _ _ _ -> +#endif + case fields of + [] -> do + rExprDoc <- docSharedWrapper layoutExpr rExpr + docSeq [rExprDoc, docLit $ Text.pack "{}"] + (_:_) -> do + rExprDoc <- docSharedWrapper layoutExpr rExpr + rFs@((rF1f, rF1n, rF1e):rFr) <- fields + `forM` \lfield@(L _ (HsRecField (L _ ambName) rFExpr pun)) -> do + rFExpDoc <- if pun + 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 + runFilteredAlternative $ do + -- container { fieldA = blub, fieldB = blub } + addAlternative + $ docSeq + [ docNodeAnnKW lexpr Nothing $ appSep $ docForceSingleline rExprDoc + , appSep $ docLit $ Text.pack "{" + , appSep $ docSeq $ List.intersperse docCommaSep + $ rFs <&> \case + (lfield, fieldStr, Just fieldDoc) -> + docWrapNode lfield $ docSeq + [ appSep $ docLit fieldStr + , appSep $ docLit $ Text.pack "=" + , docForceSingleline fieldDoc + ] + (lfield, fieldStr, Nothing) -> + docWrapNode lfield $ docLit fieldStr + , docLit $ Text.pack "}" + ] + -- hanging single-line fields + -- container { fieldA = blub + -- , fieldB = blub + -- } + addAlternativeCond (indentPolicy == IndentPolicyFree) + $ docSeq + [ docNodeAnnKW lexpr Nothing $ appSep rExprDoc + , docSetBaseY $ docLines $ let + line1 = docCols ColRecUpdate + [ appSep $ docLit $ Text.pack "{" + , docWrapNodePrior rF1f $ appSep $ docLit rF1n + , case rF1e of + Just x -> docWrapNodeRest rF1f $ docSeq + [ appSep $ docLit $ Text.pack "=" + , docForceSingleline x + ] + Nothing -> docEmpty + ] + lineR = rFr <&> \(lfield, fText, fDoc) -> docWrapNode lfield $ docCols ColRecUpdate + [ docCommaSep + , appSep $ docLit fText + , case fDoc of + Just x -> docSeq [ appSep $ docLit $ Text.pack "=" + , docForceSingleline x + ] + Nothing -> docEmpty + ] + lineN = docSeq + [ docNodeAnnKW lexpr (Just AnnOpenC) docEmpty + , docLit $ Text.pack "}" + ] + in [line1] ++ lineR ++ [lineN] + ] + -- non-hanging with expressions placed to the right of the names + -- container + -- { fieldA = blub + -- , fieldB = potentially + -- multiline + -- } + addAlternative + $ docSetParSpacing + $ docAddBaseY BrIndentRegular + $ docPar + (docNodeAnnKW lexpr Nothing rExprDoc) + (docNonBottomSpacing $ docLines $ let + expressionWrapper = case indentPolicy of + IndentPolicyLeft -> docForceParSpacing + IndentPolicyMultiple -> docForceParSpacing + IndentPolicyFree -> docSetBaseY + line1 = docCols ColRecUpdate + [ appSep $ docLit $ Text.pack "{" + , docWrapNodePrior rF1f $ appSep $ docLit rF1n + , docWrapNodeRest rF1f $ case rF1e of + Just x -> docAlt + [ docSeq [ appSep $ docLit $ Text.pack "=" + , expressionWrapper x + ] + , docAddBaseY BrIndentRegular + $ docPar (docLit $ Text.pack "=") x + ] + Nothing -> docEmpty + ] + lineR = rFr <&> \(lfield, fText, fDoc) -> docWrapNode lfield + $ docCols ColRecUpdate + [ docCommaSep + , appSep $ docLit fText + , case fDoc of + Just x -> docAlt + [ docSeq [ appSep $ docLit $ Text.pack "=" + , expressionWrapper x + ] + , docAddBaseY BrIndentRegular + $ docPar (docLit $ Text.pack "=") x + ] + Nothing -> docEmpty + ] + lineN = docSeq + [ docNodeAnnKW lexpr (Just AnnOpenC) docEmpty + , docLit $ Text.pack "}" + ] + in [line1] ++ lineR ++ [lineN] + ) +#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 @@ -991,9 +1156,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 @@ -1038,9 +1205,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 @@ -1082,7 +1251,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 @@ -1104,7 +1277,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 #if MIN_VERSION_ghc(8,4,0) /* ghc-8.4 */ litBriDoc :: HsLit GhcPs -> BriDocFInt diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/IE.hs b/src/Language/Haskell/Brittany/Internal/Layouters/IE.hs index 56462b5..db0ba7e 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 _ _ -> docSeq [ienDoc, docLit $ Text.pack "(..)"] +#else IEThingAll _ -> docSeq [ienDoc, docLit $ Text.pack "(..)"] +#endif +#if MIN_VERSION_ghc(8,6,0) + IEThingWith _ _ (IEWildcard _) _ _ -> +#else IEThingWith _ (IEWildcard _) _ _ -> +#endif docSeq [ienDoc, docLit $ Text.pack "(..)"] +#if MIN_VERSION_ghc(8,6,0) + IEThingWith _ _ _ ns _ -> do +#else IEThingWith _ _ 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 c65b357..b204e16 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 "(" ")" Unboxed -> wrapPatListy args "(#" "#)" +#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 "[" "]" +#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 dfde7f5..62da91a 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 218f596..f4094ff 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