Fix block-comment delta position special case

source/library/Language/Haskell/Brittany/Internal/S3_ToBriDocTools.hs

@@ -660,7 +660,7 @@ instance ObtainAnnDeltaPos (EpAnn GHC.AnnsModule) where
       loc <- obtainAnnPos l kw <|> obtainAnnPos annList kw
       let pos = (GHC.srcLocLine loc, GHC.srcLocCol loc)
       pure $ ExactPrint.pos2delta
-        (maximum $ (0, 1) :
+        (maximum $ (1, 1) :
           [ ExactPrint.ss2posEnd $ GHC.anchor anch
           | L anch _ <- case epaComms of
             EpaCommentsBalanced cs1 cs2 -> cs1 ++ cs2

source/library/Language/Haskell/Brittany/Internal/S4_WriteBriDoc.hs

@@ -52,8 +52,8 @@ import Language.Haskell.Brittany.Internal.Components.BriDoc
 -- import Language.Haskell.Brittany.Internal.S3_ToBriDocTools
 
 
-ppBriDoc :: BriDocNumbered -> PPMLocal ()
+ppBriDoc :: BriDocNumbered -> Bool -> PPMLocal ()
-ppBriDoc briDoc = do
+ppBriDoc briDoc flush = do
   -- first step: transform the briDoc.
   briDoc' <- MultiRWSS.withMultiStateS BDEmpty $ do
     -- Note that briDoc is BriDocNumbered, but state type is BriDoc.
@@ -107,6 +107,7 @@ ppBriDoc briDoc = do
     $ MultiRWSS.withMultiStateS ([] :: [LEpaComment])
     $ do
       layoutBriDocM briDoc'
+      when flush layoutFlushLine
   case _lstate_plannedSpace state' of
     PlannedNone -> if _lstate_curY state' == 0
       then pure ()
@@ -302,21 +303,22 @@ takeBefore loc = do
 
 printComments :: LayoutConstraints m => [GHC.LEpaComment] -> m ()
 printComments comms = do
-  let addComment s anchor prior = do
+  let addComment isBlock s anchor prior = do
         case anchor of
           Anchor span UnchangedAnchor -> layoutWriteComment
             True
+            isBlock
             (ExactPrint.ss2deltaEnd prior span)
             1
             (Text.pack s)
           Anchor _span (MovedAnchor dp) ->
-            layoutWriteComment False dp 1 (Text.pack s)
+            layoutWriteComment False isBlock dp 1 (Text.pack s)
-  comms `forM_` \case
+  comms `forM_` \(L anch (EpaComment tok prior) ) -> case tok of
-    L anch (EpaComment (EpaDocCommentNext s) prior) -> addComment s anch prior
+    EpaDocCommentNext s -> addComment False s anch prior
-    L anch (EpaComment (EpaDocCommentPrev s) prior) -> addComment s anch prior
+    EpaDocCommentPrev s -> addComment False s anch prior
-    L anch (EpaComment (EpaDocCommentNamed s) prior) -> addComment s anch prior
+    EpaDocCommentNamed s -> addComment False s anch prior
-    L anch (EpaComment (EpaDocSection _ s) prior) -> addComment s anch prior
+    EpaDocSection _ s -> addComment False s anch prior
-    L anch (EpaComment (EpaDocOptions s) prior) -> addComment s anch prior
+    EpaDocOptions s -> addComment False s anch prior
-    L anch (EpaComment (EpaLineComment s) prior) -> addComment s anch prior
+    EpaLineComment s -> addComment False s anch prior
-    L anch (EpaComment (EpaBlockComment s) prior) -> addComment s anch prior
+    EpaBlockComment s -> addComment True s anch prior
-    L _anch (EpaComment (EpaEofComment) _prior) -> pure ()
+    EpaEofComment -> pure ()

source/library/Language/Haskell/Brittany/Internal/StepOrchestrate.hs

@@ -82,7 +82,7 @@ processModule traceFunc conf inlineConf parsedModule = do
                   bdMay <- ppModuleHead modHead
                   case bdMay of
                     Nothing -> pure ()
-                    Just bd -> ppBriDoc bd
+                    Just bd -> ppBriDoc bd True
                 MEPrettyModuleHead (L loc modHead) -> wrapNonDeclToBriDoc $ do
                   case modHead of
                     HsModule epAnn _layoutInfo Nothing Nothing _ _ _ _ -> do
@@ -92,7 +92,7 @@ processModule traceFunc conf inlineConf parsedModule = do
                                 docFlushRemaining
                                 (srcSpanFileName_maybe loc)
                         $ docHandleComms epAnn docSeparator
-                      ppBriDoc bd
+                      ppBriDoc bd True
                     HsModule _ _layoutInfo Nothing Just{} _ _ _ _ -> error
                       "brittany internal error: exports without module name"
                     HsModule epAnn _layoutInfo (Just n) les _ _ _ _ -> do
@@ -102,7 +102,7 @@ processModule traceFunc conf inlineConf parsedModule = do
                                 docFlushRemaining
                                 (srcSpanFileName_maybe loc)
                         $ moduleNameExportBridoc epAnn n les
-                      ppBriDoc bd
+                      ppBriDoc bd True
                 MEImportDecl importDecl immediateAfterComms ->
                   wrapNonDeclToBriDoc $ do
                     (bd, _) <-
@@ -111,7 +111,7 @@ processModule traceFunc conf inlineConf parsedModule = do
                             ( layoutImport importDecl
                             : map commentToDoc immediateAfterComms
                             )
-                    ppBriDoc bd
+                    ppBriDoc bd False
                 MEDecl decl immediateAfterComms -> do
                   let declConfig = getDeclConfig conf inlineConf decl
                   MultiRWSS.withMultiReader declConfig
@@ -225,7 +225,7 @@ ppToplevelDecl decl immediateAfterComms = do
       (r, errorCount) <- briDocMToPPM
         $ docSeq (innerDoc : map commentToDoc immediateAfterComms)
       if errorCount == 0 then pure (r, 0) else briDocMToPPM $ briDocByExact decl
-  ppBriDoc bd
+  ppBriDoc bd False
   let commCntIn = connectedCommentCount decl
   commCntOut <- mGet
   when (commCntIn /= commCntOut) $ if commCntOut < commCntIn

source/library/Language/Haskell/Brittany/Internal/ToBriDoc/Module.hs

@@ -39,7 +39,6 @@ moduleNameExportBridoc epAnn modName les = do
         Nothing                  -> id
         Just SameLine{}          -> id
         Just (DifferentLine 0 _) -> id
-        Just (DifferentLine 1 _) -> id
         Just dp                  -> docAddEntryDelta dp
   docHandleComms epAnn $ docHandleComms posModule $ runFilteredAlternative $ do
     addAlternativeCond allowSingleLine $ docSeq

source/library/Language/Haskell/Brittany/Internal/WriteBriDoc/Operators.hs

@@ -16,6 +16,7 @@ module Language.Haskell.Brittany.Internal.WriteBriDoc.Operators
   , layoutIndentLevelPop
   , layoutWriteNewline
   , layoutWriteComment
+  , layoutFlushLine
   )
 where
 
@@ -111,11 +112,12 @@ layoutWriteNewline = do
 layoutWriteComment
   :: (MonadMultiWriter Text.Builder.Builder m, MonadMultiState LayoutState m)
   => Bool
+  -> Bool
   -> GHC.DeltaPos
   -> Int
   -> Text
   -> m ()
-layoutWriteComment absolute dp commentLines s = do -- TODO92 we don't move to comment pos at all!
+layoutWriteComment absolute isBlock dp commentLines s = do -- TODO92 we don't move to comment pos at all!
   let (y, x) = case dp of
          GHC.SameLine c -> (0, c)
          GHC.DifferentLine l c -> (l, c)
@@ -124,15 +126,17 @@ layoutWriteComment absolute dp commentLines s = do -- TODO92 we don't move to co
   mTell $ Text.Builder.fromText s
   traceLocal ("layoutMoveToCommentPos", y, x, commentLines, _lstate_plannedSpace state, lstate_baseY state)
   mSet state
-    { _lstate_plannedSpace = case _lstate_plannedSpace state of
+    { _lstate_plannedSpace = if isBlock
-      PlannedNone -> PlannedDelta 1 (_lstate_curY state)
+      then PlannedSameline 0
-      PlannedSameline i -> PlannedDelta 1 (_lstate_curY state + i)
+      else case _lstate_plannedSpace state of
-      p@PlannedNewline{} -> p
+        PlannedNone -> PlannedDelta 1 (_lstate_curY state)
-      p@PlannedDelta{} -> p
+        PlannedSameline i -> PlannedDelta 1 (_lstate_curY state + i)
+        p@PlannedNewline{} -> p
+        p@PlannedDelta{} -> p
     , _lstate_commentNewlines =
       _lstate_commentNewlines state + y + commentLines - 1
-    , _lstate_curY = if y == 0 then _lstate_curY state + x
+    , _lstate_curY = if y == 0 then _lstate_curY state + x + Text.length s
-        else x
+        else x + Text.length s
     }
 
 
@@ -293,6 +297,13 @@ layoutAddSepSpace = do
       -- (e.g. from an inserted comment restore-position task).
     }
 
+layoutFlushLine
+  :: (MonadMultiWriter Text.Builder.Builder m, MonadMultiState LayoutState m)
+  => m ()
+layoutFlushLine = do
+  state <- mGet
+  when (_lstate_curY state > 0) layoutWriteEnsureNewlineBlock
+
 -- moveToY :: MonadMultiState LayoutState m => Int -> m ()
 -- moveToY y = mModify $ \state ->
 --   let