From 6724760f408e4e6d9640a663ed1bd51af0380893 Mon Sep 17 00:00:00 2001
From: Lennart Spitzner <hexagoxel@hexagoxel.de>
Date: Fri, 20 Dec 2019 01:12:25 +0100
Subject: [PATCH] Fix non-idempotent newlines with comment + where (#263)

---
 src-literatetests/15-regressions.blt                 | 12 ++++++++++++
 src/Language/Haskell/Brittany/Internal.hs            |  1 +
 src/Language/Haskell/Brittany/Internal/Backend.hs    | 10 ++++++----
 .../Haskell/Brittany/Internal/BackendUtils.hs        |  6 +++++-
 src/Language/Haskell/Brittany/Internal/Types.hs      |  6 ++++++
 5 files changed, 30 insertions(+), 5 deletions(-)

diff --git a/src-literatetests/15-regressions.blt b/src-literatetests/15-regressions.blt
index 07cc3a9..ce2d617 100644
--- a/src-literatetests/15-regressions.blt
+++ b/src-literatetests/15-regressions.blt
@@ -770,3 +770,15 @@ vakjkeSulxudbFokvir = Duotpo
   , -- N.B.
     .. -- x
   }
+
+#test issue 263
+
+func = abc + def
+  -- a
+  -- b
+
+  -- comment
+
+ where
+  abc = 13
+  def = 1
diff --git a/src/Language/Haskell/Brittany/Internal.hs b/src/Language/Haskell/Brittany/Internal.hs
index b0680a7..e98c0fc 100644
--- a/src/Language/Haskell/Brittany/Internal.hs
+++ b/src/Language/Haskell/Brittany/Internal.hs
@@ -651,6 +651,7 @@ layoutBriDoc briDoc = do
         , _lstate_comments         = anns
         , _lstate_commentCol       = Nothing
         , _lstate_addSepSpace      = Nothing
+        , _lstate_commentNewlines  = 0
         }
 
   state' <- MultiRWSS.withMultiStateS state $ layoutBriDocM briDoc'
diff --git a/src/Language/Haskell/Brittany/Internal/Backend.hs b/src/Language/Haskell/Brittany/Internal/Backend.hs
index 50522ed..a33edca 100644
--- a/src/Language/Haskell/Brittany/Internal/Backend.hs
+++ b/src/Language/Haskell/Brittany/Internal/Backend.hs
@@ -279,12 +279,14 @@ layoutBriDocM = \case
                      , keyword == kw1
                      ]
       -- mTell $ Seq.fromList ["KWDP: " ++ show annKey ++ " " ++ show mAnn]
-      pure $ case relevant of
-        [] -> Nothing
-        (dp:_) -> Just dp
+      case relevant of
+        [] -> pure Nothing
+        (ExactPrint.Types.DP (y, x):_) -> do
+          mSet state { _lstate_commentNewlines = 0 }
+          pure $ Just (y - _lstate_commentNewlines state, x)
     case mDP of
       Nothing -> pure ()
-      Just (ExactPrint.Types.DP (y, x)) ->
+      Just (y, x) ->
         layoutMoveToCommentPos y (if shouldRestoreIndent then x else 0)
     layoutBriDocM bd
   BDNonBottomSpacing _ bd -> layoutBriDocM bd
diff --git a/src/Language/Haskell/Brittany/Internal/BackendUtils.hs b/src/Language/Haskell/Brittany/Internal/BackendUtils.hs
index bf30a4e..aa420fe 100644
--- a/src/Language/Haskell/Brittany/Internal/BackendUtils.hs
+++ b/src/Language/Haskell/Brittany/Internal/BackendUtils.hs
@@ -200,6 +200,7 @@ 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
     }
 
 -- | does _not_ add spaces to again reach the current base column.
@@ -217,6 +218,7 @@ layoutWriteNewline = do
       Left{}  -> Right 1
       Right i -> Right (i + 1)
     , _lstate_addSepSpace      = Nothing
+    , _lstate_commentNewlines  = 0
     }
 
 layoutWriteEnsureNewlineBlock
@@ -574,7 +576,9 @@ layoutIndentRestorePostComment = do
 #if INSERTTRACES
   tellDebugMessShow ("layoutIndentRestorePostComment", mCommentCol)
 #endif
-  mModify $ \s -> s { _lstate_commentCol = Nothing }
+  mModify $ \s -> s { _lstate_commentCol = Nothing
+                    , _lstate_commentNewlines = 0
+                    }
   case (mCommentCol, eCurYAddNL) of
     (Just commentCol, Left{}) -> do
       layoutWriteEnsureNewlineBlock
diff --git a/src/Language/Haskell/Brittany/Internal/Types.hs b/src/Language/Haskell/Brittany/Internal/Types.hs
index c8e37ff..ed7798e 100644
--- a/src/Language/Haskell/Brittany/Internal/Types.hs
+++ b/src/Language/Haskell/Brittany/Internal/Types.hs
@@ -84,6 +84,11 @@ data LayoutState = LayoutState
   --     -- captures if the layouter currently is in a new line, i.e. if the
   --     -- current line only contains (indentation) spaces.
   -- this is mostly superseeded by curYOrAddNewline, iirc.
+  , _lstate_commentNewlines :: Int -- number of newlines inserted due to
+                                   -- move-to-DP at a start of a comment.
+                                   -- Necessary because some keyword DPs
+                                   -- are relative to the last non-comment
+                                   -- entity (for some reason)
   }
 
 lstate_baseY :: LayoutState -> Int
@@ -102,6 +107,7 @@ instance Show LayoutState where
     ++ ",indLevelLinger=" ++ show (_lstate_indLevelLinger state)
     ++ ",commentCol=" ++ show (_lstate_commentCol state)
     ++ ",addSepSpace=" ++ show (_lstate_addSepSpace state)
+    ++ ",commentNewlines=" ++ show (_lstate_commentNewlines state)
     ++ "}"
 
 -- data NewLineState = NewLineStateInit -- initial state. we do not know if in a