Add compat with GHC-8.6 API

remotes/felixonmars/ghc-8.6
Lennart Spitzner 2018-07-05 19:55:49 +02:00
parent 9d915232c0
commit 34735e27ef
11 changed files with 678 additions and 183 deletions

View File

@ -83,12 +83,12 @@ library {
-fno-warn-redundant-constraints -fno-warn-redundant-constraints
} }
build-depends: build-depends:
{ base >=4.9 && <4.12 { base >=4.9 && <4.13
, ghc >=8.0.1 && <8.5 , ghc >=8.0.1 && <8.7
, ghc-paths >=0.1.0.9 && <0.2 , ghc-paths >=0.1.0.9 && <0.2
, ghc-exactprint >=0.5.8 && <0.5.9 , ghc-exactprint >=0.5.8 && <0.5.9
, transformers >=0.5.2.0 && <0.6 , 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 , mtl >=2.2.1 && <2.3
, text >=1.2 && <1.3 , text >=1.2 && <1.3
, multistate >=0.7.1.1 && <0.9 , multistate >=0.7.1.1 && <0.9
@ -111,7 +111,7 @@ library {
, semigroups >=0.18.2 && <0.19 , semigroups >=0.18.2 && <0.19
, cmdargs >=0.10.14 && <0.11 , cmdargs >=0.10.14 && <0.11
, czipwith >=1.0.1.0 && <1.1 , 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 , filepath >=1.4.1.0 && <1.5
, random >= 1.1 && <1.2 , random >= 1.1 && <1.2
} }

View File

@ -487,10 +487,17 @@ ppModule lmod@(L _loc _m@(HsModule _name _exports _ decls _ _)) = do
getDeclBindingNames :: LHsDecl GhcPs -> [String] 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 getDeclBindingNames (L _ decl) = case decl of
SigD (TypeSig ns _) -> ns <&> \(L _ n) -> Text.unpack (rdrNameToText n) SigD (TypeSig ns _) -> ns <&> \(L _ n) -> Text.unpack (rdrNameToText n)
ValD (FunBind (L _ n) _ _ _ _) -> [Text.unpack $ rdrNameToText n] ValD (FunBind (L _ n) _ _ _ _) -> [Text.unpack $ rdrNameToText n]
_ -> [] _ -> []
#endif
-- Prints the information associated with the module annotation -- Prints the information associated with the module annotation
@ -564,15 +571,26 @@ ppPreamble lmod@(L loc m@(HsModule _ _ _ _ _ _)) = do
_sigHead :: Sig GhcPs -> String _sigHead :: Sig GhcPs -> String
_sigHead = \case _sigHead = \case
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
TypeSig _ names _ ->
#else
TypeSig names _ -> TypeSig names _ ->
#endif
"TypeSig " ++ intercalate "," (Text.unpack . lrdrNameToText <$> names) "TypeSig " ++ intercalate "," (Text.unpack . lrdrNameToText <$> names)
_ -> "unknown sig" _ -> "unknown sig"
_bindHead :: HsBind GhcPs -> String _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 _bindHead = \case
FunBind fId _ _ _ [] -> "FunBind " ++ (Text.unpack $ lrdrNameToText $ fId) FunBind fId _ _ _ [] -> "FunBind " ++ (Text.unpack $ lrdrNameToText $ fId)
PatBind _pat _ _ _ ([], []) -> "PatBind smth" PatBind _pat _ _ _ ([], []) -> "PatBind smth"
_ -> "unknown bind" _ -> "unknown bind"
#endif

View File

@ -197,9 +197,17 @@ commentAnnFixTransform modul = SYB.everything (>>) genF modul
genF = (\_ -> return ()) `SYB.extQ` exprF genF = (\_ -> return ()) `SYB.extQ` exprF
exprF :: Located (HsExpr GhcPs) -> ExactPrint.Transform () exprF :: Located (HsExpr GhcPs) -> ExactPrint.Transform ()
exprF lexpr@(L _ expr) = case expr of 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) 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) moveTrailingComments lexpr (List.last fs)
_ -> return () _ -> return ()
@ -280,13 +288,13 @@ withTransformedAnns
=> ast => ast
-> MultiRWSS.MultiRWS '[Config, ExactPrint.Anns] w s a -> MultiRWSS.MultiRWS '[Config, ExactPrint.Anns] w s a
-> MultiRWSS.MultiRWS '[Config, ExactPrint.Anns] w s a -> MultiRWSS.MultiRWS '[Config, ExactPrint.Anns] w s a
withTransformedAnns ast m = do withTransformedAnns ast m = MultiRWSS.mGetRawR >>= \case
-- TODO: implement `local` for MultiReader/MultiRWS readers@(conf :+: anns :+: HNil) -> do
readers@(conf :+: anns :+: HNil) <- MultiRWSS.mGetRawR -- TODO: implement `local` for MultiReader/MultiRWS
MultiRWSS.mPutRawR (conf :+: f anns :+: HNil) MultiRWSS.mPutRawR (conf :+: f anns :+: HNil)
x <- m x <- m
MultiRWSS.mPutRawR readers MultiRWSS.mPutRawR readers
pure x pure x
where where
f anns = f anns =
let ((), (annsBalanced, _), _) = let ((), (annsBalanced, _), _) =

View File

