Various layouting fixes

src/Language/Haskell/Brittany/Layouters/Decl.hs

@@ -18,6 +18,7 @@ where
 
 import           Language.Haskell.Brittany.Types
 import           Language.Haskell.Brittany.LayoutBasics
+import           Language.Haskell.Brittany.Config.Types
 
 import           RdrName ( RdrName(..) )
 import           GHC ( runGhc, GenLocated(L), moduleNameString )
@@ -148,6 +149,11 @@ layoutPatternBindFinal binderDoc mPatDoc clauseDocs mWhereDocs = do
       patPartParWrap = case mPatDoc of
         Nothing -> id
         Just patDoc -> docPar (return patDoc)
+  _whereIndent <- mAsk
+                 <&> _conf_layout
+                 .>  _lconfig_indentWhereSpecial
+                 .>  runIdentity
+                 .>  Bool.bool BrIndentRegular (BrIndentSpecial 1)
   docAlt $
     -- one-line solution
     [ docCols ColBindingLine
@@ -171,14 +177,29 @@ layoutPatternBindFinal binderDoc mPatDoc clauseDocs mWhereDocs = do
               $ [appSep $ docLit $ Text.pack "|"]
               ++ List.intersperse docCommaSep (return <$> gs)
               ++ [docSeparator]
-    , wherePart <- case mWhereDocs of
+    , let
-        Nothing -> pure docEmpty
+        wherePart = case mWhereDocs of
-        Just [w] -> pure $ docSeq
+          Nothing -> docEmpty
-          [ docSeparator
+          Just [w] -> docAlt
-          , appSep $ docLit $ Text.pack "where"
+            [ docSeq
-          , docSetBaseY $ docSetIndentLevel $ return w
+              [ docSeparator
-          ]
+              , appSep $ docLit $ Text.pack "where"
-        _ -> []
+              , docSetIndentLevel $ docForceSingleline $ return w
+              ]
+            , docAddBaseY BrIndentRegular
+            $ docPar docEmpty
+            $ docAddBaseY BrIndentRegular
+            $ docPar
+              (docLit $ Text.pack "where")
+              (docSetIndentLevel $ return w)
+            ]
+          Just ws ->
+            docAddBaseY BrIndentRegular
+            $ docPar docEmpty
+            $ docAddBaseY BrIndentRegular
+            $ docPar
+              (docLit $ Text.pack "where")
+              (docSetIndentLevel $ docLines $ return <$> ws)
     ] ++
     -- two-line solution
     [ docLines
@@ -238,7 +259,10 @@ layoutPatternBindFinal binderDoc mPatDoc clauseDocs mWhereDocs = do
     [ docAddBaseY BrIndentRegular
     $ docPar
       (docSeq (patPartInline ++ [appSep $ guardPart, return binderDoc]))
-      (docLines $ [ return body ] ++ wherePart)
+      ( docNonBottomSpacing
+      $ docLines
+      $ [ docAddBaseY BrIndentRegular $ return body ] ++ wherePart
+      )
     | [(guards, body, _)] <- [clauseDocs]
     , let guardPart = case guards of
             [] -> docEmpty

src/Language/Haskell/Brittany/Layouters/Expr.hs

@@ -57,12 +57,15 @@ layoutExpr lexpr@(L _ expr) = docWrapNode lexpr $ case expr of
     let funcPatternPartLine =
           docCols ColCasePattern
             $ (patDocs <&> (\p -> docSeq [docForceSingleline p, docSeparator]))
+    let lineMod = if isExpressionTypeHeadPar body
+          then id
+          else docForceSingleline
     docAlt
       [ docSeq
         [ docLit $ Text.pack "\\"
         , docWrapNode lmatch $ docForceSingleline funcPatternPartLine
         , appSep $ docLit $ Text.pack "->"
-        , docWrapNode lgrhs $ docForceSingleline bodyDoc
+        , docWrapNode lgrhs $ lineMod bodyDoc
         ]
       , docAddBaseY BrIndentRegular
       $ docPar
@@ -327,11 +330,11 @@ layoutExpr lexpr@(L _ expr) = docWrapNode lexpr $ case expr of
         , docLines
           [ docSeq
             [ appSep $ docLit $ Text.pack "let"
-            , docSetBaseY $ docSetIndentLevel $ return bindDoc
+            , docSetIndentLevel $ return bindDoc
             ]
           , docSeq
             [ appSep $ docLit $ Text.pack "in "
-            , docSetBaseY $ docSetIndentLevel $ expDoc1
+            , docSetIndentLevel $ expDoc1
             ]
           ]
         , docLines
@@ -349,11 +352,11 @@ layoutExpr lexpr@(L _ expr) = docWrapNode lexpr $ case expr of
         [ docLines
           [ docSeq
             [ appSep $ docLit $ Text.pack "let"
-            , docSetBaseY $ docSetIndentLevel $ docLines $ return <$> bindDocs
+            , docSetIndentLevel $ docLines $ return <$> bindDocs
             ]
           , docSeq
             [ appSep $ docLit $ Text.pack "in "
-            , docSetBaseY $ docSetIndentLevel $ expDoc1
+            , docSetIndentLevel $ expDoc1
             ]
           ]
         , docLines
@@ -386,7 +389,7 @@ layoutExpr lexpr@(L _ expr) = docWrapNode lexpr $ case expr of
         , appSep $ docLit $ Text.pack "|"
         , docSeq $ List.intersperse docCommaSep
                 $ fmap docForceSingleline $ List.init stmtDocs
-        , docLit $ Text.pack "]"
+        , docLit $ Text.pack " ]"
         ]
       , let
           start = docCols ColListComp
@@ -396,7 +399,7 @@ layoutExpr lexpr@(L _ expr) = docWrapNode lexpr $ case expr of
                     [appSep $ docLit $ Text.pack "|", s1]
           lineM = sM <&> \d ->
                   docCols ColListComp [docCommaSep, d]
-          end   = docLit $ Text.pack " ]"
+          end   = docLit $ Text.pack "]"
         in docSetBaseY $ docLines $ [start, line1] ++ lineM ++ [end]
       ]
   HsDo{} -> do
@@ -427,9 +430,9 @@ layoutExpr lexpr@(L _ expr) = docWrapNode lexpr $ case expr of
     docLit $ t <> Text.pack "{}"
   RecordCon lname _ _ (HsRecFields fs@(_:_) Nothing) -> do
     let t = lrdrNameToText lname
-    (fd1:fdr) <- fs `forM` \(L _ (HsRecField (L _ (FieldOcc lnameF _)) fExpr _)) -> do
+    ((fd1l, fd1n, fd1e):fdr) <- fs `forM` \fieldl@(L _ (HsRecField (L _ (FieldOcc lnameF _)) fExpr _)) -> do
       fExpDoc <- docSharedWrapper layoutExpr fExpr
-      return $ (lrdrNameToText lnameF, fExpDoc)
+      return $ (fieldl, lrdrNameToText lnameF, fExpDoc)
     docAlt
       [ docAddBaseY BrIndentRegular
       $ docPar
@@ -437,16 +440,16 @@ layoutExpr lexpr@(L _ expr) = docWrapNode lexpr $ case expr of
           (docLines $ let
             line1 = docCols ColRecUpdate
               [ appSep $ docLit $ Text.pack "{"
-              , appSep $ docLit $ fst fd1
+              , appSep $ docLit $ fd1n
               , docSeq [ appSep $ docLit $ Text.pack "="
-                      , docAddBaseY BrIndentRegular $ snd fd1
+                      , docWrapNode fd1l $ docAddBaseY BrIndentRegular $ fd1e
                       ]
               ]
-            lineR = fdr <&> \(fText, fDoc) -> docCols ColRecUpdate
+            lineR = fdr <&> \(lfield, fText, fDoc) -> docCols ColRecUpdate
               [ appSep $ docLit $ Text.pack ","
               , appSep $ docLit $ fText
               , docSeq [ appSep $ docLit $ Text.pack "="
-                      , docAddBaseY BrIndentRegular fDoc
+                      , docWrapNode lfield $ docAddBaseY BrIndentRegular fDoc
                       ]
               ]
             lineN = docLit $ Text.pack "}"

src/Language/Haskell/Brittany/Layouters/Stmt.hs

@@ -46,28 +46,30 @@ layoutStmt lstmt@(L _ stmt) = docWrapNode lstmt $ case stmt of
     Just [bindDoc] -> docAlt
       [ docCols ColDoLet
         [ appSep $ docLit $ Text.pack "let"
-        , docSetBaseY $ docAddBaseY BrIndentRegular (return bindDoc)
+        , docSetIndentLevel $ docAddBaseY BrIndentRegular (return bindDoc)
         ]
       , docAddBaseY BrIndentRegular $ docPar
         (docLit $ Text.pack "let")
-        (return bindDoc)
+        (docSetIndentLevel $ return bindDoc)
       ]
     Just bindDocs@(bindDoc1:bindDocr) -> do
+      -- TODO: the indentation here is screwed up. needs docSetIndentLevel and
+      -- SetBaseY based layouting, not cols.
       docAlt
         [ docLines
         $ (docCols ColDoLet
             [ appSep $ docLit $ Text.pack "let"
-            , docAddBaseY (BrIndentSpecial 6) (return bindDoc1)
+            , docSetIndentLevel $ docAddBaseY BrIndentRegular (return bindDoc1)
             ])
         : (bindDocr <&> \bindDoc ->
            docCols ColDoLet
-            [ appSep $ docEmpty
+            [ docEnsureIndent (BrIndentSpecial 4) docEmpty
-            , docAddBaseY (BrIndentSpecial 6) (return bindDoc)
+            , docSetIndentLevel $ docAddBaseY BrIndentRegular (return bindDoc)
             ])
         , docAddBaseY BrIndentRegular
         $ docPar
           (docLit $ Text.pack "let")
-          (docLines $ return <$> bindDocs)
+          (docSetIndentLevel $ docAddBaseY BrIndentRegular $ docLines $ return <$> bindDocs)
         ]
   BodyStmt expr _ _ _ -> do
     expDoc <- docSharedWrapper layoutExpr expr

src/Language/Haskell/Brittany/Layouters/Type.hs

@@ -217,7 +217,7 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
       [ docSeq
         [ docForceSingleline contextDoc
         , docLit $ Text.pack " => "
-        , typeDoc
+        , docForceSingleline typeDoc
         ]
       --    (Foo a b c)
       -- => a b