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 optimizationpull/189/head
parent
e7d8b5f1ab
commit
ad5868eb76
|
@ -172,11 +172,13 @@ layoutBriDocM = \case
|
||||||
priors
|
priors
|
||||||
`forM_` \(ExactPrint.Types.Comment comment _ _, ExactPrint.Types.DP (y, x)) ->
|
`forM_` \(ExactPrint.Types.Comment comment _ _, ExactPrint.Types.DP (y, x)) ->
|
||||||
do
|
do
|
||||||
-- evil hack for CPP:
|
|
||||||
case comment of
|
case comment of
|
||||||
('#':_) -> layoutMoveToCommentPos y (-999)
|
('#':_) -> layoutMoveToCommentPos y (-999)
|
||||||
|
-- ^ evil hack for CPP
|
||||||
"(" -> pure ()
|
"(" -> pure ()
|
||||||
")" -> layoutMoveToCommentPosX (x - 1)
|
")" -> pure ()
|
||||||
|
-- ^ these two fix the formatting of parens
|
||||||
|
-- on the lhs of type alias defs
|
||||||
_ -> layoutMoveToCommentPos y x
|
_ -> layoutMoveToCommentPos y x
|
||||||
-- fixedX <- fixMoveToLineByIsNewline x
|
-- fixedX <- fixMoveToLineByIsNewline x
|
||||||
-- replicateM_ fixedX layoutWriteNewline
|
-- replicateM_ fixedX layoutWriteNewline
|
||||||
|
@ -245,10 +247,12 @@ layoutBriDocM = \case
|
||||||
Just comments -> do
|
Just comments -> do
|
||||||
comments `forM_` \(ExactPrint.Types.Comment comment _ _, ExactPrint.Types.DP (y, x)) ->
|
comments `forM_` \(ExactPrint.Types.Comment comment _ _, ExactPrint.Types.DP (y, x)) ->
|
||||||
do
|
do
|
||||||
-- evil hack for CPP:
|
|
||||||
case comment of
|
case comment of
|
||||||
('#':_) -> layoutMoveToCommentPos y (-999)
|
('#':_) -> 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
|
_ -> layoutMoveToCommentPos y x
|
||||||
-- fixedX <- fixMoveToLineByIsNewline x
|
-- fixedX <- fixMoveToLineByIsNewline x
|
||||||
-- replicateM_ fixedX layoutWriteNewline
|
-- replicateM_ fixedX layoutWriteNewline
|
||||||
|
|
|
@ -26,7 +26,6 @@ module Language.Haskell.Brittany.Internal.BackendUtils
|
||||||
, layoutAddSepSpace
|
, layoutAddSepSpace
|
||||||
, layoutSetCommentCol
|
, layoutSetCommentCol
|
||||||
, layoutMoveToCommentPos
|
, layoutMoveToCommentPos
|
||||||
, layoutMoveToCommentPosX
|
|
||||||
, layoutIndentRestorePostComment
|
, layoutIndentRestorePostComment
|
||||||
, moveToExactAnn
|
, moveToExactAnn
|
||||||
, ppmMoveToExactLoc
|
, ppmMoveToExactLoc
|
||||||
|
@ -189,30 +188,20 @@ layoutMoveToCommentPos y x = do
|
||||||
{ _lstate_curYOrAddNewline = case _lstate_curYOrAddNewline state of
|
{ _lstate_curYOrAddNewline = case _lstate_curYOrAddNewline state of
|
||||||
Left i -> if y == 0 then Left i else Right y
|
Left i -> if y == 0 then Left i else Right y
|
||||||
Right{} -> Right y
|
Right{} -> Right y
|
||||||
, _lstate_addSepSpace = if Data.Maybe.isJust (_lstate_commentCol state)
|
, _lstate_addSepSpace =
|
||||||
then Just $ case _lstate_curYOrAddNewline state of
|
Just $ if Data.Maybe.isJust (_lstate_commentCol state)
|
||||||
Left{} -> if y == 0 then x else _lstate_indLevelLinger state + x
|
then case _lstate_curYOrAddNewline state of
|
||||||
Right{} -> _lstate_indLevelLinger state + x
|
Left{} -> if y == 0 then x else _lstate_indLevelLinger state + x
|
||||||
else Just $ if y == 0 then x else _lstate_indLevelLinger state + x
|
Right{} -> _lstate_indLevelLinger state + x
|
||||||
, _lstate_commentCol = Just $ case _lstate_commentCol state of
|
else if y == 0 then x else _lstate_indLevelLinger state + x
|
||||||
Just existing -> existing
|
, _lstate_commentCol =
|
||||||
Nothing -> case _lstate_curYOrAddNewline state of
|
Just $ case _lstate_commentCol state of
|
||||||
Left i -> i + fromMaybe 0 (_lstate_addSepSpace state)
|
Just existing -> existing
|
||||||
Right{} -> lstate_baseY state
|
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.
|
-- | does _not_ add spaces to again reach the current base column.
|
||||||
layoutWriteNewline
|
layoutWriteNewline
|
||||||
:: ( MonadMultiWriter Text.Builder.Builder m
|
:: ( MonadMultiWriter Text.Builder.Builder m
|
||||||
|
|
|
@ -659,46 +659,45 @@ layoutSynDecl isInfix wrapNodeRest name vars typ = do
|
||||||
-- This isn't quite right, but does give syntactically valid results
|
-- This isn't quite right, but does give syntactically valid results
|
||||||
let needsParens = not $ null rest || hasOwnParens
|
let needsParens = not $ null rest || hasOwnParens
|
||||||
docSeq
|
docSeq
|
||||||
$ [ appSep $ docLit $ Text.pack "type"
|
$ [ docLit $ Text.pack "type"
|
||||||
, appSep
|
, docSeparator
|
||||||
. docSeq
|
|
||||||
$ [ docParenL | needsParens ]
|
|
||||||
++ [ appSep $ layoutTyVarBndr a
|
|
||||||
, appSep $ docLit nameStr
|
|
||||||
, layoutTyVarBndr b
|
|
||||||
]
|
|
||||||
++ [ docParenR | needsParens ]
|
|
||||||
]
|
]
|
||||||
++ fmap (appSep . layoutTyVarBndr) rest
|
++ [ docParenL | needsParens ]
|
||||||
|
++ [ layoutTyVarBndr False a
|
||||||
|
, docSeparator
|
||||||
|
, docLit nameStr
|
||||||
|
, docSeparator
|
||||||
|
, layoutTyVarBndr False b
|
||||||
|
]
|
||||||
|
++ [ docParenR | needsParens ]
|
||||||
|
++ fmap (layoutTyVarBndr True) rest
|
||||||
else
|
else
|
||||||
docSeq
|
docSeq
|
||||||
$ [ appSep $ docLit $ Text.pack "type"
|
$ [ docLit $ Text.pack "type"
|
||||||
, appSep $ docWrapNode name $ docLit nameStr
|
, docSeparator
|
||||||
|
, docWrapNode name $ docLit nameStr
|
||||||
]
|
]
|
||||||
++ fmap (appSep . layoutTyVarBndr) vars
|
++ fmap (layoutTyVarBndr True) vars
|
||||||
|
sharedLhs <- docSharedWrapper id lhs
|
||||||
typeDoc <- docSharedWrapper layoutType typ
|
typeDoc <- docSharedWrapper layoutType typ
|
||||||
hasComments <- hasAnyCommentsConnected typ
|
hasComments <- hasAnyCommentsConnected typ
|
||||||
docAlt
|
runFilteredAlternative $ do
|
||||||
$ [ docSeq
|
addAlternativeCond (not hasComments) $ docSeq
|
||||||
[lhs, appSep $ docLit $ Text.pack "=", docForceSingleline typeDoc]
|
[sharedLhs, appSep $ docLit $ Text.pack "=", docForceSingleline typeDoc]
|
||||||
| not hasComments
|
addAlternative $ docAddBaseY BrIndentRegular $ docPar
|
||||||
]
|
sharedLhs
|
||||||
++ [ docAddBaseY BrIndentRegular $ docPar
|
(docCols ColTyOpPrefix [appSep $ docLit $ Text.pack "=", typeDoc])
|
||||||
lhs
|
|
||||||
(docCols ColTyOpPrefix [appSep $ docLit $ Text.pack "=", typeDoc])
|
|
||||||
]
|
|
||||||
|
|
||||||
layoutTyVarBndr :: ToBriDoc HsTyVarBndr
|
layoutTyVarBndr :: Bool -> ToBriDoc HsTyVarBndr
|
||||||
layoutTyVarBndr lbndr@(L _ bndr) = do
|
layoutTyVarBndr needsSep lbndr@(L _ bndr) = do
|
||||||
needsPriorSpace <- hasAnnKeywordComment lbndr AnnCloseP
|
|
||||||
docWrapNodePrior lbndr $ case bndr of
|
docWrapNodePrior lbndr $ case bndr of
|
||||||
UserTyVar name -> do
|
UserTyVar name -> do
|
||||||
nameStr <- lrdrNameToTextAnn name
|
nameStr <- lrdrNameToTextAnn name
|
||||||
docSeq $ [ docSeparator | needsPriorSpace ] ++ [docLit nameStr]
|
docSeq $ [docSeparator | needsSep] ++ [docLit nameStr]
|
||||||
KindedTyVar name kind -> do
|
KindedTyVar name kind -> do
|
||||||
nameStr <- lrdrNameToTextAnn name
|
nameStr <- lrdrNameToTextAnn name
|
||||||
docSeq
|
docSeq
|
||||||
$ [ docSeparator | needsPriorSpace ]
|
$ [ docSeparator | needsSep ]
|
||||||
++ [ docLit $ Text.pack "("
|
++ [ docLit $ Text.pack "("
|
||||||
, appSep $ docLit nameStr
|
, appSep $ docLit nameStr
|
||||||
, appSep . docLit $ Text.pack "::"
|
, appSep . docLit $ Text.pack "::"
|
||||||
|
|
Loading…
Reference in New Issue