@ -55,28 +55,43 @@ import Data.Char (isUpper)
layoutDecl :: ToBriDoc HsDecl 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 layoutDecl d@(L loc decl) = case decl of
SigD sig -> withTransformedAnns d $ layoutSig (L loc sig) SigD sig -> withTransformedAnns d $ layoutSig (L loc sig)
ValD bind -> withTransformedAnns d $ layoutBind (L loc bind) >>= \case ValD bind -> withTransformedAnns d $ layoutBind (L loc bind) >>= \case
Left ns -> docLines $ return <$> ns Left ns -> docLines $ return <$> ns
Right n -> return n Right n -> return n
TyClD tycl -> withTransformedAnns d $ layoutTyCl (L loc tycl) TyClD tycl -> withTransformedAnns d $ layoutTyCl (L loc tycl)
InstD (TyFamInstD{}) -> do InstD (TyFamInstD{}) -> layoutTyFamInstDWorkaround d
-- 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 (ClsInstD inst) -> withTransformedAnns d $ layoutClsInst (L loc inst) 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 -- Sig
@ -84,12 +99,18 @@ layoutDecl d@(L loc decl) = case decl of
layoutSig :: ToBriDoc Sig layoutSig :: ToBriDoc Sig
layoutSig lsig@(L _loc sig) = case sig of 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 TypeSig names (HsWC _ (HsIB _ typ _)) -> layoutNamesAndType names typ
#else /* ghc-8.0 */ #else /* ghc-8.0 */
TypeSig names (HsIB _ (HsWC _ _ typ)) -> layoutNamesAndType names typ TypeSig names (HsIB _ (HsWC _ _ typ)) -> layoutNamesAndType names typ
#endif #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) -> InlineSig name (InlinePragma _ spec _arity phaseAct conlike) ->
#endif
docWrapNode lsig $ do docWrapNode lsig $ do
nameStr <- lrdrNameToTextAnn name nameStr <- lrdrNameToTextAnn name
specStr <- specStringCompat lsig spec specStr <- specStringCompat lsig spec
@ -106,7 +127,9 @@ layoutSig lsig@(L _loc sig) = case sig of
$ Text.pack ("{-# " ++ specStr ++ conlikeStr ++ phaseStr) $ Text.pack ("{-# " ++ specStr ++ conlikeStr ++ phaseStr)
<> nameStr <> nameStr
<> Text.pack " #-}" <> 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 ClassOpSig False names (HsIB _ typ _) -> layoutNamesAndType names typ
#else /* ghc-8.0 */ #else /* ghc-8.0 */
ClassOpSig False names (HsIB _ typ) -> layoutNamesAndType names typ ClassOpSig False names (HsIB _ typ) -> layoutNamesAndType names typ
@ -152,7 +175,6 @@ layoutSig lsig@(L _loc sig) = case sig of
) )
] ]
specStringCompat specStringCompat
:: MonadMultiWriter [BrittanyError] m => LSig GhcPs -> InlineSpec -> m String :: MonadMultiWriter [BrittanyError] m => LSig GhcPs -> InlineSpec -> m String
#if MIN_VERSION_ghc(8,4,0) #if MIN_VERSION_ghc(8,4,0)
@ -171,8 +193,16 @@ specStringCompat _ = \case
layoutGuardLStmt :: ToBriDoc' (Stmt GhcPs (LHsExpr GhcPs)) layoutGuardLStmt :: ToBriDoc' (Stmt GhcPs (LHsExpr GhcPs))
layoutGuardLStmt lgstmt@(L _ stmtLR) = docWrapNode lgstmt $ case stmtLR of 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 BodyStmt body _ _ _ -> layoutExpr body
#endif
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
BindStmt _ lPat expr _ _ -> do
#else
BindStmt lPat expr _ _ _ -> do BindStmt lPat expr _ _ _ -> do
#endif
patDoc <- docSharedWrapper layoutPat lPat patDoc <- docSharedWrapper layoutPat lPat
expDoc <- docSharedWrapper layoutExpr expr expDoc <- docSharedWrapper layoutExpr expr
docCols ColBindStmt docCols ColBindStmt
@ -191,7 +221,11 @@ layoutBind
(HsBindLR GhcPs GhcPs) (HsBindLR GhcPs GhcPs)
(Either [BriDocNumbered] BriDocNumbered) (Either [BriDocNumbered] BriDocNumbered)
layoutBind lbind@(L _ bind) = case bind of 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 FunBind fId (MG lmatches@(L _ matches) _ _ _) _ _ [] -> do
#endif
idStr <- lrdrNameToTextAnn fId idStr <- lrdrNameToTextAnn fId
binderDoc <- docLit $ Text.pack "=" binderDoc <- docLit $ Text.pack "="
funcPatDocs <- funcPatDocs <-
@ -200,7 +234,11 @@ layoutBind lbind@(L _ bind) = case bind of
$ layoutPatternBind (Just idStr) binderDoc $ layoutPatternBind (Just idStr) binderDoc
`mapM` matches `mapM` matches
return $ Left $ funcPatDocs 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 PatBind pat (GRHSs grhss whereBinds) _ _ ([], []) -> do
#endif
patDocs <- colsWrapPat =<< layoutPat pat patDocs <- colsWrapPat =<< layoutPat pat
clauseDocs <- layoutGrhs `mapM` grhss clauseDocs <- layoutGrhs `mapM` grhss
mWhereDocs <- layoutLocalBinds whereBinds 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 -- Just . (>>= either id return) . Data.Foldable.toList <$> mapBagM layoutBind lhsBindsLR -- TODO: fix ordering
-- x@(HsValBinds (ValBindsIn{})) -> -- x@(HsValBinds (ValBindsIn{})) ->
-- Just . (:[]) <$> unknownNodeError "HsValBinds (ValBindsIn _ (_:_))" x -- 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 HsValBinds (ValBindsIn bindlrs sigs) -> do
#endif
let unordered = let unordered =
[ BagBind b | b <- Data.Foldable.toList bindlrs ] [ BagBind b | b <- Data.Foldable.toList bindlrs ]
++ [ BagSig s | s <- sigs ] ++ [ BagSig s | s <- sigs ]
@ -238,23 +280,36 @@ layoutLocalBinds lbinds@(L _ binds) = case binds of
BagBind b -> either id return <$> layoutBind b BagBind b -> either id return <$> layoutBind b
BagSig s -> return <$> layoutSig s BagSig s -> return <$> layoutSig s
return $ Just $ docs 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)) -> x@(HsValBinds (ValBindsOut _binds _lsigs)) ->
-- i _think_ this case never occurs in non-processed ast -- i _think_ this case never occurs in non-processed ast
Just . (: []) <$> unknownNodeError "HsValBinds ValBindsOut{}" Just . (: []) <$> unknownNodeError "HsValBinds ValBindsOut{}"
(L noSrcSpan x) (L noSrcSpan x)
x@(HsIPBinds _ipBinds) -> #endif
x@(HsIPBinds{}) ->
Just . (: []) <$> unknownNodeError "HsIPBinds" (L noSrcSpan x) 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 -- TODO: we don't need the `LHsExpr GhcPs` anymore, now that there is
-- parSpacing stuff.B -- parSpacing stuff.B
layoutGrhs layoutGrhs
:: LGRHS GhcPs (LHsExpr GhcPs) :: LGRHS GhcPs (LHsExpr GhcPs)
-> ToBriDocM ([BriDocNumbered], BriDocNumbered, 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 layoutGrhs lgrhs@(L _ (GRHS guards body)) = do
#endif
guardDocs <- docWrapNode lgrhs $ layoutStmt `mapM` guards guardDocs <- docWrapNode lgrhs $ layoutStmt `mapM` guards
bodyDoc <- layoutExpr body bodyDoc <- layoutExpr body
return (guardDocs, bodyDoc, 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 layoutPatternBind
:: Maybe Text :: Maybe Text
@ -263,7 +318,11 @@ layoutPatternBind
-> ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
layoutPatternBind mIdStr binderDoc lmatch@(L _ match) = do layoutPatternBind mIdStr binderDoc lmatch@(L _ match) = do
let pats = m_pats match 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 let (GRHSs grhss whereBinds) = m_grhss match
#endif
patDocs <- pats `forM` \p -> fmap return $ colsWrapPat =<< layoutPat p patDocs <- pats `forM` \p -> fmap return $ colsWrapPat =<< layoutPat p
let isInfix = isInfixMatch match let isInfix = isInfixMatch match
let mIdStr' = fixPatternBindIdentifier match <$> mIdStr let mIdStr' = fixPatternBindIdentifier match <$> mIdStr
@ -629,7 +688,12 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs mWhereDocs ha
layoutTyCl :: ToBriDoc TyClDecl layoutTyCl :: ToBriDoc TyClDecl
layoutTyCl ltycl@(L _loc tycl) = case tycl of 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 SynDecl name vars fixity typ _ -> do
let isInfix = case fixity of let isInfix = case fixity of
Prefix -> False Prefix -> False
@ -700,10 +764,19 @@ layoutSynDecl isInfix wrapNodeRest name vars typ = do
layoutTyVarBndr :: Bool -> ToBriDoc HsTyVarBndr layoutTyVarBndr :: Bool -> ToBriDoc HsTyVarBndr
layoutTyVarBndr needsSep lbndr@(L _ bndr) = do layoutTyVarBndr needsSep lbndr@(L _ bndr) = do
docWrapNodePrior lbndr $ case bndr of 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 UserTyVar name -> do
#endif
nameStr <- lrdrNameToTextAnn name nameStr <- lrdrNameToTextAnn name
docSeq $ [docSeparator | needsSep] ++ [docLit nameStr] 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 KindedTyVar name kind -> do
#endif
nameStr <- lrdrNameToTextAnn name nameStr <- lrdrNameToTextAnn name
docSeq docSeq
$ [ docSeparator | needsSep ] $ [ docSeparator | needsSep ]
@ -736,8 +809,21 @@ layoutClsInst lcid@(L _ cid) = docLines
] ]
where where
layoutInstanceHead :: ToBriDocM BriDocNumbered layoutInstanceHead :: ToBriDocM BriDocNumbered
#if MIN_VERSION_ghc(8,6,0) /* 8.6 */
layoutInstanceHead = 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 :: ClsInstDecl p -> ClsInstDecl p
removeChildren c = c removeChildren c = c

View File

