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

Fix spacing bugs, Clean up implemenation 

- Normalize spaces on type alias lhs. unnecessary spaces were
  retained previously, e.g.
  "type   (   (   a  :%:   b   ) c   ) = (a , c)"
  had non-optimal output
- Clean up separator usage
- Remove backend hacks (to some degree)
- Minor reformatting and premature optimization
pull/189/head
Lennart Spitzner 2018-10-27 16:04:57 +02:00
parent e7d8b5f1ab
commit ad5868eb76
3 changed files with 46 additions and 54 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
src/Language/Haskell/Brittany/Internal/Backend.hs
View File

@ -172,11 +172,13 @@ layoutBriDocM = \case
priors
`forM_` \(ExactPrint.Types.Comment comment _ _, ExactPrint.Types.DP (y, x)) ->
do
-- evil hack for CPP:
case comment of
('#':_) -> layoutMoveToCommentPos y (-999)
-- ^ evil hack for CPP
"(" -> pure ()
")" -> layoutMoveToCommentPosX (x - 1)
")" -> pure ()
-- ^ these two fix the formatting of parens
-- on the lhs of type alias defs
_ -> layoutMoveToCommentPos y x
-- fixedX <- fixMoveToLineByIsNewline x
-- replicateM_ fixedX layoutWriteNewline
@ -245,10 +247,12 @@ layoutBriDocM = \case
Just comments -> do
comments `forM_` \(ExactPrint.Types.Comment comment _ _, ExactPrint.Types.DP (y, x)) ->
do
-- evil hack for CPP:
case comment of
('#':_) -> layoutMoveToCommentPos y (-999)
")" -> layoutMoveToCommentPosX (x - 1)
-- ^ evil hack for CPP
")" -> pure ()
-- ^ fixes the formatting of parens
-- on the lhs of type alias defs
_ -> layoutMoveToCommentPos y x
-- fixedX <- fixMoveToLineByIsNewline x
-- replicateM_ fixedX layoutWriteNewline

23
src/Language/Haskell/Brittany/Internal/BackendUtils.hs
View File

@ -26,7 +26,6 @@ module Language.Haskell.Brittany.Internal.BackendUtils
, layoutAddSepSpace
, layoutSetCommentCol
, layoutMoveToCommentPos
, layoutMoveToCommentPosX
, layoutIndentRestorePostComment
, moveToExactAnn
, ppmMoveToExactLoc
@ -189,30 +188,20 @@ layoutMoveToCommentPos y x = do
{ _lstate_curYOrAddNewline = case _lstate_curYOrAddNewline state of
Left i -> if y == 0 then Left i else Right y
Right{} -> Right y
, _lstate_addSepSpace = if Data.Maybe.isJust (_lstate_commentCol state)
then Just $ case _lstate_curYOrAddNewline state of
, _lstate_addSepSpace =
Just $ if Data.Maybe.isJust (_lstate_commentCol state)
then case _lstate_curYOrAddNewline state of
Left{} -> if y == 0 then x else _lstate_indLevelLinger state + x
Right{} -> _lstate_indLevelLinger state + x
else Just $ if y == 0 then x else _lstate_indLevelLinger state + x
, _lstate_commentCol = Just $ case _lstate_commentCol state of
else if y == 0 then x else _lstate_indLevelLinger state + x
, _lstate_commentCol =
Just $ case _lstate_commentCol state of
Just existing -> existing
Nothing -> case _lstate_curYOrAddNewline state of
Left i -> i + fromMaybe 0 (_lstate_addSepSpace state)
Right{} -> lstate_baseY state
}
layoutMoveToCommentPosX
:: ( MonadMultiWriter Text.Builder.Builder m
, MonadMultiState LayoutState m
, MonadMultiWriter (Seq String) m
)
=> Int
-> m ()
layoutMoveToCommentPosX x = do
traceLocal ("layoutMoveToCommentPosX", x)
state <- mGet
mSet state { _lstate_addSepSpace = Just $ _lstate_indLevelLinger state + x }
-- | does _not_ add spaces to again reach the current base column.
layoutWriteNewline
:: ( MonadMultiWriter Text.Builder.Builder m

49
src/Language/Haskell/Brittany/Internal/Layouters/Decl.hs
View File

@ -659,46 +659,45 @@ layoutSynDecl isInfix wrapNodeRest name vars typ = do
-- This isn't quite right, but does give syntactically valid results
let needsParens = not $ null rest || hasOwnParens
docSeq
$ [ appSep $ docLit $ Text.pack "type"
, appSep
. docSeq
$ [ docParenL | needsParens ]
++ [ appSep $ layoutTyVarBndr a
, appSep $ docLit nameStr
, layoutTyVarBndr b
$ [ docLit $ Text.pack "type"
, docSeparator
]
++ [ docParenL | needsParens ]
++ [ layoutTyVarBndr False a
, docSeparator
, docLit nameStr
, docSeparator
, layoutTyVarBndr False b
]
++ [ docParenR | needsParens ]
]
++ fmap (appSep . layoutTyVarBndr) rest
++ fmap (layoutTyVarBndr True) rest
else
docSeq
$ [ appSep $ docLit $ Text.pack "type"
, appSep $ docWrapNode name $ docLit nameStr
$ [ docLit $ Text.pack "type"
, docSeparator
, docWrapNode name $ docLit nameStr
]
++ fmap (appSep . layoutTyVarBndr) vars
++ fmap (layoutTyVarBndr True) vars
sharedLhs <- docSharedWrapper id lhs
typeDoc <- docSharedWrapper layoutType typ
hasComments <- hasAnyCommentsConnected typ
docAlt
$ [ docSeq
[lhs, appSep $ docLit $ Text.pack "=", docForceSingleline typeDoc]
| not hasComments
]
++ [ docAddBaseY BrIndentRegular $ docPar
lhs
runFilteredAlternative $ do
addAlternativeCond (not hasComments) $ docSeq
[sharedLhs, appSep $ docLit $ Text.pack "=", docForceSingleline typeDoc]
addAlternative $ docAddBaseY BrIndentRegular $ docPar
sharedLhs
(docCols ColTyOpPrefix [appSep $ docLit $ Text.pack "=", typeDoc])
]
layoutTyVarBndr :: ToBriDoc HsTyVarBndr
layoutTyVarBndr lbndr@(L _ bndr) = do
needsPriorSpace <- hasAnnKeywordComment lbndr AnnCloseP
layoutTyVarBndr :: Bool -> ToBriDoc HsTyVarBndr
layoutTyVarBndr needsSep lbndr@(L _ bndr) = do
docWrapNodePrior lbndr $ case bndr of
UserTyVar name -> do
nameStr <- lrdrNameToTextAnn name
docSeq $ [ docSeparator | needsPriorSpace ] ++ [docLit nameStr]
docSeq $ [docSeparator | needsSep] ++ [docLit nameStr]
KindedTyVar name kind -> do
nameStr <- lrdrNameToTextAnn name
docSeq
$ [ docSeparator | needsPriorSpace ]
$ [ docSeparator | needsSep ]
++ [ docLit $ Text.pack "("
, appSep $ docLit nameStr
, appSep . docLit $ Text.pack "::"