diff --git a/source/library/Language/Haskell/Brittany/Internal/WriteBriDoc.hs b/source/library/Language/Haskell/Brittany/Internal/WriteBriDoc.hs index 035b697..03710de 100644 --- a/source/library/Language/Haskell/Brittany/Internal/WriteBriDoc.hs +++ b/source/library/Language/Haskell/Brittany/Internal/WriteBriDoc.hs @@ -33,8 +33,12 @@ import GHC ( Anchor(Anchor) , DeltaPos(SameLine, DifferentLine) , srcLocLine , srcLocCol + , srcSpanStartCol + , srcSpanStartLine + ) +import GHC.Types.SrcLoc ( realSrcSpanEnd + , realSrcSpanStart ) -import GHC.Types.SrcLoc ( realSrcSpanEnd ) import qualified GHC.OldList as List import qualified Language.Haskell.GHC.ExactPrint.Utils as ExactPrint @@ -286,9 +290,9 @@ layoutBriDocM = \case Just m -> let p1 = (srcLocLine m, srcLocCol m) p2 = (srcLocLine loc, srcLocCol loc) - in -- trace ("_lstate_plannedSpace = " ++ show (_lstate_plannedSpace s) - -- ++ ", _lstate_markerForDelta = " ++ show (_lstate_markerForDelta s) - -- ++ ", _lstate_curY = " ++ show (_lstate_curY s) + in -- trace ("plannedSpace = " ++ show (_lstate_plannedSpace s) + -- ++ ", markerForDelta = " ++ show (_lstate_markerForDelta s) + -- ++ ", curY = " ++ show (_lstate_curY s) -- ++ ", p1 = " ++ show p1 -- ++ ", p2 = " ++ show p2 -- ++ ", startCurY = " ++ show startCurY @@ -352,10 +356,28 @@ takeBefore loc = do printComments :: LayoutConstraints m => [GHC.LEpaComment] -> m () printComments comms = do let addComment isBlock s anchor prior = do + curY <- _lstate_curY <$> mGet case anchor of Anchor span UnchangedAnchor -> do - let dp = ExactPrint.ss2deltaEnd prior span - layoutWriteComment True isBlock dp 1 (Text.pack s) + case ExactPrint.ss2deltaEnd prior span of + -- this is a stupid shitty hacky workaround + -- because exactprint _sometimes_ decides that + -- block comments don't get a proper prior span + -- assigned and it breaks everything. + SameLine 0 + | isBlock + , srcSpanStartLine span > 1 + , srcSpanStartCol span /= curY + 1 + -> do + layoutSetMarker $ Just $ realSrcSpanStart span + layoutWriteComment + True + isBlock + (DifferentLine 1 (srcSpanStartCol span)) + 1 + (Text.pack s) + dp -> do + layoutWriteComment True isBlock dp 1 (Text.pack s) if isBlock then layoutSetMarker $ Just $ realSrcSpanEnd span else layoutUpdateMarker $ realSrcSpanEnd span diff --git a/source/library/Language/Haskell/Brittany/Internal/WriteBriDoc/Operators.hs b/source/library/Language/Haskell/Brittany/Internal/WriteBriDoc/Operators.hs index 354d4d6..d592adb 100644 --- a/source/library/Language/Haskell/Brittany/Internal/WriteBriDoc/Operators.hs +++ b/source/library/Language/Haskell/Brittany/Internal/WriteBriDoc/Operators.hs @@ -133,7 +133,7 @@ layoutWriteComment -> Int -> Text -> m () -layoutWriteComment absolute isBlock dp commentLines s = do -- TODO92 we don't move to comment pos at all! +layoutWriteComment absolute isBlock dp commentLines s = do let (y, x) = case dp of GHC.SameLine c -> (0, c) GHC.DifferentLine l c -> (l, c) @@ -165,7 +165,7 @@ layoutWriteComment absolute isBlock dp commentLines s = do -- TODO92 we don't mo PlannedNone -> PlannedDelta 1 (_lstate_curY state) PlannedSameline i -> PlannedDelta 1 (_lstate_curY state + i) p@PlannedNewline{} -> p - p@PlannedDelta{} -> p + PlannedDelta n _ -> PlannedNewline n , _lstate_commentNewlines = _lstate_commentNewlines state + y + commentLines