@ -37,9 +37,17 @@ layoutExpr lexpr@(L _ expr) = do
.> confUnpack .> confUnpack
let allowFreeIndent = indentPolicy == IndentPolicyFree let allowFreeIndent = indentPolicy == IndentPolicyFree
docWrapNode lexpr $ case expr of docWrapNode lexpr $ case expr of
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
HsVar _ vname -> do
#else
HsVar vname -> do HsVar vname -> do
#endif
docLit =<< lrdrNameToTextAnn vname docLit =<< lrdrNameToTextAnn vname
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
HsUnboundVar _ var -> case var of
#else
HsUnboundVar var -> case var of HsUnboundVar var -> case var of
#endif
OutOfScope oname _ -> docLit $ Text.pack $ occNameString oname OutOfScope oname _ -> docLit $ Text.pack $ occNameString oname
TrueExprHole oname -> docLit $ Text.pack $ occNameString oname TrueExprHole oname -> docLit $ Text.pack $ occNameString oname
HsRecFld{} -> do HsRecFld{} -> do
@ -51,15 +59,35 @@ layoutExpr lexpr@(L _ expr) = do
HsIPVar{} -> do HsIPVar{} -> do
-- TODO -- TODO
briDocByExactInlineOnly "HsOverLabel{}" lexpr briDocByExactInlineOnly "HsOverLabel{}" lexpr
HsOverLit (OverLit olit _ _ _) -> do #if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
allocateNode $ overLitValBriDoc olit 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 HsLit lit -> do
#endif
allocateNode $ litBriDoc lit 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)]) _ _ _) HsLam (MG (L _ [lmatch@(L _ match)]) _ _ _)
#endif
| pats <- m_pats match | pats <- m_pats match
, GRHSs [lgrhs] llocals <- m_grhss match #if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
, L _ EmptyLocalBinds <- llocals , GRHSs _ [lgrhs] llocals <- m_grhss match
, L _ (GRHS [] body) <- lgrhs #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 -> do
patDocs <- pats `forM` \p -> fmap return $ colsWrapPat =<< layoutPat p patDocs <- pats `forM` \p -> fmap return $ colsWrapPat =<< layoutPat p
bodyDoc <- docAddBaseY BrIndentRegular <$> docSharedWrapper layoutExpr body bodyDoc <- docAddBaseY BrIndentRegular <$> docSharedWrapper layoutExpr body
@ -105,9 +133,13 @@ layoutExpr lexpr@(L _ expr) = do
] ]
HsLam{} -> HsLam{} ->
unknownNodeError "HsLam too complex" lexpr 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 HsLamCase (MG lmatches@(L _ matches) _ _ _) -> do
#else /* ghc-8.0 */ #else /* ghc-8.0 */
HsLamCase _ (MG lmatches@(L _ matches) _ _ _) -> do HsLamCase _ (MG lmatches@(L _ matches) _ _ _) -> do
#endif #endif
binderDoc <- docLit $ Text.pack "->" binderDoc <- docLit $ Text.pack "->"
@ -116,14 +148,26 @@ layoutExpr lexpr@(L _ expr) = do
docSetParSpacing $ docAddBaseY BrIndentRegular $ docPar docSetParSpacing $ docAddBaseY BrIndentRegular $ docPar
(docLit $ Text.pack "\\case") (docLit $ Text.pack "\\case")
(docSetBaseAndIndent $ docNonBottomSpacing $ docLines $ return <$> funcPatDocs) (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 HsApp exp1@(L _ HsApp{}) exp2 -> do
#endif
let gather :: [LHsExpr GhcPs] -> LHsExpr GhcPs -> (LHsExpr GhcPs, [LHsExpr GhcPs]) let gather :: [LHsExpr GhcPs] -> LHsExpr GhcPs -> (LHsExpr GhcPs, [LHsExpr GhcPs])
gather list = \case 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 L _ (HsApp l r) -> gather (r:list) l
#endif
x -> (x, list) x -> (x, list)
let (headE, paramEs) = gather [exp2] exp1 let (headE, paramEs) = gather [exp2] exp1
let colsOrSequence = case headE of 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))) -> L _ (HsVar (L _ (Unqual occname))) ->
#endif
docCols (ColApp $ Text.pack $ occNameString occname) docCols (ColApp $ Text.pack $ occNameString occname)
_ -> docSeq _ -> docSeq
headDoc <- docSharedWrapper layoutExpr headE headDoc <- docSharedWrapper layoutExpr headE
@ -168,7 +212,11 @@ layoutExpr lexpr@(L _ expr) = do
( docNonBottomSpacing ( docNonBottomSpacing
$ docLines paramDocs $ docLines paramDocs
) )
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
HsApp _ exp1 exp2 -> do
#else
HsApp exp1 exp2 -> do HsApp exp1 exp2 -> do
#endif
-- TODO: if expDoc1 is some literal, we may want to create a docCols here. -- TODO: if expDoc1 is some literal, we may want to create a docCols here.
expDoc1 <- docSharedWrapper layoutExpr exp1 expDoc1 <- docSharedWrapper layoutExpr exp1
expDoc2 <- docSharedWrapper layoutExpr exp2 expDoc2 <- docSharedWrapper layoutExpr exp2
@ -206,9 +254,13 @@ layoutExpr lexpr@(L _ expr) = do
expDoc1 expDoc1
expDoc2 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 HsAppType exp1 (HsWC _ ty1) -> do
#else /* ghc-8.0 */ #else /* ghc-8.0 */
HsAppType exp1 (HsWC _ _ ty1) -> do HsAppType exp1 (HsWC _ _ ty1) -> do
#endif #endif
t <- docSharedWrapper layoutType ty1 t <- docSharedWrapper layoutType ty1
@ -224,13 +276,23 @@ layoutExpr lexpr@(L _ expr) = do
e e
(docSeq [docLit $ Text.pack "@", t ]) (docSeq [docLit $ Text.pack "@", t ])
] ]
#if !MIN_VERSION_ghc(8,6,0) /* ghc-8.0 8.2 8.4 */
HsAppTypeOut{} -> do HsAppTypeOut{} -> do
-- TODO -- TODO
briDocByExactInlineOnly "HsAppTypeOut{}" lexpr 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 OpApp expLeft@(L _ OpApp{}) expOp _ expRight -> do
#endif
let gather :: [(LHsExpr GhcPs, LHsExpr GhcPs)] -> LHsExpr GhcPs -> (LHsExpr GhcPs, [(LHsExpr GhcPs, LHsExpr GhcPs)]) let gather :: [(LHsExpr GhcPs, LHsExpr GhcPs)] -> LHsExpr GhcPs -> (LHsExpr GhcPs, [(LHsExpr GhcPs, LHsExpr GhcPs)])
gather opExprList = \case 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 (L _ (OpApp l1 op1 _ r1)) -> gather ((op1, r1): opExprList) l1
#endif
final -> (final, opExprList) final -> (final, opExprList)
(leftOperand, appList) = gather [] expLeft (leftOperand, appList) = gather [] expLeft
leftOperandDoc <- docSharedWrapper layoutExpr leftOperand leftOperandDoc <- docSharedWrapper layoutExpr leftOperand
@ -244,11 +306,19 @@ layoutExpr lexpr@(L _ expr) = do
hasComLeft <- hasAnyCommentsConnected expLeft hasComLeft <- hasAnyCommentsConnected expLeft
hasComOp <- hasAnyCommentsConnected expOp hasComOp <- hasAnyCommentsConnected expOp
pure $ not hasComLeft && not hasComOp 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 let allowPar = case (expOp, expRight) of
(L _ (HsVar (L _ (Unqual occname))), _) (L _ (HsVar (L _ (Unqual occname))), _)
| occNameString occname == "$" -> True | occNameString occname == "$" -> True
(_, L _ (HsApp _ (L _ HsVar{}))) -> False (_, L _ (HsApp _ (L _ HsVar{}))) -> False
_ -> True _ -> True
#endif
runFilteredAlternative $ do runFilteredAlternative $ do
-- > one + two + three -- > one + two + three
-- or -- or
@ -286,15 +356,27 @@ layoutExpr lexpr@(L _ expr) = do
$ (appListDocs <&> \(od, ed) -> docCols ColOpPrefix [appSep od, docSetBaseY ed]) $ (appListDocs <&> \(od, ed) -> docCols ColOpPrefix [appSep od, docSetBaseY ed])
++ [docCols ColOpPrefix [appSep opLastDoc, docSetBaseY expLastDoc]] ++ [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 OpApp expLeft expOp _ expRight -> do
#endif
expDocLeft <- docSharedWrapper layoutExpr expLeft expDocLeft <- docSharedWrapper layoutExpr expLeft
expDocOp <- docSharedWrapper layoutExpr expOp expDocOp <- docSharedWrapper layoutExpr expOp
expDocRight <- docSharedWrapper layoutExpr expRight 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 let allowPar = case (expOp, expRight) of
(L _ (HsVar (L _ (Unqual occname))), _) (L _ (HsVar (L _ (Unqual occname))), _)
| occNameString occname == "$" -> True | occNameString occname == "$" -> True
(_, L _ (HsApp _ (L _ HsVar{}))) -> False (_, L _ (HsApp _ (L _ HsVar{}))) -> False
_ -> True _ -> True
#endif
runFilteredAlternative $ do runFilteredAlternative $ do
-- one-line -- one-line
addAlternative addAlternative
@ -334,12 +416,20 @@ layoutExpr lexpr@(L _ expr) = do
$ docPar $ docPar
expDocLeft expDocLeft
(docCols ColOpPrefix [appSep expDocOp, docSetBaseY expDocRight]) (docCols ColOpPrefix [appSep expDocOp, docSetBaseY expDocRight])
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
NegApp _ op _ -> do
#else
NegApp op _ -> do NegApp op _ -> do
#endif
opDoc <- docSharedWrapper layoutExpr op opDoc <- docSharedWrapper layoutExpr op
docSeq [ docLit $ Text.pack "-" docSeq [ docLit $ Text.pack "-"
, opDoc , opDoc
] ]
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
HsPar _ innerExp -> do
#else
HsPar innerExp -> do HsPar innerExp -> do
#endif
innerExpDoc <- docSharedWrapper (docWrapNode lexpr . layoutExpr) innerExp innerExpDoc <- docSharedWrapper (docWrapNode lexpr . layoutExpr) innerExp
docAlt docAlt
[ docSeq [ docSeq
@ -355,18 +445,37 @@ layoutExpr lexpr@(L _ expr) = do
, docLit $ Text.pack ")" , 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 SectionL left op -> do -- TODO: add to testsuite
#endif
leftDoc <- docSharedWrapper layoutExpr left leftDoc <- docSharedWrapper layoutExpr left
opDoc <- docSharedWrapper layoutExpr op opDoc <- docSharedWrapper layoutExpr op
docSeq [leftDoc, docSeparator, opDoc] 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 SectionR op right -> do -- TODO: add to testsuite
#endif
opDoc <- docSharedWrapper layoutExpr op opDoc <- docSharedWrapper layoutExpr op
rightDoc <- docSharedWrapper layoutExpr right rightDoc <- docSharedWrapper layoutExpr right
docSeq [opDoc, docSeparator, rightDoc] docSeq [opDoc, docSeparator, rightDoc]
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
ExplicitTuple _ args boxity -> do
#else
ExplicitTuple args boxity -> do 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 let argExprs = args <&> \arg -> case arg of
(L _ (Present e)) -> (arg, Just e); (L _ (Present e)) -> (arg, Just e);
(L _ (Missing PlaceHolder)) -> (arg, Nothing) (L _ (Missing PlaceHolder)) -> (arg, Nothing)
#endif
argDocs <- forM argExprs argDocs <- forM argExprs
$ docSharedWrapper $ docSharedWrapper
$ \(arg, exprM) -> docWrapNode arg $ maybe docEmpty layoutExpr exprM $ \(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] lineN = docCols ColTuples [docCommaSep, docNodeAnnKW lexpr (Just AnnOpenP) eN]
end = closeLit end = closeLit
in docSetBaseY $ docLines $ [start] ++ linesM ++ [lineN, end] 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 HsCase cExp (MG lmatches@(L _ matches) _ _ _) -> do
#endif
cExpDoc <- docSharedWrapper layoutExpr cExp cExpDoc <- docSharedWrapper layoutExpr cExp
binderDoc <- docLit $ Text.pack "->" binderDoc <- docLit $ Text.pack "->"
funcPatDocs <- docWrapNode lmatches funcPatDocs <- docWrapNode lmatches
@ -432,7 +547,11 @@ layoutExpr lexpr@(L _ expr) = do
(docSetBaseAndIndent $ docNonBottomSpacing $ docLines $ return <$> funcPatDocs) (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 HsIf _ ifExpr thenExpr elseExpr -> do
#endif
ifExprDoc <- docSharedWrapper layoutExpr ifExpr ifExprDoc <- docSharedWrapper layoutExpr ifExpr
thenExprDoc <- docSharedWrapper layoutExpr thenExpr thenExprDoc <- docSharedWrapper layoutExpr thenExpr
elseExprDoc <- docSharedWrapper layoutExpr elseExpr elseExprDoc <- docSharedWrapper layoutExpr elseExpr
@ -552,7 +671,11 @@ layoutExpr lexpr@(L _ expr) = do
docSetParSpacing $ docAddBaseY BrIndentRegular $ docPar docSetParSpacing $ docAddBaseY BrIndentRegular $ docPar
(docLit $ Text.pack "if") (docLit $ Text.pack "if")
(layoutPatternBindFinal Nothing binderDoc Nothing clauseDocs Nothing hasComments) (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 HsLet binds exp1 -> do
#endif
expDoc1 <- docSharedWrapper layoutExpr exp1 expDoc1 <- docSharedWrapper layoutExpr exp1
-- We jump through some ugly hoops here to ensure proper sharing. -- We jump through some ugly hoops here to ensure proper sharing.
mBindDocs <- mapM (fmap (fmap return) . docWrapNodeRest lexpr . return) 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 $ Text.pack "let in", expDoc1]
-- docSeq [appSep $ docLit "let in", expDoc1] -- docSeq [appSep $ docLit "let in", expDoc1]
HsDo DoExpr (L _ stmts) _ -> do #if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
stmtDocs <- docSharedWrapper layoutStmt `mapM` stmts HsDo _ stmtCtx (L _ stmts) -> case stmtCtx of
docSetParSpacing #else
$ docAddBaseY BrIndentRegular HsDo stmtCtx (L _ stmts) _ -> case stmtCtx of
$ docPar #endif
(docLit $ Text.pack "do") DoExpr -> do
(docSetBaseAndIndent $ docNonBottomSpacing $ docLines stmtDocs) stmtDocs <- docSharedWrapper layoutStmt `mapM` stmts
HsDo MDoExpr (L _ stmts) _ -> do docSetParSpacing
stmtDocs <- docSharedWrapper layoutStmt `mapM` stmts $ docAddBaseY BrIndentRegular
docSetParSpacing $ docPar
$ docAddBaseY BrIndentRegular (docLit $ Text.pack "do")
$ docPar (docSetBaseAndIndent $ docNonBottomSpacing $ docLines stmtDocs)
(docLit $ Text.pack "mdo") MDoExpr -> do
(docSetBaseAndIndent $ docNonBottomSpacing $ docLines stmtDocs) stmtDocs <- docSharedWrapper layoutStmt `mapM` stmts
HsDo x (L _ stmts) _ | case x of { ListComp -> True docSetParSpacing
; MonadComp -> True $ docAddBaseY BrIndentRegular
; _ -> False } -> do $ docPar
stmtDocs <- docSharedWrapper layoutStmt `mapM` stmts (docLit $ Text.pack "mdo")
hasComments <- hasAnyCommentsBelow lexpr (docSetBaseAndIndent $ docNonBottomSpacing $ docLines stmtDocs)
runFilteredAlternative $ do x | case x of { ListComp -> True
addAlternativeCond (not hasComments) ; MonadComp -> True
$ docSeq ; _ -> False } -> do
[ docNodeAnnKW lexpr Nothing stmtDocs <- docSharedWrapper layoutStmt `mapM` stmts
$ appSep hasComments <- hasAnyCommentsBelow lexpr
$ docLit runFilteredAlternative $ do
$ Text.pack "[" addAlternativeCond (not hasComments)
, docNodeAnnKW lexpr (Just AnnOpenS) $ docSeq
$ appSep [ docNodeAnnKW lexpr Nothing
$ docForceSingleline $ appSep
$ List.last stmtDocs $ docLit
, appSep $ docLit $ Text.pack "|" $ Text.pack "["
, docSeq $ List.intersperse docCommaSep , docNodeAnnKW lexpr (Just AnnOpenS)
$ docForceSingleline <$> List.init stmtDocs $ appSep
, docLit $ Text.pack " ]" $ docForceSingleline
] $ List.last stmtDocs
addAlternative $ , appSep $ docLit $ Text.pack "|"
let , docSeq $ List.intersperse docCommaSep
start = docCols ColListComp $ docForceSingleline <$> List.init stmtDocs
[ docNodeAnnKW lexpr Nothing , docLit $ Text.pack " ]"
$ appSep $ docLit $ Text.pack "[" ]
, docSetBaseY addAlternative $
$ docNodeAnnKW lexpr (Just AnnOpenS) let
$ List.last stmtDocs start = docCols ColListComp
] [ docNodeAnnKW lexpr Nothing
(s1:sM) = List.init stmtDocs $ appSep $ docLit $ Text.pack "["
line1 = docCols ColListComp , docSetBaseY
[appSep $ docLit $ Text.pack "|", s1] $ docNodeAnnKW lexpr (Just AnnOpenS)
lineM = sM <&> \d -> $ List.last stmtDocs
docCols ColListComp [docCommaSep, d] ]
end = docLit $ Text.pack "]" (s1:sM) = List.init stmtDocs
in docSetBaseY $ docLines $ [start, line1] ++ lineM ++ [end] line1 = docCols ColListComp
HsDo{} -> do [appSep $ docLit $ Text.pack "|", s1]
-- TODO lineM = sM <&> \d ->
unknownNodeError "HsDo{} no comp" lexpr 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 ExplicitList _ _ elems@(_:_) -> do
elemDocs <- elems `forM` docSharedWrapper layoutExpr elemDocs <- elems `forM` docSharedWrapper layoutExpr
hasComments <- hasAnyCommentsBelow lexpr hasComments <- hasAnyCommentsBelow lexpr
@ -749,80 +877,101 @@ layoutExpr lexpr@(L _ expr) = do
in docSetBaseY $ docLines $ [start] ++ linesM ++ [lineN] ++ [end] in docSetBaseY $ docLines $ [start] ++ linesM ++ [lineN] ++ [end]
ExplicitList _ _ [] -> ExplicitList _ _ [] ->
docLit $ Text.pack "[]" docLit $ Text.pack "[]"
#if !MIN_VERSION_ghc(8,6,0) /* ghc-8.0 8.2 8.4 */
ExplicitPArr{} -> do ExplicitPArr{} -> do
-- TODO -- TODO
briDocByExactInlineOnly "ExplicitPArr{}" lexpr briDocByExactInlineOnly "ExplicitPArr{}" lexpr
RecordCon lname _ _ (HsRecFields fields Nothing) -> do #endif
let nameDoc = docWrapNode lname $ docLit $ lrdrNameToText lname #if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
rFs <- fields RecordCon _ lname fields ->
`forM` \lfield@(L _ (HsRecField (L _ (FieldOcc lnameF _)) rFExpr pun)) -> do #else
rFExpDoc <- if pun RecordCon lname _ _ fields ->
then return Nothing #endif
else Just <$> docSharedWrapper layoutExpr rFExpr case fields of
return $ (lfield, lrdrNameToText lnameF, rFExpDoc) HsRecFields fs Nothing -> do
recordExpression indentPolicy lexpr nameDoc rFs let nameDoc = docWrapNode lname $ docLit $ lrdrNameToText lname
rFs <- fs
RecordCon lname _ _ (HsRecFields [] (Just 0)) -> do `forM` \lfield@(L _ (HsRecField (L _ fieldOcc) rFExpr pun)) -> do
let t = lrdrNameToText lname #if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
docWrapNode lname $ docLit $ t <> Text.pack " { .. }" let FieldOcc _ lnameF = fieldOcc
RecordCon lname _ _ (HsRecFields fs@(_:_) (Just dotdoti)) | dotdoti == length fs -> do #else
-- TODO this should be consolidated into `recordExpression` let FieldOcc lnameF _ = fieldOcc
let nameDoc = docWrapNode lname $ docLit $ lrdrNameToText lname #endif
((fd1l, fd1n, fd1e):fdr) <- fs `forM` \fieldl@(L _ (HsRecField (L _ (FieldOcc lnameF _)) fExpr pun)) -> do rFExpDoc <- if pun
fExpDoc <- if pun then return Nothing
then return Nothing else Just <$> docSharedWrapper layoutExpr rFExpr
else Just <$> docSharedWrapper layoutExpr fExpr return $ (lfield, lrdrNameToText lnameF, rFExpDoc)
return (fieldl, lrdrNameToText lnameF, fExpDoc) recordExpression indentPolicy lexpr nameDoc rFs
let line1 wrapper = HsRecFields [] (Just 0) -> do
[ appSep $ docLit $ Text.pack "{" let t = lrdrNameToText lname
, docWrapNodePrior fd1l $ appSep $ docLit fd1n docWrapNode lname $ docLit $ t <> Text.pack " { .. }"
, case fd1e of HsRecFields fs@(_:_) (Just dotdoti) | dotdoti == length fs -> do
Just x -> docSeq -- TODO this should be consolidated into `recordExpression`
[ appSep $ docLit $ Text.pack "=" let nameDoc = docWrapNode lname $ docLit $ lrdrNameToText lname
, docWrapNodeRest fd1l $ wrapper x fieldDocs <- fs `forM` \fieldl@(L _ (HsRecField (L _ fieldOcc) fExpr pun)) -> do
] #if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
Nothing -> docEmpty 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) -> _ -> unknownNodeError "RecordCon with puns" lexpr
[ docCommaSep #if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
, appSep $ docLit fText RecordUpd _ rExpr fields -> do
, case fDoc of #else
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
RecordUpd rExpr fields _ _ _ _ -> do RecordUpd rExpr fields _ _ _ _ -> do
#endif
rExprDoc <- docSharedWrapper layoutExpr rExpr rExprDoc <- docSharedWrapper layoutExpr rExpr
rFs <- fields rFs <- fields
`forM` \lfield@(L _ (HsRecField (L _ ambName) rFExpr pun)) -> do `forM` \lfield@(L _ (HsRecField (L _ ambName) rFExpr pun)) -> do
@ -830,10 +979,23 @@ layoutExpr lexpr@(L _ expr) = do
then return Nothing then return Nothing
else Just <$> docSharedWrapper layoutExpr rFExpr else Just <$> docSharedWrapper layoutExpr rFExpr
return $ case ambName of 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) Unambiguous n _ -> (lfield, lrdrNameToText n, rFExpDoc)
Ambiguous n _ -> (lfield, lrdrNameToText n, rFExpDoc) Ambiguous n _ -> (lfield, lrdrNameToText n, rFExpDoc)
#endif
recordExpression indentPolicy lexpr rExprDoc rFs 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 ExprWithTySig exp1 (HsWC _ (HsIB _ typ1 _)) -> do
#else /* ghc-8.0 */ #else /* ghc-8.0 */
ExprWithTySig exp1 (HsIB _ (HsWC _ _ typ1)) -> do ExprWithTySig exp1 (HsIB _ (HsWC _ _ typ1)) -> do
@ -845,9 +1007,11 @@ layoutExpr lexpr@(L _ expr) = do
, appSep $ docLit $ Text.pack "::" , appSep $ docLit $ Text.pack "::"
, typDoc , typDoc
] ]
#if !MIN_VERSION_ghc(8,6,0) /* ghc-8.0 8.2 8.4 */
ExprWithTySigOut{} -> do ExprWithTySigOut{} -> do
-- TODO -- TODO
briDocByExactInlineOnly "ExprWithTySigOut{}" lexpr briDocByExactInlineOnly "ExprWithTySigOut{}" lexpr
#endif
ArithSeq _ Nothing info -> ArithSeq _ Nothing info ->
case info of case info of
From e1 -> do From e1 -> do
@ -892,9 +1056,11 @@ layoutExpr lexpr@(L _ expr) = do
] ]
ArithSeq{} -> ArithSeq{} ->
briDocByExactInlineOnly "ArithSeq" lexpr briDocByExactInlineOnly "ArithSeq" lexpr
#if !MIN_VERSION_ghc(8,6,0) /* ghc-8.0 8.2 8.4 */
PArrSeq{} -> do PArrSeq{} -> do
-- TODO -- TODO
briDocByExactInlineOnly "PArrSeq{}" lexpr briDocByExactInlineOnly "PArrSeq{}" lexpr
#endif
HsSCC{} -> do HsSCC{} -> do
-- TODO -- TODO
briDocByExactInlineOnly "HsSCC{}" lexpr briDocByExactInlineOnly "HsSCC{}" lexpr
@ -936,7 +1102,11 @@ layoutExpr lexpr@(L _ expr) = do
briDocByExactInlineOnly "HsTickPragma{}" lexpr briDocByExactInlineOnly "HsTickPragma{}" lexpr
EWildPat{} -> do EWildPat{} -> do
docLit $ Text.pack "_" docLit $ Text.pack "_"
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
EAsPat _ asName asExpr -> do
#else
EAsPat asName asExpr -> do EAsPat asName asExpr -> do
#endif
docSeq docSeq
[ docLit $ lrdrNameToText asName <> Text.pack "@" [ docLit $ lrdrNameToText asName <> Text.pack "@"
, layoutExpr asExpr , layoutExpr asExpr
@ -958,6 +1128,9 @@ layoutExpr lexpr@(L _ expr) = do
-- TODO -- TODO
briDocByExactInlineOnly "ExplicitSum{}" lexpr briDocByExactInlineOnly "ExplicitSum{}" lexpr
#endif #endif
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
XExpr{} -> error "brittany internal error: XExpr"
#endif
recordExpression recordExpression
:: (Data.Data.Data lExpr, Data.Data.Data name) :: (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] in [line1] ++ lineR ++ [lineN]
) )
#if MIN_VERSION_ghc(8,4,0) /* ghc-8.4 */ #if MIN_VERSION_ghc(8,4,0) /* ghc-8.4 */
litBriDoc :: HsLit GhcPs -> BriDocFInt litBriDoc :: HsLit GhcPs -> BriDocFInt
litBriDoc = \case litBriDoc = \case

