From 2b303b2a2048bc9218feefc893018a5108953689 Mon Sep 17 00:00:00 2001 From: Lennart Spitzner Date: Fri, 10 Jan 2020 16:32:18 +0100 Subject: [PATCH 1/2] Fix additional indentation bug for let-in --- src-literatetests/15-regressions.blt | 16 ++++++++++++++++ .../Haskell/Brittany/Internal/Layouters/Expr.hs | 2 +- .../Internal/Transformations/Floating.hs | 2 ++ 3 files changed, 19 insertions(+), 1 deletion(-) diff --git a/src-literatetests/15-regressions.blt b/src-literatetests/15-regressions.blt index ce2d617..21eaf3d 100644 --- a/src-literatetests/15-regressions.blt +++ b/src-literatetests/15-regressions.blt @@ -782,3 +782,19 @@ 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) diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs b/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs index df5ee2a..1a02ab8 100644 --- a/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs +++ b/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 ] diff --git a/src/Language/Haskell/Brittany/Internal/Transformations/Floating.hs b/src/Language/Haskell/Brittany/Internal/Transformations/Floating.hs index 03c6c0c..4bb227b 100644 --- a/src/Language/Haskell/Brittany/Internal/Transformations/Floating.hs +++ b/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) $ From 128dd828c24e33d1e67db8f713692af72a88b8e0 Mon Sep 17 00:00:00 2001 From: Lennart Spitzner Date: Sat, 11 Jan 2020 23:19:04 +0100 Subject: [PATCH 2/2] Fix newline issue on comments before where --- src-literatetests/15-regressions.blt | 4 +++ src/Language/Haskell/Brittany/Internal.hs | 20 ++------------ .../Haskell/Brittany/Internal/Backend.hs | 25 +++++++++-------- .../Haskell/Brittany/Internal/BackendUtils.hs | 27 +++++++++++-------- 4 files changed, 36 insertions(+), 40 deletions(-) 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