Merge branch 'master' into error-handling

src-literatetests/15-regressions.blt

@@ -782,3 +782,23 @@ func = abc + def
  where
   abc = 13
   def = 1
+
+#test AddBaseY/EnsureIndent float in effect
+
+zItazySunefp twgq nlyo lwojjoBiecao =
+  let mhIarjyai =
+        ukwAausnfcn
+          $ XojlsTOSR.vuwOvuvdAZUOJaa
+          $ XojlsTOSR.vkesForanLiufjeDI
+          $ XojlsTOSR.vkesForanLiufjeDI
+          $ XojlsTOSR.popjAyijoWarueeP
+          $ XojlsTOSR.jpwuPmafuDqlbkt nlyo
+          $ XojlsTOSR.jpwuPmafuDqlbkt xxneswWhxwng
+          $ XojlsTOSR.jpwuPmafuDqlbkt oloCuxeDdow
+          $ XojlsTOSR.jpwuPmafuDqlbkt (uwurrvoNnukzefuDjeh lwojjoBiecao nlyo)
+          $ etOslnoz lwojjoBiecao
+  in  kucotg $ (bbbr, Yoxe.Dwzbuzi.zrLokoTnuy piv)
+
+#test module initial comment
+-- test
+module MyModule where

src/Language/Haskell/Brittany/Internal.hs

@@ -526,7 +526,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
@@ -542,23 +542,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
+            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'' =
               Map.insert (ExactPrint.mkAnnKey lmod) mAnn' filteredAnns
           in

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 (-999) (length commentLines)
-              _       -> 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 }
   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

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
+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
       layoutWriteAppend l
       lr `forM_` \x -> do
@@ -182,9 +182,10 @@ layoutMoveToCommentPos
      )
   => Int
   -> Int
+  -> Int
   -> m ()
-layoutMoveToCommentPos y x = do
+layoutMoveToCommentPos y x commentLines = do
-  traceLocal ("layoutMoveToCommentPos", y, x)
+  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

src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs

@@ -770,7 +770,7 @@ layoutExpr lexpr@(L _ expr) = do
           addAlternativeCond (not hasComments) $ docSeq
             [ appSep $ docLit $ Text.pack "let"
             , docNodeAnnKW lexpr (Just AnnLet)
-            $ appSep $ docForceSingleline bindDoc
+              $ appSep $ docForceSingleline bindDoc
             , appSep $ docLit $ Text.pack "in"
             , docForceSingleline expDoc1
             ]

src/Language/Haskell/Brittany/Internal/Transformations/Floating.hs

@@ -132,6 +132,8 @@ transformSimplifyFloating = stepBO .> stepFull
         Just $ BDIndentLevelPop (BDAddBaseY ind x)
       BDAddBaseY ind (BDIndentLevelPushCur x) ->
         Just $ BDIndentLevelPushCur (BDAddBaseY ind x)
+      BDAddBaseY ind (BDEnsureIndent ind2 x) ->
+        Just $ BDEnsureIndent (mergeIndents ind ind2) x
       _ -> Nothing
     stepBO :: BriDoc -> BriDoc
     stepBO = -- traceFunctionWith "stepBO" (show . briDocToDocWithAnns) (show . briDocToDocWithAnns) $