View File

@ -39,12 +39,32 @@ prepareName = id
layoutIE :: ToBriDoc IE layoutIE :: ToBriDoc IE
layoutIE lie@(L _ ie) = docWrapNode lie $ case ie of 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 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 "(..)"] IEThingAll x -> docSeq [layoutWrapped lie x, docLit $ Text.pack "(..)"]
#endif
#if MIN_VERSION_ghc(8,6,0)
IEThingWith _ x (IEWildcard _) _ _ ->
#else
IEThingWith x (IEWildcard _) _ _ -> IEThingWith x (IEWildcard _) _ _ ->
#endif
docSeq [layoutWrapped lie x, docLit $ Text.pack "(..)"] docSeq [layoutWrapped lie x, docLit $ Text.pack "(..)"]
#if MIN_VERSION_ghc(8,6,0)
IEThingWith _ x _ ns _ -> do
#else
IEThingWith x _ ns _ -> do IEThingWith x _ ns _ -> do
#endif
hasComments <- hasAnyCommentsBelow lie hasComments <- hasAnyCommentsBelow lie
runFilteredAlternative $ do runFilteredAlternative $ do
addAlternativeCond (not hasComments) addAlternativeCond (not hasComments)
@ -68,7 +88,11 @@ layoutIE lie@(L _ ie) = docWrapNode lie $ case ie of
$ [docSeq [docParenLSep, docWrapNode n1 $ nameDoc n1]] $ [docSeq [docParenLSep, docWrapNode n1 $ nameDoc n1]]
++ map layoutItem nMs ++ map layoutItem nMs
++ [docSeq [docCommaSep, docWrapNodeRest lie $ nameDoc nN], docParenR] ++ [docSeq [docCommaSep, docWrapNodeRest lie $ nameDoc nN], docParenR]
#if MIN_VERSION_ghc(8,6,0)
IEModuleContents _ n -> docSeq
#else
IEModuleContents n -> docSeq IEModuleContents n -> docSeq
#endif
[ docLit $ Text.pack "module" [ docLit $ Text.pack "module"
, docSeparator , docSeparator
, docLit . Text.pack . moduleNameString $ unLoc n , docLit . Text.pack . moduleNameString $ unLoc n

View File

@ -43,7 +43,11 @@ prepModName = id
layoutImport :: ToBriDoc ImportDecl layoutImport :: ToBriDoc ImportDecl
layoutImport limportD@(L _ importD) = docWrapNode limportD $ case importD of 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 ImportDecl _ (L _ modName) pkg src safe q False mas mllies -> do
#endif
importCol <- mAsk <&> _conf_layout .> _lconfig_importColumn .> confUnpack importCol <- mAsk <&> _conf_layout .> _lconfig_importColumn .> confUnpack
importAsCol <- mAsk <&> _conf_layout .> _lconfig_importAsColumn .> confUnpack importAsCol <- mAsk <&> _conf_layout .> _lconfig_importAsColumn .> confUnpack
indentPolicy <- mAsk <&> _conf_layout .> _lconfig_indentPolicy .> confUnpack indentPolicy <- mAsk <&> _conf_layout .> _lconfig_indentPolicy .> confUnpack

View File

@ -13,7 +13,7 @@ where
import Language.Haskell.Brittany.Internal.Types import Language.Haskell.Brittany.Internal.Types
import Language.Haskell.Brittany.Internal.LayouterBasics 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 HsSyn
import Name import Name
import BasicTypes import BasicTypes
@ -37,11 +37,25 @@ layoutPat :: ToBriDocC (Pat GhcPs) (Seq BriDocNumbered)
layoutPat lpat@(L _ pat) = docWrapNode lpat $ case pat of layoutPat lpat@(L _ pat) = docWrapNode lpat $ case pat of
WildPat _ -> fmap Seq.singleton $ docLit $ Text.pack "_" WildPat _ -> fmap Seq.singleton $ docLit $ Text.pack "_"
-- _ -> expr -- _ -> 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 -- 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 -- 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 ParPat inner -> do
#endif
-- (nestedpat) -> expr -- (nestedpat) -> expr
left <- docLit $ Text.pack "(" left <- docLit $ Text.pack "("
right <- 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 = locA, b = locB, c = locC } -> expr1
-- Abc { a, b, c } -> expr2 -- Abc { a, b, c } -> expr2
let t = lrdrNameToText lname 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 fExpDoc <- if pun
then return Nothing then return Nothing
else Just <$> docSharedWrapper layoutPat fPat 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 ConPatIn lname (RecCon (HsRecFields fs@(_:_) (Just dotdoti))) | dotdoti == length fs -> do
-- Abc { a = locA, .. } -- Abc { a = locA, .. }
let t = lrdrNameToText lname 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 fExpDoc <- if pun
then return Nothing then return Nothing
else Just <$> docSharedWrapper layoutPat fPat else Just <$> docSharedWrapper layoutPat fPat
@ -136,18 +160,28 @@ layoutPat lpat@(L _ pat) = docWrapNode lpat $ case pat of
(fieldName, Nothing) -> [docLit fieldName, docCommaSep] (fieldName, Nothing) -> [docLit fieldName, docCommaSep]
, docLit $ Text.pack "..}" , docLit $ Text.pack "..}"
] ]
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
TuplePat _ args boxity -> do
#else
TuplePat args boxity _ -> do TuplePat args boxity _ -> do
#endif
-- (nestedpat1, nestedpat2, nestedpat3) -> expr -- (nestedpat1, nestedpat2, nestedpat3) -> expr
-- (#nestedpat1, nestedpat2, nestedpat3#) -> expr -- (#nestedpat1, nestedpat2, nestedpat3#) -> expr
case boxity of case boxity of
Boxed -> wrapPatListy args "()" docParenL docParenR Boxed -> wrapPatListy args "()" docParenL docParenR
Unboxed -> wrapPatListy args "(##)" docParenHashLSep docParenHashRSep Unboxed -> wrapPatListy args "(##)" docParenHashLSep docParenHashRSep
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
AsPat _ asName asPat -> do
#else
AsPat asName asPat -> do AsPat asName asPat -> do
#endif
-- bind@nestedpat -> expr -- bind@nestedpat -> expr
wrapPatPrepend asPat (docLit $ lrdrNameToText asName <> Text.pack "@") 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 SigPatIn pat1 (HsWC _ (HsIB _ ty1 _)) -> do
#else /* ghc-8.0 */ #else /* ghc-8.0 */
SigPatIn pat1 (HsIB _ (HsWC _ _ ty1)) -> do SigPatIn pat1 (HsIB _ (HsWC _ _ ty1)) -> do
#endif #endif
-- i :: Int -> expr -- i :: Int -> expr
@ -169,19 +203,35 @@ layoutPat lpat@(L _ pat) = docWrapNode lpat $ case pat of
, docForceSingleline tyDoc , docForceSingleline tyDoc
] ]
return $ xR Seq.|> xN' return $ xR Seq.|> xN'
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
ListPat _ elems ->
#else
ListPat elems _ _ -> ListPat elems _ _ ->
#endif
-- [] -> expr1 -- [] -> expr1
-- [nestedpat1, nestedpat2, nestedpat3] -> expr2 -- [nestedpat1, nestedpat2, nestedpat3] -> expr2
wrapPatListy elems "[]" docBracketL docBracketR wrapPatListy elems "[]" docBracketL docBracketR
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
BangPat _ pat1 -> do
#else
BangPat pat1 -> do BangPat pat1 -> do
#endif
-- !nestedpat -> expr -- !nestedpat -> expr
wrapPatPrepend pat1 (docLit $ Text.pack "!") wrapPatPrepend pat1 (docLit $ Text.pack "!")
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
LazyPat _ pat1 -> do
#else
LazyPat pat1 -> do LazyPat pat1 -> do
#endif
-- ~nestedpat -> expr -- ~nestedpat -> expr
wrapPatPrepend pat1 (docLit $ Text.pack "~") 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 -- -13 -> expr
litDoc <- docWrapNode llit $ allocateNode $ overLitValBriDoc olit litDoc <- docWrapNode llit $ allocateNode $ overLitValBriDoc $ GHC.ol_val ol
negDoc <- docLit $ Text.pack "-" negDoc <- docLit $ Text.pack "-"
pure $ case mNegative of pure $ case mNegative of
Just{} -> Seq.fromList [negDoc, litDoc] Just{} -> Seq.fromList [negDoc, litDoc]

