diff --git a/src-literatetests/40-indent-policy-multiple.blt b/src-literatetests/40-indent-policy-multiple.blt new file mode 100644 index 0000000..b75c726 --- /dev/null +++ b/src-literatetests/40-indent-policy-multiple.blt @@ -0,0 +1,42 @@ +############################################################################### +############################################################################### +############################################################################### +#group indent-policy-multiple +############################################################################### +############################################################################### +############################################################################### + +#test long +-- brittany { lconfig_indentAmount: 4, lconfig_indentPolicy: IndentPolicyMultiple } +func = + mweroiuxlskdfjlksjdflkjsdfljksldkjflkjsdflkj + + mweroiuxlskdfjlksjdflkjsdfljksldkjflkjsdflkj + +#test let indAmount=4 +-- brittany { lconfig_indentAmount: 4, lconfig_indentPolicy: IndentPolicyMultiple } +foo = do + let aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa = + aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa + aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa + foo + +#test let indAmount=8 +-- brittany { lconfig_indentAmount: 8, lconfig_indentPolicy: IndentPolicyMultiple } +foo = do + let aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa = + aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa + aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa + foo +foo = do + let aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa = + aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa + + aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa + + aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa + foo + +#test nested do-block +-- brittany { lconfig_indentAmount: 4, lconfig_indentPolicy: IndentPolicyMultiple } +foo = asdyf8asdf + "ajsdfas" + [ asjdf asyhf $ do + aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa + aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa + ] 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..6e32798 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 @@ -539,9 +540,12 @@ layoutExpr lexpr@(L _ expr) = do mBindDocs <- mapM (fmap (fmap return) . docWrapNodeRest lexpr . return) =<< layoutLocalBinds binds let - ifIndentLeftElse :: a -> a -> a - ifIndentLeftElse x y = - if indentPolicy == IndentPolicyLeft then x else y + ifIndentFreeElse :: a -> a -> a + ifIndentFreeElse x y = + case indentPolicy of + IndentPolicyLeft -> y + IndentPolicyMultiple -> y + IndentPolicyFree -> x -- 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 @@ -562,7 +566,7 @@ layoutExpr lexpr@(L _ expr) = do [ docAlt [ docSeq [ appSep $ docLit $ Text.pack "let" - , ifIndentLeftElse docForceSingleline docSetBaseAndIndent + , ifIndentFreeElse docSetBaseAndIndent docForceSingleline $ bindDoc ] , docAddBaseY BrIndentRegular @@ -572,8 +576,8 @@ layoutExpr lexpr@(L _ expr) = do ] , docAlt [ docSeq - [ appSep $ docLit $ Text.pack $ ifIndentLeftElse "in" "in " - , ifIndentLeftElse docForceSingleline docSetBaseAndIndent expDoc1 + [ appSep $ docLit $ Text.pack $ ifIndentFreeElse "in " "in" + , ifIndentFreeElse docSetBaseAndIndent docForceSingleline expDoc1 ] , docAddBaseY BrIndentRegular $ docPar @@ -596,28 +600,29 @@ layoutExpr lexpr@(L _ expr) = do -- c = d -- in -- fooooooooooooooooooo - addAlternativeCond (indentPolicy == IndentPolicyLeft) - $ docLines - [ docAddBaseY BrIndentRegular - $ docPar - (docLit $ Text.pack "let") - (docSetBaseAndIndent $ docLines bindDocs) - , docSeq - [ docLit $ Text.pack "in " - , docAddBaseY BrIndentRegular expDoc1 + let noHangingBinds = + [ docAddBaseY BrIndentRegular + $ docPar + (docLit $ Text.pack "let") + (docSetBaseAndIndent $ docLines bindDocs) + , docSeq + [ docLit $ Text.pack "in " + , docAddBaseY BrIndentRegular expDoc1 + ] + ] + addAlternative $ case indentPolicy of + IndentPolicyLeft -> docLines noHangingBinds + IndentPolicyMultiple -> docLines noHangingBinds + IndentPolicyFree -> docLines + [ docSeq + [ appSep $ docLit $ Text.pack "let" + , docSetBaseAndIndent $ docLines bindDocs + ] + , docSeq + [ appSep $ docLit $ Text.pack "in " + , docSetBaseY expDoc1 + ] ] - ] - addAlternativeCond (indentPolicy /= IndentPolicyLeft) - $ docLines - [ docSeq - [ appSep $ docLit $ Text.pack "let" - , docSetBaseAndIndent $ docLines bindDocs - ] - , docSeq - [ appSep $ docLit $ Text.pack "in " - , docSetBaseY expDoc1 - ] - ] addAlternative $ docLines [ docAddBaseY BrIndentRegular @@ -877,7 +882,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 +923,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..7a9b922 100644 --- a/src/Language/Haskell/Brittany/Internal/Layouters/Stmt.hs +++ b/src/Language/Haskell/Brittany/Internal/Layouters/Stmt.hs @@ -13,7 +13,10 @@ import Language.Haskell.Brittany.Internal.Types import Language.Haskell.Brittany.Internal.LayouterBasics import Language.Haskell.Brittany.Internal.Config.Types -import GHC ( runGhc, GenLocated(L), moduleNameString ) +import GHC ( runGhc + , GenLocated(L) + , moduleNameString + ) import HsSyn import Name import qualified FastString @@ -28,6 +31,8 @@ import {-# SOURCE #-} Language.Haskell.Brittany.Internal.Layouters.Expr layoutStmt :: ToBriDoc' (StmtLR GhcPs GhcPs (LHsExpr GhcPs)) layoutStmt lstmt@(L _ stmt) = do indentPolicy <- mAsk <&> _conf_layout .> _lconfig_indentPolicy .> confUnpack + indentAmount :: Int <- + mAsk <&> _conf_layout .> _lconfig_indentAmount .> confUnpack docWrapNode lstmt $ case stmt of LastStmt body False _ -> do layoutExpr body @@ -47,52 +52,56 @@ layoutStmt lstmt@(L _ stmt) = do $ docPar (docLit $ Text.pack "<-") (expDoc) ] ] - LetStmt binds -> layoutLocalBinds binds >>= \case - Nothing -> docLit $ Text.pack "let" -- i just tested - -- it, and it is - -- indeed allowed. - -- heh. - Just [] -> docLit $ Text.pack "let" -- this probably never happens - Just [bindDoc] -> docAlt - [ -- let bind = expr - docCols - ColDoLet - [ appSep $ docLit $ Text.pack "let" - , ( if indentPolicy == IndentPolicyLeft - then docForceSingleline - else docSetBaseAndIndent - ) - $ return bindDoc - ] - , -- let - -- bind = expr - docAddBaseY BrIndentRegular $ docPar - (docLit $ Text.pack "let") - (docSetBaseAndIndent $ return bindDoc) - ] - Just bindDocs -> runFilteredAlternative $ do - -- let aaa = expra - -- bbb = exprb - -- ccc = exprc - addAlternativeCond (indentPolicy /= IndentPolicyLeft) - $ docSeq - [ appSep $ docLit $ Text.pack "let" - , docSetBaseAndIndent $ docLines $ return <$> bindDocs - ] - -- let - -- aaa = expra - -- bbb = exprb - -- ccc = exprc - addAlternative $ - docAddBaseY BrIndentRegular $ docPar + LetStmt binds -> do + let isFree = indentPolicy == IndentPolicyFree + let indentFourPlus = indentAmount >= 4 + layoutLocalBinds binds >>= \case + Nothing -> docLit $ Text.pack "let" + -- i just tested the above, and it is indeed allowed. heh. + Just [] -> docLit $ Text.pack "let" -- this probably never happens + Just [bindDoc] -> docAlt + [ -- let bind = expr + docCols + ColDoLet + [ appSep $ docLit $ Text.pack "let" + , let + f = case indentPolicy of + IndentPolicyFree -> docSetBaseAndIndent + IndentPolicyLeft -> docForceSingleline + IndentPolicyMultiple | indentFourPlus -> docSetBaseAndIndent + | otherwise -> docForceSingleline + in f $ return bindDoc + ] + , -- let + -- bind = expr + docAddBaseY BrIndentRegular $ docPar (docLit $ Text.pack "let") - (docSetBaseAndIndent $ docLines $ return <$> bindDocs) + (docSetBaseAndIndent $ return bindDoc) + ] + Just bindDocs -> runFilteredAlternative $ do + -- let aaa = expra + -- bbb = exprb + -- ccc = exprc + addAlternativeCond (isFree || indentFourPlus) $ docSeq + [ appSep $ docLit $ Text.pack "let" + , let f = if indentFourPlus + then docEnsureIndent BrIndentRegular + else docSetBaseAndIndent + in f $ docLines $ return <$> bindDocs + ] + -- let + -- aaa = expra + -- bbb = exprb + -- ccc = exprc + addAlternativeCond (not indentFourPlus) + $ 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 +110,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..7361ce6 100644 --- a/src/Language/Haskell/Brittany/Internal/Transformations/Alt.hs +++ b/src/Language/Haskell/Brittany/Internal/Transformations/Alt.hs @@ -141,11 +141,7 @@ transformAlts = BDFSeparator -> processSpacingSimple bdX $> bdX BDFAddBaseY indent bd -> do acp <- mGet - indAmount <- mAsk <&> _conf_layout .> _lconfig_indentAmount .> confUnpack - let indAdd = case indent of - BrIndentNone -> 0 - BrIndentRegular -> indAmount - BrIndentSpecial i -> i + indAdd <- fixIndentationForMultiple acp indent mSet $ acp { _acp_indentPrep = max (_acp_indentPrep acp) indAdd } r <- rec bd acp' <- mGet @@ -315,11 +311,7 @@ transformAlts = return $ reWrap $ BDFLines (l':lr') BDFEnsureIndent indent bd -> do acp <- mGet - indAmount <- mAsk <&> _conf_layout .> _lconfig_indentAmount .> confUnpack - let indAdd = case indent of - BrIndentNone -> 0 - BrIndentRegular -> indAmount - BrIndentSpecial i -> i + indAdd <- fixIndentationForMultiple acp indent mSet $ acp { _acp_indentPrep = 0 -- TODO: i am not sure this is valid, in general. @@ -857,3 +849,25 @@ getSpacings limit bridoc = preFilterLimit <$> rec bridoc VerticalSpacingParSome i -> VerticalSpacingParSome $ x1 `max` i VerticalSpacingParNone -> VerticalSpacingParSome $ x1 VerticalSpacingParAlways i -> VerticalSpacingParAlways $ x1 `max` i + +fixIndentationForMultiple + :: (MonadMultiReader (CConfig Identity) m) => AltCurPos -> BrIndent -> m Int +fixIndentationForMultiple acp indent = do + indAmount <- mAsk <&> _conf_layout .> _lconfig_indentAmount .> confUnpack + let indAddRaw = case indent of + BrIndentNone -> 0 + BrIndentRegular -> indAmount + BrIndentSpecial i -> i + -- for IndentPolicyMultiple, we restrict the amount of added + -- indentation in such a manner that we end up on a multiple of the + -- base indentation. + indPolicy <- mAsk <&> _conf_layout .> _lconfig_indentPolicy .> confUnpack + pure $ if indPolicy == IndentPolicyMultiple + then + let indAddMultiple1 = + indAddRaw - ((_acp_indent acp + indAddRaw) `mod` indAmount) + indAddMultiple2 = if indAddMultiple1 <= 0 + then indAddMultiple1 + indAmount + else indAddMultiple1 + in indAddMultiple2 + else indAddRaw