diff --git a/data/10-structured/expression-do.blt b/data/10-structured/expression-do.blt
index a45bbf6..5bda8ed 100644
--- a/data/10-structured/expression-do.blt
+++ b/data/10-structured/expression-do.blt
@@ -15,3 +15,12 @@ func = do
func = do
let x = 13
stmt x
+
+#test do empty lines
+func = do
+ <BLANKLINE>
+ let x = 13
+ <BLANKLINE>
+ y <- monadic
+ <BLANKLINE>
+ stmt (x + y)
diff --git a/source/library/Language/Haskell/Brittany/Internal/S3_ToBriDocTools.hs b/source/library/Language/Haskell/Brittany/Internal/S3_ToBriDocTools.hs
index 5a41a01..10886a4 100644
--- a/source/library/Language/Haskell/Brittany/Internal/S3_ToBriDocTools.hs
+++ b/source/library/Language/Haskell/Brittany/Internal/S3_ToBriDocTools.hs
@@ -226,21 +226,28 @@ hasAnyCommentsBelow =
hasCommentsBetween
:: Data ast
=> ast
- -> Maybe GHC.RealSrcLoc
- -> Maybe GHC.RealSrcLoc
+ -> Maybe GHC.RealSrcSpan
+ -> Maybe GHC.RealSrcSpan
-> Bool
hasCommentsBetween ast left right = do
- getAny $ SYB.everything
- (<>)
- (SYB.mkQ
- (Any False)
- (\(L (GHC.Anchor pos _) _ :: LEpaComment) -> Any
- ( (maybe True (GHC.realSrcSpanStart pos >=) left)
- && (maybe True (GHC.realSrcSpanEnd pos <=) right)
+ getAny
+ $ SYB.everything
+ (<>)
+ (SYB.mkQ
+ (Any False)
+ (\(L (GHC.Anchor pos _) _ :: LEpaComment) -> Any
+ ( ( maybe True
+ (\l -> GHC.realSrcSpanStart pos >= GHC.realSrcSpanEnd l)
+ left
+ )
+ && (maybe True
+ (\l -> GHC.realSrcSpanEnd pos <= GHC.realSrcSpanStart l)
+ right
+ )
+ )
)
)
- )
- ast
+ ast
startsWithComments :: EpAnn a -> Bool
startsWithComments = \case
@@ -627,11 +634,11 @@ instance DocHandleComms GHC.SrcSpan (ToBriDocM BriDocNumbered) where
-- CLASS ObtainAnnPos ----------------------------------------------------------
class ObtainAnnPos key ann where
- obtainAnnPos :: ann -> key -> Maybe GHC.RealSrcLoc
+ obtainAnnPos :: ann -> key -> Maybe GHC.RealSrcSpan
instance ObtainAnnPos AnnKeywordId GHC.AddEpAnn where
obtainAnnPos (GHC.AddEpAnn eKW loc) kw = if eKW == kw
- then Just (epaLocationRealSrcSpanStart loc)
+ then Just (GHC.epaLocationRealSrcSpan loc)
else Nothing
instance ObtainAnnPos AnnKeywordId (EpAnn GHC.AnnsModule) where
@@ -648,7 +655,7 @@ instance ObtainAnnPos AnnKeywordId [GHC.AddEpAnn] where
obtainAnnPos list kw =
case [ loc | GHC.AddEpAnn eKW loc <- list, eKW == kw ] of
[] -> Nothing
- locs -> Just (epaLocationRealSrcSpanStart $ minimum locs)
+ locs -> Just (GHC.epaLocationRealSrcSpan $ minimum locs)
instance ObtainAnnPos AnnKeywordId (EpAnn [GHC.AddEpAnn]) where
obtainAnnPos EpAnnNotUsed _kw = Nothing
@@ -679,7 +686,8 @@ instance ObtainAnnDeltaPos (EpAnn GHC.AnnsModule) where
obtainAnnDeltaPos = \case
EpAnnNotUsed -> \_kw -> Nothing
EpAnn _ (GHC.AnnsModule l annList) epaComms -> \kw -> do
- loc <- obtainAnnPos l kw <|> obtainAnnPos annList kw
+ loc <- GHC.realSrcSpanStart
+ <$> (obtainAnnPos l kw <|> obtainAnnPos annList kw)
let pos = (GHC.srcLocLine loc, GHC.srcLocCol loc)
pure $ ExactPrint.pos2delta
(maximum $ (1, 1) :
@@ -704,6 +712,14 @@ instance DocFlushCommsPost (Maybe GHC.RealSrcLoc) (ToBriDocM BriDocNumbered) whe
bd <- bdm
pure (i1, BDFlushCommentsPost loc shouldMark bd)
+instance DocFlushCommsPost (Maybe GHC.RealSrcSpan) (ToBriDocM BriDocNumbered) where
+ docFlushCommsPost shouldMark = \case
+ Nothing -> id
+ Just loc -> \bdm -> do
+ i1 <- allocNodeIndex
+ bd <- bdm
+ pure (i1, BDFlushCommentsPost (GHC.realSrcSpanEnd loc) shouldMark bd)
+
instance DocFlushCommsPost ann (ToBriDocM BriDocNumbered)
=> DocFlushCommsPost ann (ToBriDocM [BriDocNumbered]) where
docFlushCommsPost shouldMark loc bdm = do
diff --git a/source/library/Language/Haskell/Brittany/Internal/S4_WriteBriDoc.hs b/source/library/Language/Haskell/Brittany/Internal/S4_WriteBriDoc.hs
index cb7a597..40d2e50 100644
--- a/source/library/Language/Haskell/Brittany/Internal/S4_WriteBriDoc.hs
+++ b/source/library/Language/Haskell/Brittany/Internal/S4_WriteBriDoc.hs
@@ -291,7 +291,7 @@ layoutBriDocM = \case
PlannedNone -> PlannedNone
PlannedSameline i -> PlannedDelta n (_lstate_curY s + i)
PlannedNewline{} -> PlannedNewline n
- PlannedDelta{} -> PlannedNewline n
+ PlannedDelta _ i -> PlannedDelta n i
}
layoutBriDocM bd
BDFlushCommentsPost loc shouldMark bd -> do
diff --git a/source/library/Language/Haskell/Brittany/Internal/StepOrchestrate.hs b/source/library/Language/Haskell/Brittany/Internal/StepOrchestrate.hs
index 0e78fcf..6da4220 100644
--- a/source/library/Language/Haskell/Brittany/Internal/StepOrchestrate.hs
+++ b/source/library/Language/Haskell/Brittany/Internal/StepOrchestrate.hs
@@ -25,6 +25,7 @@ import GHC ( EpaCommentTok
, LHsDecl
, SrcSpanAnn'(SrcSpanAnn)
)
+import qualified GHC.Types.SrcLoc as GHC
import qualified GHC.OldList as List
import GHC.Types.SrcLoc ( srcSpanFileName_maybe )
import qualified Language.Haskell.GHC.ExactPrint
@@ -68,7 +69,7 @@ processModule traceFunc conf inlineConf parsedModule = do
FinalList moduleElementsStream = splitModule
shouldReformatHead
parsedModule
- (obtainAnnPos (GHC.hsmodAnn $ GHC.unLoc parsedModule) GHC.AnnWhere)
+ (fmap GHC.realSrcSpanStart $ obtainAnnPos (GHC.hsmodAnn $ GHC.unLoc parsedModule) GHC.AnnWhere)
((out, errs), debugStrings) =
runIdentity
$ MultiRWSS.runMultiRWSTNil
diff --git a/source/library/Language/Haskell/Brittany/Internal/ToBriDoc/Decl.hs b/source/library/Language/Haskell/Brittany/Internal/ToBriDoc/Decl.hs
index 28b8b02..5683d18 100644
--- a/source/library/Language/Haskell/Brittany/Internal/ToBriDoc/Decl.hs
+++ b/source/library/Language/Haskell/Brittany/Internal/ToBriDoc/Decl.hs
@@ -904,7 +904,12 @@ layoutClsInst (L declLoc _) cid = do
layoutInstanceHead = case cid_ext cid of
(EpAnn annAnchor addEpAnns (EpaComments comms), sortKey) -> do
let posWhere = obtainAnnPos addEpAnns AnnWhere
- let (commsBefore, commsAfter) = partition (\(L anch _) -> (Just $ GHC.realSrcSpanStart $ anchor anch) < posWhere) comms
+ let (commsBefore, commsAfter) =
+ partition
+ (\(L anch _) ->
+ (Just $ GHC.realSrcSpanStart $ anchor anch)
+ < fmap GHC.realSrcSpanStart posWhere)
+ comms
docHandleComms (reverse commsAfter)
$ briDocByExactNoComment
$ L declLoc
diff --git a/source/library/Language/Haskell/Brittany/Internal/ToBriDoc/Expr.hs b/source/library/Language/Haskell/Brittany/Internal/ToBriDoc/Expr.hs
index b66d31e..9d2b5fd 100644
--- a/source/library/Language/Haskell/Brittany/Internal/ToBriDoc/Expr.hs
+++ b/source/library/Language/Haskell/Brittany/Internal/ToBriDoc/Expr.hs
@@ -649,7 +649,11 @@ layoutExpr lexpr@(L _ expr) = do
stmtDocs <- docHandleComms stmtEpAnn $ do
stmts `forM` docHandleListElemComms (callLayouter layout_stmt)
docSetParSpacing $ docAddBaseY BrIndentRegularForce $ docPar
- (docHandleComms locDo $ docLit $ Text.pack "do")
+ ( docFlushCommsPost True locDo
+ $ docHandleComms locDo
+ $ docLit
+ $ Text.pack "do"
+ )
( docSetBaseAndIndent
$ docNonBottomSpacing
$ docLines
diff --git a/source/library/Language/Haskell/Brittany/Internal/ToBriDoc/Stmt.hs b/source/library/Language/Haskell/Brittany/Internal/ToBriDoc/Stmt.hs
index e5219b2..5561ab1 100644
--- a/source/library/Language/Haskell/Brittany/Internal/ToBriDoc/Stmt.hs
+++ b/source/library/Language/Haskell/Brittany/Internal/ToBriDoc/Stmt.hs
@@ -20,7 +20,7 @@ layoutStmt lstmt@(L _ stmt) = do
indentPolicy <- mAsk <&> _conf_layout .> _lconfig_indentPolicy .> confUnpack
indentAmount :: Int <-
mAsk <&> _conf_layout .> _lconfig_indentAmount .> confUnpack
- case stmt of
+ docFlushCommsPost True lstmt $ case stmt of
LastStmt NoExtField body Nothing _ -> do
-- at least the "|" of a monadcomprehension for _some_ reason
-- is connected to the _body_ of the "result" stmt. So we need
diff --git a/source/test-suite/Main.hs b/source/test-suite/Main.hs
index 3604b81..7720ee6 100644
--- a/source/test-suite/Main.hs
+++ b/source/test-suite/Main.hs
@@ -245,16 +245,17 @@ main = do
| _ <- Parsec.try $ Parsec.string "#expected"
, _ <- Parsec.eof
]
+ , [ NormalLine mempty
+ | _ <- Parsec.many $ Parsec.oneOf " \t"
+ , _ <- Parsec.try $ Parsec.string "<BLANKLINE>"
+ , _ <- Parsec.eof
+ ]
, [ CommentLine
| _ <- Parsec.many $ Parsec.oneOf " \t"
, _ <- Parsec.optional $ Parsec.string "##" <* many
(Parsec.noneOf "\r\n")
, _ <- Parsec.eof
]
- , [ NormalLine mempty
- | _ <- Parsec.try $ Parsec.string "<BLANKLINE>"
- , _ <- Parsec.eof
- ]
]
lineMapper :: Text -> InputLine
lineMapper line = case Parsec.runParser specialLineParser () "" line of