View File

@ -34,9 +34,17 @@ layoutStmt lstmt@(L _ stmt) = do
indentAmount :: Int <- indentAmount :: Int <-
mAsk <&> _conf_layout .> _lconfig_indentAmount .> confUnpack mAsk <&> _conf_layout .> _lconfig_indentAmount .> confUnpack
docWrapNode lstmt $ case stmt of docWrapNode lstmt $ case stmt of
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
LastStmt _ body False _ -> do
#else
LastStmt body False _ -> do LastStmt body False _ -> do
#endif
layoutExpr body layoutExpr body
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
BindStmt _ lPat expr _ _ -> do
#else
BindStmt lPat expr _ _ _ -> do BindStmt lPat expr _ _ _ -> do
#endif
patDoc <- fmap return $ colsWrapPat =<< layoutPat lPat patDoc <- fmap return $ colsWrapPat =<< layoutPat lPat
expDoc <- docSharedWrapper layoutExpr expr expDoc <- docSharedWrapper layoutExpr expr
docAlt docAlt
@ -52,7 +60,11 @@ layoutStmt lstmt@(L _ stmt) = do
$ docPar (docLit $ Text.pack "<-") (expDoc) $ docPar (docLit $ Text.pack "<-") (expDoc)
] ]
] ]
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
LetStmt _ binds -> do
#else
LetStmt binds -> do LetStmt binds -> do
#endif
let isFree = indentPolicy == IndentPolicyFree let isFree = indentPolicy == IndentPolicyFree
let indentFourPlus = indentAmount >= 4 let indentFourPlus = indentAmount >= 4
layoutLocalBinds binds >>= \case layoutLocalBinds binds >>= \case
@ -97,7 +109,11 @@ layoutStmt lstmt@(L _ stmt) = do
$ docAddBaseY BrIndentRegular $ docAddBaseY BrIndentRegular
$ docPar (docLit $ Text.pack "let") $ docPar (docLit $ Text.pack "let")
(docSetBaseAndIndent $ docLines $ return <$> bindDocs) (docSetBaseAndIndent $ docLines $ return <$> bindDocs)
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
RecStmt _ stmts _ _ _ _ _ -> runFilteredAlternative $ do
#else
RecStmt stmts _ _ _ _ _ _ _ _ _ -> runFilteredAlternative $ do RecStmt stmts _ _ _ _ _ _ _ _ _ -> runFilteredAlternative $ do
#endif
-- rec stmt1 -- rec stmt1
-- stmt2 -- stmt2
-- stmt3 -- stmt3
@ -113,7 +129,11 @@ layoutStmt lstmt@(L _ stmt) = do
addAlternative $ docAddBaseY BrIndentRegular $ docPar addAlternative $ docAddBaseY BrIndentRegular $ docPar
(docLit (Text.pack "rec")) (docLit (Text.pack "rec"))
(docLines $ layoutStmt <$> stmts) (docLines $ layoutStmt <$> stmts)
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
BodyStmt _ expr _ _ -> do
#else
BodyStmt expr _ _ _ -> do BodyStmt expr _ _ _ -> do
#endif
expDoc <- docSharedWrapper layoutExpr expr expDoc <- docSharedWrapper layoutExpr expr
docAddBaseY BrIndentRegular $ expDoc docAddBaseY BrIndentRegular $ expDoc
_ -> briDocByExactInlineOnly "some unknown statement" lstmt _ -> briDocByExactInlineOnly "some unknown statement" lstmt

