diff --git a/src-literatetests/15-regressions.blt b/src-literatetests/15-regressions.blt index 21eaf3d..c61bb78 100644 --- a/src-literatetests/15-regressions.blt +++ b/src-literatetests/15-regressions.blt @@ -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 diff --git a/src/Language/Haskell/Brittany/Internal.hs b/src/Language/Haskell/Brittany/Internal.hs index e98c0fc..3fca4a1 100644 --- a/src/Language/Haskell/Brittany/Internal.hs +++ b/src/Language/Haskell/Brittany/Internal.hs @@ -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 diff --git a/src/Language/Haskell/Brittany/Internal/Backend.hs b/src/Language/Haskell/Brittany/Internal/Backend.hs index 2516f81..3d29218 100644 --- a/src/Language/Haskell/Brittany/Internal/Backend.hs +++ b/src/Language/Haskell/Brittany/Internal/Backend.hs @@ -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 diff --git a/src/Language/Haskell/Brittany/Internal/BackendUtils.hs b/src/Language/Haskell/Brittany/Internal/BackendUtils.hs index 2398508..2531794 100644 --- a/src/Language/Haskell/Brittany/Internal/BackendUtils.hs +++ b/src/Language/Haskell/Brittany/Internal/BackendUtils.hs @@ -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