Merge branch 'IndentPolicyMultiple'

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
+    ]

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

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
+        ifIndentFreeElse :: a -> a -> a
-        ifIndentLeftElse x y =
+        ifIndentFreeElse x y =
-          if indentPolicy == IndentPolicyLeft then x else 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 "
+                      [ appSep $ docLit $ Text.pack $ ifIndentFreeElse "in " "in"
-                      , ifIndentLeftElse docForceSingleline docSetBaseAndIndent expDoc1
+                      , ifIndentFreeElse docSetBaseAndIndent docForceSingleline expDoc1
                       ]
                   , docAddBaseY BrIndentRegular
                   $ docPar
@@ -596,28 +600,29 @@ layoutExpr lexpr@(L _ expr) = do
           --    c = d
           --  in
           --    fooooooooooooooooooo
-          addAlternativeCond (indentPolicy == IndentPolicyLeft)
+          let noHangingBinds =
-            $ docLines
+                [ docAddBaseY BrIndentRegular
-            [ docAddBaseY BrIndentRegular
+                $ docPar
-            $ docPar
+                  (docLit $ Text.pack "let")
-              (docLit $ Text.pack "let")
+                  (docSetBaseAndIndent $ docLines bindDocs)
-              (docSetBaseAndIndent $ docLines bindDocs)
+                , docSeq
-            , docSeq
+                  [ docLit $ Text.pack "in "
-              [ docLit $ Text.pack "in "
+                  , docAddBaseY BrIndentRegular expDoc1
-              , 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
+                expressionWrapper = case indentPolicy of
-                  then docForceParSpacing
+                  IndentPolicyLeft -> docForceParSpacing
-                  else docSetBaseY
+                  IndentPolicyMultiple -> docForceParSpacing
+                  IndentPolicyFree -> docSetBaseY
                 line1 = docCols ColRecUpdate
                   [ appSep $ docLit $ Text.pack "{"
                   , docWrapNodePrior rF1f $ appSep $ docLit rF1n

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

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
+    LetStmt binds -> do
-      Nothing        -> docLit $ Text.pack "let" -- i just tested
+      let isFree         = indentPolicy == IndentPolicyFree
-                                -- it, and it is
+      let indentFourPlus = indentAmount >= 4
-                                -- indeed allowed.
+      layoutLocalBinds binds >>= \case
-                                -- heh.
+        Nothing        -> docLit $ Text.pack "let"
-      Just []        -> docLit $ Text.pack "let" -- this probably never happens
+          -- i just tested the above, and it is indeed allowed. heh.
-      Just [bindDoc] -> docAlt
+        Just []        -> docLit $ Text.pack "let" -- this probably never happens
-        [ -- let bind = expr
+        Just [bindDoc] -> docAlt
-          docCols
+          [ -- let bind = expr
-          ColDoLet
+            docCols
-          [ appSep $ docLit $ Text.pack "let"
+            ColDoLet
-          , ( if indentPolicy == IndentPolicyLeft
+            [ appSep $ docLit $ Text.pack "let"
-              then docForceSingleline
+            , let
-              else docSetBaseAndIndent
+                f = case indentPolicy of
-            )
+                  IndentPolicyFree -> docSetBaseAndIndent
-            $ return bindDoc
+                  IndentPolicyLeft -> docForceSingleline
-          ]
+                  IndentPolicyMultiple | indentFourPlus -> docSetBaseAndIndent
-        , -- let
+                                       | otherwise      -> docForceSingleline
-          --   bind = expr
+              in  f $ return bindDoc
-          docAddBaseY BrIndentRegular $ docPar
+            ]
-          (docLit $ Text.pack "let")
+          , -- let
-          (docSetBaseAndIndent $ return bindDoc)
+              --   bind = expr
-        ]
+            docAddBaseY BrIndentRegular $ docPar
-      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
             (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)
+      addAlternativeCond (indentPolicy == IndentPolicyFree) $ docSeq
-        $ docSeq
         [ docLit (Text.pack "rec")
         , docSeparator
         , docSetBaseAndIndent $ docLines $ layoutStmt <$> stmts
@@ -101,9 +110,9 @@ layoutStmt lstmt@(L _ stmt) = do
       --   stmt1
       --   stmt2
       --   stmt3
-      addAlternative
+      addAlternative $ docAddBaseY BrIndentRegular $ docPar
-        $ docAddBaseY BrIndentRegular
+        (docLit (Text.pack "rec"))
-        $ docPar (docLit (Text.pack "rec")) (docLines $ layoutStmt <$> stmts)
+        (docLines $ layoutStmt <$> stmts)
     BodyStmt expr _ _ _ -> do
       expDoc <- docSharedWrapper layoutExpr expr
       docAddBaseY BrIndentRegular $ expDoc

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
+          indAdd <- fixIndentationForMultiple acp indent
-          let indAdd = case indent of
-                BrIndentNone -> 0
-                BrIndentRegular -> indAmount
-                BrIndentSpecial i -> i
           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
+          indAdd <- fixIndentationForMultiple acp indent
-          let indAdd = case indent of
-                BrIndentNone -> 0
-                BrIndentRegular -> indAmount
-                BrIndentSpecial i -> i
           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