View File

@ -23,6 +23,7 @@ import HsSyn
import Name import Name
import Outputable ( ftext, showSDocUnsafe ) import Outputable ( ftext, showSDocUnsafe )
import BasicTypes import BasicTypes
import qualified SrcLoc
import DataTreePrint import DataTreePrint
@ -31,7 +32,17 @@ import DataTreePrint
layoutType :: ToBriDoc HsType layoutType :: ToBriDoc HsType
layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
-- _ | traceShow (ExactPrint.Types.mkAnnKey ltype) False -> error "impossible" -- _ | 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 HsTyVar promoted name -> do
t <- lrdrNameToTextAnn name t <- lrdrNameToTextAnn name
case promoted of case promoted of
@ -46,13 +57,25 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
t <- lrdrNameToTextAnn name t <- lrdrNameToTextAnn name
docWrapNode name $ docLit t docWrapNode name $ docLit t
#endif #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 HsForAllTy bndrs (L _ (HsQualTy (L _ cntxts) typ2)) -> do
#endif
typeDoc <- docSharedWrapper layoutType typ2 typeDoc <- docSharedWrapper layoutType typ2
tyVarDocs <- bndrs `forM` \case 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 _ (UserTyVar name)) -> return $ (lrdrNameToText name, Nothing)
(L _ (KindedTyVar lrdrName kind)) -> do (L _ (KindedTyVar lrdrName kind)) -> do
d <- docSharedWrapper layoutType kind d <- docSharedWrapper layoutType kind
return $ (lrdrNameToText lrdrName, Just $ d) return $ (lrdrNameToText lrdrName, Just $ d)
#endif
cntxtDocs <- cntxts `forM` docSharedWrapper layoutType cntxtDocs <- cntxts `forM` docSharedWrapper layoutType
let maybeForceML = case typ2 of let maybeForceML = case typ2 of
(L _ HsFunTy{}) -> docForceMultiline (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 HsForAllTy bndrs typ2 -> do
#endif
typeDoc <- layoutType typ2 typeDoc <- layoutType typ2
tyVarDocs <- bndrs `forM` \case 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 _ (UserTyVar name)) -> return $ (lrdrNameToText name, Nothing)
(L _ (KindedTyVar lrdrName kind)) -> do (L _ (KindedTyVar lrdrName kind)) -> do
d <- layoutType kind d <- layoutType kind
return $ (lrdrNameToText lrdrName, Just $ return d) return $ (lrdrNameToText lrdrName, Just $ return d)
#endif
let maybeForceML = case typ2 of let maybeForceML = case typ2 of
(L _ HsFunTy{}) -> docForceMultiline (L _ HsFunTy{}) -> docForceMultiline
_ -> id _ -> 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 HsQualTy lcntxts@(L _ cntxts) typ1 -> do
#endif
typeDoc <- docSharedWrapper layoutType typ1 typeDoc <- docSharedWrapper layoutType typ1
cntxtDocs <- cntxts `forM` docSharedWrapper layoutType cntxtDocs <- cntxts `forM` docSharedWrapper layoutType
let 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 HsFunTy typ1 typ2 -> do
#endif
typeDoc1 <- docSharedWrapper layoutType typ1 typeDoc1 <- docSharedWrapper layoutType typ1
typeDoc2 <- docSharedWrapper layoutType typ2 typeDoc2 <- docSharedWrapper layoutType typ2
let maybeForceML = case typ2 of 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 HsParTy typ1 -> do
#endif
typeDoc1 <- docSharedWrapper layoutType typ1 typeDoc1 <- docSharedWrapper layoutType typ1
docAlt docAlt
[ docSeq [ docSeq
@ -299,6 +346,35 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
]) ])
(docLit $ Text.pack ")") (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 HsAppTy typ1 typ2 -> do
typeDoc1 <- docSharedWrapper layoutType typ1 typeDoc1 <- docSharedWrapper layoutType typ1
typeDoc2 <- docSharedWrapper layoutType typ2 typeDoc2 <- docSharedWrapper layoutType typ2
@ -351,7 +427,12 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
layoutAppType (L _ (HsAppPrefix t)) = layoutType t layoutAppType (L _ (HsAppPrefix t)) = layoutType t
layoutAppType lt@(L _ (HsAppInfix t)) = layoutAppType lt@(L _ (HsAppInfix t)) =
docLit =<< lrdrNameToTextAnnTypeEqualityIsSpecialAndRespectTick lt t docLit =<< lrdrNameToTextAnnTypeEqualityIsSpecialAndRespectTick lt t
#endif
#if MIN_VERSION_ghc(8,6,0)
HsListTy _ typ1 -> do
#else
HsListTy typ1 -> do HsListTy typ1 -> do
#endif
typeDoc1 <- docSharedWrapper layoutType typ1 typeDoc1 <- docSharedWrapper layoutType typ1
docAlt docAlt
[ docSeq [ docSeq
@ -366,6 +447,8 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
]) ])
(docLit $ Text.pack "]") (docLit $ Text.pack "]")
] ]
#if MIN_VERSION_ghc(8,6,0)
#else
HsPArrTy typ1 -> do HsPArrTy typ1 -> do
typeDoc1 <- docSharedWrapper layoutType typ1 typeDoc1 <- docSharedWrapper layoutType typ1
docAlt docAlt
@ -381,13 +464,19 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
]) ])
(docLit $ Text.pack ":]") (docLit $ Text.pack ":]")
] ]
#endif
#if MIN_VERSION_ghc(8,6,0)
HsTupleTy _ tupleSort typs -> case tupleSort of
#else
HsTupleTy tupleSort typs -> case tupleSort of HsTupleTy tupleSort typs -> case tupleSort of
#endif
HsUnboxedTuple -> unboxed HsUnboxedTuple -> unboxed
HsBoxedTuple -> simple HsBoxedTuple -> simple
HsConstraintTuple -> simple HsConstraintTuple -> simple
HsBoxedOrConstraintTuple -> simple HsBoxedOrConstraintTuple -> simple
where 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 simple = if null typs then unitL else simpleL
unitL = docLit $ Text.pack "()" unitL = docLit $ Text.pack "()"
simpleL = do simpleL = do
@ -480,9 +569,11 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
-- } -- }
-- , _layouter_ast = ltype -- , _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 HsIParamTy (L _ (HsIPName ipName)) typ1 -> do
#else /* ghc-8.0 */ #else /* ghc-8.0 */
HsIParamTy (HsIPName ipName) typ1 -> do HsIParamTy (HsIPName ipName) typ1 -> do
#endif #endif
typeDoc1 <- docSharedWrapper layoutType typ1 typeDoc1 <- docSharedWrapper layoutType typ1
@ -503,6 +594,8 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
, docAddBaseY (BrIndentSpecial 2) typeDoc1 , docAddBaseY (BrIndentSpecial 2) typeDoc1
]) ])
] ]
#if MIN_VERSION_ghc(8,6,0)
#else
HsEqTy typ1 typ2 -> do HsEqTy typ1 typ2 -> do
typeDoc1 <- docSharedWrapper layoutType typ1 typeDoc1 <- docSharedWrapper layoutType typ1
typeDoc2 <- docSharedWrapper layoutType typ2 typeDoc2 <- docSharedWrapper layoutType typ2
@ -521,8 +614,13 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
, docAddBaseY (BrIndentSpecial 2) typeDoc2 , docAddBaseY (BrIndentSpecial 2) typeDoc2
]) ])
] ]
#endif
-- TODO: test KindSig -- TODO: test KindSig
#if MIN_VERSION_ghc(8,6,0)
HsKindSig _ typ1 kind1 -> do
#else
HsKindSig typ1 kind1 -> do HsKindSig typ1 kind1 -> do
#endif
typeDoc1 <- docSharedWrapper layoutType typ1 typeDoc1 <- docSharedWrapper layoutType typ1
kindDoc1 <- docSharedWrapper layoutType kind1 kindDoc1 <- docSharedWrapper layoutType kind1
hasParens <- hasAnnKeyword ltype AnnOpenP hasParens <- hasAnnKeyword ltype AnnOpenP
@ -640,7 +738,11 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
] ]
HsExplicitTupleTy{} -> -- TODO HsExplicitTupleTy{} -> -- TODO
briDocByExactInlineOnly "HsExplicitTupleTy{}" ltype briDocByExactInlineOnly "HsExplicitTupleTy{}" ltype
#if MIN_VERSION_ghc(8,6,0)
HsTyLit _ lit -> case lit of
#else
HsTyLit lit -> case lit of HsTyLit lit -> case lit of
#endif
#if MIN_VERSION_ghc(8,2,0) /* ghc-8.2 */ #if MIN_VERSION_ghc(8,2,0) /* ghc-8.2 */
HsNumTy (SourceText srctext) _ -> docLit $ Text.pack srctext HsNumTy (SourceText srctext) _ -> docLit $ Text.pack srctext
HsNumTy NoSourceText _ -> HsNumTy NoSourceText _ ->
@ -652,11 +754,20 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
HsNumTy srctext _ -> docLit $ Text.pack srctext HsNumTy srctext _ -> docLit $ Text.pack srctext
HsStrTy srctext _ -> docLit $ Text.pack srctext HsStrTy srctext _ -> docLit $ Text.pack srctext
#endif #endif
#if !MIN_VERSION_ghc(8,6,0)
HsCoreTy{} -> -- TODO HsCoreTy{} -> -- TODO
briDocByExactInlineOnly "HsCoreTy{}" ltype briDocByExactInlineOnly "HsCoreTy{}" ltype
#endif
HsWildCardTy _ -> HsWildCardTy _ ->
docLit $ Text.pack "_" docLit $ Text.pack "_"
#if MIN_VERSION_ghc(8,2,0) /* ghc-8.2 */ #if MIN_VERSION_ghc(8,2,0) /* ghc-8.2 */
HsSumTy{} -> -- TODO HsSumTy{} -> -- TODO
briDocByExactInlineOnly "HsSumTy{}" ltype briDocByExactInlineOnly "HsSumTy{}" ltype
#endif #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

