From 9ab17cc899718714fb387a475afde5a11041ea69 Mon Sep 17 00:00:00 2001 From: Bryan Richter Date: Sun, 22 Apr 2018 15:24:40 +0200 Subject: [PATCH] Implement IndentPolicyMultiple --- .../Brittany/Internal/Layouters/Decl.hs | 2 +- .../Brittany/Internal/Layouters/Expr.hs | 42 +++++++++++-------- .../Brittany/Internal/Layouters/Import.hs | 2 +- .../Brittany/Internal/Layouters/Stmt.hs | 30 +++++++------ .../Brittany/Internal/Transformations/Alt.hs | 10 ++++- 5 files changed, 49 insertions(+), 37 deletions(-) diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Decl.hs b/src/Language/Haskell/Brittany/Internal/Layouters/Decl.hs index d4e8bce..19a6f48 100644 --- a/src/Language/Haskell/Brittany/Internal/Layouters/Decl.hs +++ b/src/Language/Haskell/Brittany/Internal/Layouters/Decl.hs @@ -436,7 +436,7 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs mWhereDocs ha -- multiple clauses added in-paragraph, each in a single line -- example: foo | bar = baz -- | lll = asd - addAlternativeCond (indentPolicy /= IndentPolicyLeft) + addAlternativeCond (indentPolicy == IndentPolicyFree) $ docLines $ [ docSeq [ appSep $ docForceSingleline $ return patDoc diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs b/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs index 93a06ac..a9deffc 100644 --- a/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs +++ b/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs @@ -422,7 +422,8 @@ layoutExpr lexpr@(L _ expr) = do let maySpecialIndent = case indentPolicy of IndentPolicyLeft -> BrIndentRegular - _ -> BrIndentSpecial 3 + IndentPolicyMultiple -> BrIndentRegular + IndentPolicyFree -> BrIndentSpecial 3 -- TODO: some of the alternatives (especially last and last-but-one) -- overlap. runFilteredAlternative $ do @@ -541,7 +542,10 @@ layoutExpr lexpr@(L _ expr) = do let ifIndentLeftElse :: a -> a -> a ifIndentLeftElse x y = - if indentPolicy == IndentPolicyLeft then x else y + case indentPolicy of + IndentPolicyLeft -> x + IndentPolicyMultiple -> x + IndentPolicyFree -> y -- this `docSetBaseAndIndent` might seem out of place (especially the -- Indent part; setBase is necessary due to the use of docLines below), -- but is here due to ghc-exactprint's DP handling of "let" in @@ -596,18 +600,21 @@ layoutExpr lexpr@(L _ expr) = do -- c = d -- in -- fooooooooooooooooooo + let noHangingBinds = + [ docAddBaseY BrIndentRegular + $ docPar + (docLit $ Text.pack "let") + (docSetBaseAndIndent $ docLines bindDocs) + , docSeq + [ docLit $ Text.pack "in " + , docAddBaseY BrIndentRegular expDoc1 + ] + ] addAlternativeCond (indentPolicy == IndentPolicyLeft) - $ docLines - [ docAddBaseY BrIndentRegular - $ docPar - (docLit $ Text.pack "let") - (docSetBaseAndIndent $ docLines bindDocs) - , docSeq - [ docLit $ Text.pack "in " - , docAddBaseY BrIndentRegular expDoc1 - ] - ] - addAlternativeCond (indentPolicy /= IndentPolicyLeft) + $ docLines noHangingBinds + addAlternativeCond (indentPolicy == IndentPolicyMultiple) + $ docLines noHangingBinds + addAlternativeCond (indentPolicy == IndentPolicyFree) $ docLines [ docSeq [ appSep $ docLit $ Text.pack "let" @@ -877,7 +884,7 @@ layoutExpr lexpr@(L _ expr) = do -- container { fieldA = blub -- , fieldB = blub -- } - addAlternativeCond (indentPolicy /= IndentPolicyLeft) + addAlternativeCond (indentPolicy == IndentPolicyFree) $ docSeq [ docNodeAnnKW lexpr Nothing $ appSep rExprDoc , docSetBaseY $ docLines $ let @@ -918,9 +925,10 @@ layoutExpr lexpr@(L _ expr) = do $ docPar (docNodeAnnKW lexpr Nothing rExprDoc) (docNonBottomSpacing $ docLines $ let - expressionWrapper = if indentPolicy == IndentPolicyLeft - then docForceParSpacing - else docSetBaseY + expressionWrapper = case indentPolicy of + IndentPolicyLeft -> docForceParSpacing + IndentPolicyMultiple -> docForceParSpacing + IndentPolicyFree -> docSetBaseY line1 = docCols ColRecUpdate [ appSep $ docLit $ Text.pack "{" , docWrapNodePrior rF1f $ appSep $ docLit rF1n diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Import.hs b/src/Language/Haskell/Brittany/Internal/Layouters/Import.hs index 3f56dcd..aa4380f 100644 --- a/src/Language/Haskell/Brittany/Internal/Layouters/Import.hs +++ b/src/Language/Haskell/Brittany/Internal/Layouters/Import.hs @@ -48,7 +48,7 @@ layoutImport limportD@(L _ importD) = docWrapNode limportD $ case importD of importAsCol <- mAsk <&> _conf_layout .> _lconfig_importAsColumn .> confUnpack indentPolicy <- mAsk <&> _conf_layout .> _lconfig_indentPolicy .> confUnpack let - compact = indentPolicy == IndentPolicyLeft + compact = indentPolicy /= IndentPolicyFree modNameT = Text.pack $ moduleNameString modName pkgNameT = Text.pack . prepPkg . sl_st <$> pkg masT = Text.pack . moduleNameString . prepModName <$> mas diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Stmt.hs b/src/Language/Haskell/Brittany/Internal/Layouters/Stmt.hs index 70daf6c..33b700e 100644 --- a/src/Language/Haskell/Brittany/Internal/Layouters/Stmt.hs +++ b/src/Language/Haskell/Brittany/Internal/Layouters/Stmt.hs @@ -58,11 +58,11 @@ layoutStmt lstmt@(L _ stmt) = do docCols ColDoLet [ appSep $ docLit $ Text.pack "let" - , ( if indentPolicy == IndentPolicyLeft - then docForceSingleline - else docSetBaseAndIndent - ) - $ return bindDoc + , let f = case indentPolicy of + IndentPolicyFree -> docSetBaseAndIndent + IndentPolicyLeft -> docForceSingleline + IndentPolicyMultiple -> docForceSingleline + in f $ return bindDoc ] , -- let -- bind = expr @@ -74,8 +74,8 @@ layoutStmt lstmt@(L _ stmt) = do -- let aaa = expra -- bbb = exprb -- ccc = exprc - addAlternativeCond (indentPolicy /= IndentPolicyLeft) - $ docSeq + -- TODO: Allow this for IndentPolicyMultiple when indentAmount = 4 + addAlternativeCond (indentPolicy == IndentPolicyFree) $ docSeq [ appSep $ docLit $ Text.pack "let" , docSetBaseAndIndent $ docLines $ return <$> bindDocs ] @@ -83,16 +83,14 @@ layoutStmt lstmt@(L _ stmt) = do -- aaa = expra -- bbb = exprb -- ccc = exprc - addAlternative $ - docAddBaseY BrIndentRegular $ docPar - (docLit $ Text.pack "let") - (docSetBaseAndIndent $ docLines $ return <$> bindDocs) + addAlternative $ docAddBaseY BrIndentRegular $ docPar + (docLit $ Text.pack "let") + (docSetBaseAndIndent $ docLines $ return <$> bindDocs) RecStmt stmts _ _ _ _ _ _ _ _ _ -> runFilteredAlternative $ do -- rec stmt1 -- stmt2 -- stmt3 - addAlternativeCond (indentPolicy /= IndentPolicyLeft) - $ docSeq + addAlternativeCond (indentPolicy == IndentPolicyFree) $ docSeq [ docLit (Text.pack "rec") , docSeparator , docSetBaseAndIndent $ docLines $ layoutStmt <$> stmts @@ -101,9 +99,9 @@ layoutStmt lstmt@(L _ stmt) = do -- stmt1 -- stmt2 -- stmt3 - addAlternative - $ docAddBaseY BrIndentRegular - $ docPar (docLit (Text.pack "rec")) (docLines $ layoutStmt <$> stmts) + addAlternative $ docAddBaseY BrIndentRegular $ docPar + (docLit (Text.pack "rec")) + (docLines $ layoutStmt <$> stmts) BodyStmt expr _ _ _ -> do expDoc <- docSharedWrapper layoutExpr expr docAddBaseY BrIndentRegular $ expDoc diff --git a/src/Language/Haskell/Brittany/Internal/Transformations/Alt.hs b/src/Language/Haskell/Brittany/Internal/Transformations/Alt.hs index f7ed523..5b833fd 100644 --- a/src/Language/Haskell/Brittany/Internal/Transformations/Alt.hs +++ b/src/Language/Haskell/Brittany/Internal/Transformations/Alt.hs @@ -142,17 +142,23 @@ transformAlts = BDFAddBaseY indent bd -> do acp <- mGet indAmount <- mAsk <&> _conf_layout .> _lconfig_indentAmount .> confUnpack + indPolicy <- mAsk <&> _conf_layout .> _lconfig_indentPolicy .> confUnpack let indAdd = case indent of BrIndentNone -> 0 BrIndentRegular -> indAmount BrIndentSpecial i -> i - mSet $ acp { _acp_indentPrep = max (_acp_indentPrep acp) indAdd } + let indAdd' = + if indPolicy == IndentPolicyMultiple + then + max 0 (indAdd - ((_acp_indent acp + indAdd) `mod` indAmount)) + else indAdd + mSet $ acp { _acp_indentPrep = max (_acp_indentPrep acp) indAdd' } r <- rec bd acp' <- mGet mSet $ acp' { _acp_indent = _acp_indent acp } return $ case indent of BrIndentNone -> r - BrIndentRegular -> reWrap $ BDFAddBaseY (BrIndentSpecial indAdd) r + BrIndentRegular -> reWrap $ BDFAddBaseY (BrIndentSpecial indAdd') r BrIndentSpecial i -> reWrap $ BDFAddBaseY (BrIndentSpecial i) r BDFBaseYPushCur bd -> do acp <- mGet