diff --git a/src/Language/Haskell/Brittany/Layouters/Decl.hs b/src/Language/Haskell/Brittany/Layouters/Decl.hs index 5ae16c1..ee6cd8c 100644 --- a/src/Language/Haskell/Brittany/Layouters/Decl.hs +++ b/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 - Nothing -> pure docEmpty - Just [w] -> pure $ docSeq - [ docSeparator - , appSep $ docLit $ Text.pack "where" - , docSetBaseY $ docSetIndentLevel $ return w - ] - _ -> [] + , let + wherePart = case mWhereDocs of + Nothing -> docEmpty + Just [w] -> docAlt + [ docSeq + [ 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 diff --git a/src/Language/Haskell/Brittany/Layouters/Expr.hs b/src/Language/Haskell/Brittany/Layouters/Expr.hs index 62ad036..1dffb81 100644 --- a/src/Language/Haskell/Brittany/Layouters/Expr.hs +++ b/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 "}" diff --git a/src/Language/Haskell/Brittany/Layouters/Stmt.hs b/src/Language/Haskell/Brittany/Layouters/Stmt.hs index 73011f7..d902835 100644 --- a/src/Language/Haskell/Brittany/Layouters/Stmt.hs +++ b/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 - , docAddBaseY (BrIndentSpecial 6) (return bindDoc) + [ docEnsureIndent (BrIndentSpecial 4) docEmpty + , 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 diff --git a/src/Language/Haskell/Brittany/Layouters/Type.hs b/src/Language/Haskell/Brittany/Layouters/Type.hs index efac1ff..8f942f9 100644 --- a/src/Language/Haskell/Brittany/Layouters/Type.hs +++ b/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