View File

@ -203,6 +203,7 @@ transformAlts =
AltLineModeStateForceSL{} -> p == VerticalSpacingParNone AltLineModeStateForceSL{} -> p == VerticalSpacingParNone
AltLineModeStateForceML{} -> p /= VerticalSpacingParNone AltLineModeStateForceML{} -> p /= VerticalSpacingParNone
AltLineModeStateContradiction -> False AltLineModeStateContradiction -> False
-- TODO: use COMPLETE pragma instead?
lineCheck _ = error "ghc exhaustive check is insufficient" lineCheck _ = error "ghc exhaustive check is insufficient"
lconf <- _conf_layout <$> mAsk lconf <- _conf_layout <$> mAsk
#if INSERTTRACESALT #if INSERTTRACESALT
@ -462,7 +463,8 @@ getSpacing !bridoc = rec bridoc
$ LineModeValid $ LineModeValid
$ VerticalSpacing 0 VerticalSpacingParNone False $ VerticalSpacing 0 VerticalSpacingParNone False
BDFLines ls@(_:_) -> do 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 return $ [ VerticalSpacing lsp (VerticalSpacingParSome $ lineMax) False
| VerticalSpacing lsp _ _ <- mVs | VerticalSpacing lsp _ _ <- mVs
, lineMax <- getMaxVS $ maxVs $ lSps , lineMax <- getMaxVS $ maxVs $ lSps