Fix retaining newlines between do statements
parent
b6001e9ecc
commit
ab67a794db
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Reference in New Issue