hexagoxel
/
brittany
1
0
Fork 0
Code Issues 117 Pull Requests 5 Packages Projects Releases 5 Wiki Activity

Various layouting fixes

pull/1/head
Lennart Spitzner 2016-08-04 15:12:05 +02:00
parent a82d38fa70
commit 87e81189c9
4 changed files with 58 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

36
src/Language/Haskell/Brittany/Layouters/Decl.hs
View File

@ -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
, let
wherePart = case mWhereDocs of
Nothing -> docEmpty
Just [w] -> docAlt
[ docSeq
[ docSeparator
, appSep $ docLit $ Text.pack "where"
, docSetBaseY $ docSetIndentLevel $ return w
, 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

25
src/Language/Haskell/Brittany/Layouters/Expr.hs
View File

@ -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
@ -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 "}"

14
src/Language/Haskell/Brittany/Layouters/Stmt.hs
View File

@ -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

2
src/Language/Haskell/Brittany/Layouters/Type.hs
View File

@ -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