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

Fix newline issue on comments before where

pull/279/head
Lennart Spitzner 2020-01-11 23:19:04 +01:00
parent 2b303b2a20
commit 128dd828c2
4 changed files with 36 additions and 40 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
src-literatetests/15-regressions.blt
View File

@ -798,3 +798,7 @@ zItazySunefp twgq nlyo lwojjoBiecao =
$ XojlsTOSR.jpwuPmafuDqlbkt (uwurrvoNnukzefuDjeh lwojjoBiecao nlyo)
$ etOslnoz lwojjoBiecao
in kucotg $ (bbbr, Yoxe.Dwzbuzi.zrLokoTnuy piv)
#test module initial comment
-- test
module MyModule where

20
src/Language/Haskell/Brittany/Internal.hs
View File

@ -520,7 +520,7 @@ ppPreamble lmod@(L loc m@(HsModule _ _ _ _ _ _)) = do
let
(filteredAnns', post) =
case (ExactPrint.mkAnnKey lmod) `Map.lookup` filteredAnns of
case Map.lookup (ExactPrint.mkAnnKey lmod) filteredAnns of
Nothing -> (filteredAnns, [])
Just mAnn ->
let
@ -536,23 +536,7 @@ ppPreamble lmod@(L loc m@(HsModule _ _ _ _ _ _)) = do
(Just i , Nothing) -> List.splitAt (i + 1) modAnnsDp
(Nothing, Just _i) -> ([], modAnnsDp)
(Just i , Just j ) -> List.splitAt (min (i + 1) j) modAnnsDp
findInitialCommentSize = \case
((ExactPrint.AnnComment cm, ExactPrint.DP (y, _)) : rest) ->
let GHC.RealSrcSpan span = ExactPrint.commentIdentifier cm
in y
+ GHC.srcSpanEndLine span
- GHC.srcSpanStartLine span
+ findInitialCommentSize rest
_ -> 0
initialCommentSize = findInitialCommentSize pre
fixAbsoluteModuleDP = \case
(g@(ExactPrint.G AnnModule), ExactPrint.DP (y, x)) ->
(g, ExactPrint.DP (y - initialCommentSize, x))
x -> x
pre' = if shouldReformatPreamble
then map fixAbsoluteModuleDP pre
else pre
mAnn' = mAnn { ExactPrint.annsDP = pre' }
mAnn' = mAnn { ExactPrint.annsDP = pre }
filteredAnns'' =
Map.insert (ExactPrint.mkAnnKey lmod) mAnn' filteredAnns
in

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

@ -174,14 +174,15 @@ layoutBriDocM = \case
priors
`forM_` \(ExactPrint.Types.Comment comment _ _, ExactPrint.Types.DP (y, x)) ->
when (not $ comment == "(" || comment == ")") $ do
let commentLines = Text.lines $ Text.pack $ comment
case comment of
('#':_) -> layoutMoveToCommentPos y (-999)
('#':_) -> layoutMoveToCommentPos y (-999) (length commentLines)
-- ^ evil hack for CPP
_ -> layoutMoveToCommentPos y x
_ -> layoutMoveToCommentPos y x (length commentLines)
-- fixedX <- fixMoveToLineByIsNewline x
-- replicateM_ fixedX layoutWriteNewline
-- layoutMoveToIndentCol y
layoutWriteAppendMultiline $ Text.pack $ comment
layoutWriteAppendMultiline commentLines
-- mModify $ \s -> s { _lstate_curYOrAddNewline = Right 0 }
when allowMTEL $ moveToExactAnn annKey
layoutBriDocM bd
@ -214,14 +215,15 @@ layoutBriDocM = \case
Just comments -> do
comments `forM_` \(ExactPrint.Types.Comment comment _ _, ExactPrint.Types.DP (y, x)) ->
when (not $ comment == "(" || comment == ")") $ do
let commentLines = Text.lines $ Text.pack $ comment
-- evil hack for CPP:
case comment of
('#':_) -> layoutMoveToCommentPos y (-999)
_ -> layoutMoveToCommentPos y x
('#':_) -> layoutMoveToCommentPos y (-999) (length commentLines)
_ -> layoutMoveToCommentPos y x (length commentLines)
-- fixedX <- fixMoveToLineByIsNewline x
-- replicateM_ fixedX layoutWriteNewline
-- layoutMoveToIndentCol y
layoutWriteAppendMultiline $ Text.pack $ comment
layoutWriteAppendMultiline commentLines
-- mModify $ \s -> s { _lstate_curYOrAddNewline = Right 0 }
BDAnnotationRest annKey bd -> do
layoutBriDocM bd
@ -256,17 +258,18 @@ layoutBriDocM = \case
Just comments -> do
comments `forM_` \(ExactPrint.Types.Comment comment _ _, ExactPrint.Types.DP (y, x)) ->
when (not $ comment == "(" || comment == ")") $ do
let commentLines = Text.lines $ Text.pack comment
case comment of
('#':_) -> layoutMoveToCommentPos y (-999)
('#':_) -> layoutMoveToCommentPos y (-999) 1
-- ^ evil hack for CPP
")" -> pure ()
-- ^ fixes the formatting of parens
-- on the lhs of type alias defs
_ -> layoutMoveToCommentPos y x
_ -> layoutMoveToCommentPos y x (length commentLines)
-- fixedX <- fixMoveToLineByIsNewline x
-- replicateM_ fixedX layoutWriteNewline
-- layoutMoveToIndentCol y
layoutWriteAppendMultiline $ Text.pack $ comment
layoutWriteAppendMultiline commentLines
-- mModify $ \s -> s { _lstate_curYOrAddNewline = Right 0 }
BDMoveToKWDP annKey keyword shouldRestoreIndent bd -> do
mDP <- do
@ -278,7 +281,7 @@ layoutBriDocM = \case
, (ExactPrint.Types.G kw1, dp) <- ann
, keyword == kw1
]
-- mTell $ Seq.fromList ["KWDP: " ++ show annKey ++ " " ++ show mAnn]
-- mTell $ Seq.fromList [show keyword, "KWDP: " ++ show annKey ++ " " ++ show mAnn, show relevant]
case relevant of
[] -> pure Nothing
(ExactPrint.Types.DP (y, x):_) -> do
@ -289,7 +292,7 @@ layoutBriDocM = \case
Just (y, x) ->
-- we abuse this, as we probably will print the KW next, which is
-- _not_ a comment..
layoutMoveToCommentPos y (if shouldRestoreIndent then x else 0)
layoutMoveToCommentPos y (if shouldRestoreIndent then x else 0) 1
layoutBriDocM bd
BDNonBottomSpacing _ bd -> layoutBriDocM bd
BDSetParSpacing bd -> layoutBriDocM bd

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

