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) $ XojlsTOSR.jpwuPmafuDqlbkt (uwurrvoNnukzefuDjeh lwojjoBiecao nlyo)
$ etOslnoz lwojjoBiecao $ etOslnoz lwojjoBiecao
in kucotg $ (bbbr, Yoxe.Dwzbuzi.zrLokoTnuy piv) 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 let
(filteredAnns', post) = (filteredAnns', post) =
case (ExactPrint.mkAnnKey lmod) `Map.lookup` filteredAnns of case Map.lookup (ExactPrint.mkAnnKey lmod) filteredAnns of
Nothing -> (filteredAnns, []) Nothing -> (filteredAnns, [])
Just mAnn -> Just mAnn ->
let let
@ -536,23 +536,7 @@ ppPreamble lmod@(L loc m@(HsModule _ _ _ _ _ _)) = do
(Just i , Nothing) -> List.splitAt (i + 1) modAnnsDp (Just i , Nothing) -> List.splitAt (i + 1) modAnnsDp
(Nothing, Just _i) -> ([], modAnnsDp) (Nothing, Just _i) -> ([], modAnnsDp)
(Just i , Just j ) -> List.splitAt (min (i + 1) j) modAnnsDp (Just i , Just j ) -> List.splitAt (min (i + 1) j) modAnnsDp
findInitialCommentSize = \case mAnn' = mAnn { ExactPrint.annsDP = pre }
((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' }
filteredAnns'' = filteredAnns'' =
Map.insert (ExactPrint.mkAnnKey lmod) mAnn' filteredAnns Map.insert (ExactPrint.mkAnnKey lmod) mAnn' filteredAnns
in in

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

@ -174,14 +174,15 @@ layoutBriDocM = \case
priors priors
`forM_` \(ExactPrint.Types.Comment comment _ _, ExactPrint.Types.DP (y, x)) -> `forM_` \(ExactPrint.Types.Comment comment _ _, ExactPrint.Types.DP (y, x)) ->
when (not $ comment == "(" || comment == ")") $ do when (not $ comment == "(" || comment == ")") $ do
let commentLines = Text.lines $ Text.pack $ comment
case comment of case comment of
('#':_) -> layoutMoveToCommentPos y (-999) ('#':_) -> layoutMoveToCommentPos y (-999) (length commentLines)
-- ^ evil hack for CPP -- ^ evil hack for CPP
_ -> layoutMoveToCommentPos y x _ -> layoutMoveToCommentPos y x (length commentLines)
-- fixedX <- fixMoveToLineByIsNewline x -- fixedX <- fixMoveToLineByIsNewline x
-- replicateM_ fixedX layoutWriteNewline -- replicateM_ fixedX layoutWriteNewline
-- layoutMoveToIndentCol y -- layoutMoveToIndentCol y
layoutWriteAppendMultiline $ Text.pack $ comment layoutWriteAppendMultiline commentLines
-- mModify $ \s -> s { _lstate_curYOrAddNewline = Right 0 } -- mModify $ \s -> s { _lstate_curYOrAddNewline = Right 0 }
when allowMTEL $ moveToExactAnn annKey when allowMTEL $ moveToExactAnn annKey
layoutBriDocM bd layoutBriDocM bd
@ -214,14 +215,15 @@ 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)) ->
when (not $ comment == "(" || comment == ")") $ do when (not $ comment == "(" || comment == ")") $ do
let commentLines = Text.lines $ Text.pack $ comment
-- evil hack for CPP: -- evil hack for CPP:
case comment of case comment of
('#':_) -> layoutMoveToCommentPos y (-999) ('#':_) -> layoutMoveToCommentPos y (-999) (length commentLines)
_ -> layoutMoveToCommentPos y x _ -> layoutMoveToCommentPos y x (length commentLines)
-- fixedX <- fixMoveToLineByIsNewline x -- fixedX <- fixMoveToLineByIsNewline x
-- replicateM_ fixedX layoutWriteNewline -- replicateM_ fixedX layoutWriteNewline
-- layoutMoveToIndentCol y -- layoutMoveToIndentCol y
layoutWriteAppendMultiline $ Text.pack $ comment layoutWriteAppendMultiline commentLines
-- mModify $ \s -> s { _lstate_curYOrAddNewline = Right 0 } -- mModify $ \s -> s { _lstate_curYOrAddNewline = Right 0 }
BDAnnotationRest annKey bd -> do BDAnnotationRest annKey bd -> do
layoutBriDocM bd layoutBriDocM bd
@ -256,17 +258,18 @@ 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)) ->
when (not $ comment == "(" || comment == ")") $ do when (not $ comment == "(" || comment == ")") $ do
let commentLines = Text.lines $ Text.pack comment
case comment of case comment of
('#':_) -> layoutMoveToCommentPos y (-999) ('#':_) -> layoutMoveToCommentPos y (-999) 1
-- ^ evil hack for CPP -- ^ evil hack for CPP
")" -> pure () ")" -> pure ()
-- ^ fixes the formatting of parens -- ^ fixes the formatting of parens
-- on the lhs of type alias defs -- on the lhs of type alias defs
_ -> layoutMoveToCommentPos y x _ -> layoutMoveToCommentPos y x (length commentLines)
-- fixedX <- fixMoveToLineByIsNewline x -- fixedX <- fixMoveToLineByIsNewline x
-- replicateM_ fixedX layoutWriteNewline -- replicateM_ fixedX layoutWriteNewline
-- layoutMoveToIndentCol y -- layoutMoveToIndentCol y
layoutWriteAppendMultiline $ Text.pack $ comment layoutWriteAppendMultiline commentLines
-- mModify $ \s -> s { _lstate_curYOrAddNewline = Right 0 } -- mModify $ \s -> s { _lstate_curYOrAddNewline = Right 0 }
BDMoveToKWDP annKey keyword shouldRestoreIndent bd -> do BDMoveToKWDP annKey keyword shouldRestoreIndent bd -> do
mDP <- do mDP <- do
@ -278,7 +281,7 @@ layoutBriDocM = \case
, (ExactPrint.Types.G kw1, dp) <- ann , (ExactPrint.Types.G kw1, dp) <- ann
, keyword == kw1 , 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 case relevant of
[] -> pure Nothing [] -> pure Nothing
(ExactPrint.Types.DP (y, x):_) -> do (ExactPrint.Types.DP (y, x):_) -> do
@ -289,7 +292,7 @@ layoutBriDocM = \case
Just (y, x) -> Just (y, x) ->
-- we abuse this, as we probably will print the KW next, which is -- we abuse this, as we probably will print the KW next, which is
-- _not_ a comment.. -- _not_ a comment..
layoutMoveToCommentPos y (if shouldRestoreIndent then x else 0) layoutMoveToCommentPos y (if shouldRestoreIndent then x else 0) 1
layoutBriDocM bd layoutBriDocM bd
BDNonBottomSpacing _ bd -> layoutBriDocM bd BDNonBottomSpacing _ bd -> layoutBriDocM bd
BDSetParSpacing 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 , MonadMultiState LayoutState m
, MonadMultiWriter (Seq String) m , MonadMultiWriter (Seq String) m
) )
=> Text => [Text]
-> m () -> m ()
layoutWriteAppendMultiline t = do layoutWriteAppendMultiline ts = do
traceLocal ("layoutWriteAppendMultiline", t) traceLocal ("layoutWriteAppendMultiline", ts)
case Text.lines t of case ts of
[] -> layoutWriteAppend t -- need to write empty, too. [] -> layoutWriteAppend (Text.pack "") -- need to write empty, too.
(l:lr) -> do (l:lr) -> do
layoutWriteAppend l layoutWriteAppend l
lr `forM_` \x -> do lr `forM_` \x -> do
@ -182,9 +182,10 @@ layoutMoveToCommentPos
) )
=> Int => Int
-> Int -> Int
-> Int
-> m () -> m ()
layoutMoveToCommentPos y x = do layoutMoveToCommentPos y x commentLines = do
traceLocal ("layoutMoveToCommentPos", y, x) traceLocal ("layoutMoveToCommentPos", y, x, commentLines)
state <- mGet state <- mGet
mSet state mSet state
{ _lstate_curYOrAddNewline = case _lstate_curYOrAddNewline state of { _lstate_curYOrAddNewline = case _lstate_curYOrAddNewline state of
@ -202,7 +203,8 @@ layoutMoveToCommentPos y x = do
Nothing -> case _lstate_curYOrAddNewline state of Nothing -> case _lstate_curYOrAddNewline state of
Left i -> i + fromMaybe 0 (_lstate_addSepSpace state) Left i -> i + fromMaybe 0 (_lstate_addSepSpace state)
Right{} -> lstate_baseY 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. -- | does _not_ add spaces to again reach the current base column.
@ -220,9 +222,12 @@ layoutWriteNewline = do
Left{} -> Right 1 Left{} -> Right 1
Right i -> Right (i + 1) Right i -> Right (i + 1)
, _lstate_addSepSpace = Nothing , _lstate_addSepSpace = Nothing
, _lstate_commentNewlines = 0
} }
_layoutResetCommentNewlines :: MonadMultiState LayoutState m => m ()
_layoutResetCommentNewlines = do
mModify $ \state -> state { _lstate_commentNewlines = 0 }
layoutWriteEnsureNewlineBlock layoutWriteEnsureNewlineBlock
:: ( MonadMultiWriter Text.Builder.Builder m :: ( MonadMultiWriter Text.Builder.Builder m
, MonadMultiState LayoutState m , MonadMultiState LayoutState m
@ -526,7 +531,7 @@ layoutWritePriorComments ast = do
) -> do ) -> do
replicateM_ x layoutWriteNewline replicateM_ x layoutWriteNewline
layoutWriteAppendSpaces y layoutWriteAppendSpaces y
layoutWriteAppendMultiline $ Text.pack $ comment layoutWriteAppendMultiline $ Text.lines $ Text.pack comment
-- TODO: update and use, or clean up. Currently dead code. -- TODO: update and use, or clean up. Currently dead code.
-- this currently only extracs from the `annsDP` field of Annotations. -- this currently only extracs from the `annsDP` field of Annotations.
@ -563,7 +568,7 @@ layoutWritePostComments ast = do
replicateM_ x layoutWriteNewline replicateM_ x layoutWriteNewline
layoutWriteAppend $ Text.pack $ replicate y ' ' layoutWriteAppend $ Text.pack $ replicate y ' '
mModify $ \s -> s { _lstate_addSepSpace = Nothing } mModify $ \s -> s { _lstate_addSepSpace = Nothing }
layoutWriteAppendMultiline $ Text.pack $ comment layoutWriteAppendMultiline $ Text.lines $ Text.pack $ comment
layoutIndentRestorePostComment layoutIndentRestorePostComment
:: ( MonadMultiState LayoutState m :: ( MonadMultiState LayoutState m