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

Layout NegApp, RecordUpd with pun; Add some AnnKW

pull/3/head
Lennart Spitzner 2016-08-11 23:06:21 +02:00
parent 46ad20e8f9
commit dd60900da4
2 changed files with 43 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -220,9 +220,11 @@ layoutExpr lexpr@(L _ expr) = docWrapNode lexpr $ case expr of
expDocLeft expDocLeft
(docCols ColOpPrefix [appSep $ expDocOp, docSetBaseY expDocRight]) (docCols ColOpPrefix [appSep $ expDocOp, docSetBaseY expDocRight])
] ]
NegApp{} -> do NegApp op _ -> do
-- TODO opDoc <- docSharedWrapper layoutExpr op
briDocByExact lexpr docSeq $ [ docLit $ Text.pack "-"
, opDoc
]
HsPar innerExp -> do HsPar innerExp -> do
innerExpDoc <- docSharedWrapper layoutExpr innerExp innerExpDoc <- docSharedWrapper layoutExpr innerExp
docAlt docAlt
@ -401,11 +403,11 @@ layoutExpr lexpr@(L _ expr) = docWrapNode lexpr $ case expr of
, docLines , docLines
[ docAddBaseY BrIndentRegular [ docAddBaseY BrIndentRegular
$ docPar $ docPar
(appSep $ docLit $ Text.pack "let") (docLit $ Text.pack "let")
(docSetIndentLevel $ docLines $ return <$> bindDocs) (docSetIndentLevel $ docLines $ return <$> bindDocs)
, docAddBaseY BrIndentRegular , docAddBaseY BrIndentRegular
$ docPar $ docPar
(appSep $ docLit $ Text.pack "in") (docLit $ Text.pack "in")
(docSetIndentLevel $ expDoc1) (docSetIndentLevel $ expDoc1)
] ]
] ]
@ -504,10 +506,16 @@ layoutExpr lexpr@(L _ expr) = docWrapNode lexpr $ case expr of
] ]
Nothing -> docEmpty Nothing -> docEmpty
] ]
lineN = docLit $ Text.pack "}" lineN = docSeq
[ docNodeAnnKW lexpr (Just AnnOpenC) docEmpty
, docLit $ Text.pack "}"
]
in [line1] ++ lineR ++ [lineN]) in [line1] ++ lineR ++ [lineN])
-- TODO oneliner (?) -- TODO oneliner (?)
] ]
RecordCon lname _ _ (HsRecFields [] (Just 0)) -> do
let t = lrdrNameToText lname
docWrapNode lname $ docLit $ t <> Text.pack " {..}"
RecordCon{} -> RecordCon{} ->
unknownNodeError "RecordCon with puns" lexpr unknownNodeError "RecordCon with puns" lexpr
RecordUpd rExpr [] _ _ _ _ -> do RecordUpd rExpr [] _ _ _ _ -> do
@ -527,12 +535,13 @@ layoutExpr lexpr@(L _ expr) = docWrapNode lexpr $ case expr of
-- singleline -- singleline
[ docSetParSpacing [ docSetParSpacing
$ docSeq $ docSeq
[ appSep rExprDoc [ docNodeAnnKW lexpr Nothing $ appSep rExprDoc
, appSep $ docLit $ Text.pack "{" , appSep $ docLit $ Text.pack "{"
, appSep $ docSeq $ List.intersperse docCommaSep , appSep $ docSeq $ List.intersperse docCommaSep
$ rFs <&> \case $ rFs <&> \case
(lfield, fieldStr, Just fieldDoc) -> (lfield, fieldStr, Just fieldDoc) ->
docSeq [ appSep $ docWrapNode lfield $ docLit fieldStr docWrapNode lfield $ docSeq
[ appSep $ docLit fieldStr
, appSep $ docLit $ Text.pack "=" , appSep $ docLit $ Text.pack "="
, docForceSingleline fieldDoc , docForceSingleline fieldDoc
] ]
@ -542,54 +551,61 @@ layoutExpr lexpr@(L _ expr) = docWrapNode lexpr $ case expr of
] ]
-- wild-indentation block -- wild-indentation block
, docSeq , docSeq
[ appSep rExprDoc [ docNodeAnnKW lexpr Nothing $ appSep rExprDoc
, docSetBaseY $ docLines $ let , docSetBaseY $ docLines $ let
line1 = docCols ColRecUpdate line1 = docCols ColRecUpdate
[ appSep $ docLit $ Text.pack "{" [ appSep $ docLit $ Text.pack "{"
, appSep $ docLit $ rF1n , appSep $ docLit $ rF1n
, case rF1e of , case rF1e of
Just x -> docSeq [ appSep $ docLit $ Text.pack "=" Just x -> docWrapNode rF1f $ docSeq
[ appSep $ docLit $ Text.pack "="
, docForceSingleline $ x , docForceSingleline $ x
] ]
Nothing -> docEmpty Nothing -> docEmpty
] ]
lineR = rFr <&> \(lfield, fText, fDoc) -> docCols ColRecUpdate lineR = rFr <&> \(lfield, fText, fDoc) -> docWrapNode lfield $ docCols ColRecUpdate
[ appSep $ docLit $ Text.pack "," [ appSep $ docLit $ Text.pack ","
, appSep $ docWrapNode lfield $ docLit $ fText , appSep $ docLit $ fText
, case fDoc of , case fDoc of
Just x -> docSeq [ appSep $ docLit $ Text.pack "=" Just x -> docSeq [ appSep $ docLit $ Text.pack "="
, docForceSingleline x , docForceSingleline x
] ]
Nothing -> docEmpty Nothing -> docEmpty
] ]
lineN = docLit $ Text.pack "}" lineN = docSeq
[ docNodeAnnKW lexpr (Just AnnOpenC) docEmpty
, docLit $ Text.pack "}"
]
in [line1] ++ lineR ++ [lineN] in [line1] ++ lineR ++ [lineN]
] ]
-- strict indentation block -- strict indentation block
, docSetParSpacing , docSetParSpacing
$ docAddBaseY BrIndentRegular $ docAddBaseY BrIndentRegular
$ docPar $ docPar
rExprDoc (docNodeAnnKW lexpr Nothing $ rExprDoc)
(docNonBottomSpacing $ docLines $ let (docNonBottomSpacing $ docLines $ let
line1 = docCols ColRecUpdate line1 = docWrapNode rF1f $ docCols ColRecUpdate
[ appSep $ docLit $ Text.pack "{" [ appSep $ docLit $ Text.pack "{"
, appSep $ docWrapNode rF1f $ docLit $ rF1n , appSep $ docLit $ rF1n
, case rF1e of , case rF1e of
Just x -> docSeq [ appSep $ docLit $ Text.pack "=" Just x -> docSeq [ appSep $ docLit $ Text.pack "="
, docAddBaseY BrIndentRegular $ x , docAddBaseY BrIndentRegular $ x
] ]
Nothing -> docEmpty Nothing -> docEmpty
] ]
lineR = rFr <&> \(lfield, fText, fDoc) -> docCols ColRecUpdate lineR = rFr <&> \(lfield, fText, fDoc) -> docWrapNode lfield $ docCols ColRecUpdate
[ appSep $ docLit $ Text.pack "," [ appSep $ docLit $ Text.pack ","
, appSep $ docWrapNode lfield $ docLit $ fText , appSep $ docLit $ fText
, case fDoc of , case fDoc of
Just x -> docSeq [ appSep $ docLit $ Text.pack "=" Just x -> docSeq [ appSep $ docLit $ Text.pack "="
, docAddBaseY BrIndentRegular x , docAddBaseY BrIndentRegular x
] ]
Nothing -> docEmpty Nothing -> docEmpty
] ]
lineN = docLit $ Text.pack "}" lineN = docSeq
[ docNodeAnnKW lexpr (Just AnnOpenC) docEmpty
, docLit $ Text.pack "}"
]
in [line1] ++ lineR ++ [lineN]) in [line1] ++ lineR ++ [lineN])
] ]
ExprWithTySig exp1 (HsIB _ (HsWC _ _ typ1)) -> do ExprWithTySig exp1 (HsIB _ (HsWC _ _ typ1)) -> do

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

@ -236,14 +236,17 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
let shouldForceML = case typ2 of let shouldForceML = case typ2 of
(L _ HsFunTy{}) -> True (L _ HsFunTy{}) -> True
_ -> False _ -> False
docAlt hasComments <- hasAnyCommentsBelow ltype
docAlt $
[ docSeq [ docSeq
[ docForceSingleline typeDoc1 [ appSep $ docForceSingleline typeDoc1
, docWrapNodeRest ltype $ appSep $ docLit $ Text.pack " ->" , appSep $ docLit $ Text.pack "->"
, docForceSingleline typeDoc2 , docForceSingleline typeDoc2
] ]
, docPar | not hasComments
typeDoc1 ] ++
[ docPar
(docNodeAnnKW ltype Nothing typeDoc1)
( docCols ColTyOpPrefix ( docCols ColTyOpPrefix
[ docWrapNodeRest ltype $ appSep $ docLit $ Text.pack "->" [ docWrapNodeRest ltype $ appSep $ docLit $ Text.pack "->"
, docAddBaseY (BrIndentSpecial 3) , docAddBaseY (BrIndentSpecial 3)