@ -122,12 +122,12 @@ layoutWriteAppendMultiline
, MonadMultiState LayoutState m
, MonadMultiWriter (Seq String) m
)
=> Text
=> [Text]
-> m ()
layoutWriteAppendMultiline t = do
traceLocal ("layoutWriteAppendMultiline", t)
case Text.lines t of
[] -> layoutWriteAppend t -- need to write empty, too.
layoutWriteAppendMultiline ts = do
traceLocal ("layoutWriteAppendMultiline", ts)
case ts of
[] -> layoutWriteAppend (Text.pack "") -- need to write empty, too.
(l:lr) -> do
layoutWriteAppend l
lr `forM_` \x -> do
@ -182,9 +182,10 @@ layoutMoveToCommentPos
)
=> Int
-> Int
-> Int
-> m ()
layoutMoveToCommentPos y x = do
traceLocal ("layoutMoveToCommentPos", y, x)
layoutMoveToCommentPos y x commentLines = do
traceLocal ("layoutMoveToCommentPos", y, x, commentLines)
state <- mGet
mSet state
{ _lstate_curYOrAddNewline = case _lstate_curYOrAddNewline state of
@ -202,7 +203,8 @@ layoutMoveToCommentPos y x = do
Nothing -> case _lstate_curYOrAddNewline state of
Left i -> i + fromMaybe 0 (_lstate_addSepSpace state)
Right{} -> lstate_baseY state
, _lstate_commentNewlines = _lstate_commentNewlines state + y
, _lstate_commentNewlines =
_lstate_commentNewlines state + y + commentLines - 1
}
-- | does _not_ add spaces to again reach the current base column.
@ -220,9 +222,12 @@ layoutWriteNewline = do
Left{} -> Right 1
Right i -> Right (i + 1)
, _lstate_addSepSpace = Nothing
, _lstate_commentNewlines = 0
}
_layoutResetCommentNewlines :: MonadMultiState LayoutState m => m ()
_layoutResetCommentNewlines = do
mModify $ \state -> state { _lstate_commentNewlines = 0 }
layoutWriteEnsureNewlineBlock
:: ( MonadMultiWriter Text.Builder.Builder m
, MonadMultiState LayoutState m
@ -526,7 +531,7 @@ layoutWritePriorComments ast = do
) -> do
replicateM_ x layoutWriteNewline
layoutWriteAppendSpaces y
layoutWriteAppendMultiline $ Text.pack $ comment
layoutWriteAppendMultiline $ Text.lines $ Text.pack comment
-- TODO: update and use, or clean up. Currently dead code.
-- this currently only extracs from the `annsDP` field of Annotations.
@ -563,7 +568,7 @@ layoutWritePostComments ast = do
replicateM_ x layoutWriteNewline
layoutWriteAppend $ Text.pack $ replicate y ' '
mModify $ \s -> s { _lstate_addSepSpace = Nothing }
layoutWriteAppendMultiline $ Text.pack $ comment
layoutWriteAppendMultiline $ Text.lines $ Text.pack $ comment
layoutIndentRestorePostComment
:: ( MonadMultiState LayoutState m