Fix retain comments on matches (lambda rhs etc.)

ghc92
Lennart Spitzner 2023-04-17 09:58:09 +00:00
parent 0a76fe952c
commit 736c2a8d46
2 changed files with 57 additions and 61 deletions

View File

@ -250,19 +250,15 @@ layoutPatternBind
-> BriDocNumbered
-> LMatch GhcPs (LHsExpr GhcPs)
-> ToBriDocM BriDocNumbered
layoutPatternBind funId binderDoc lmatch@(L _ match) =
docHandleComms lmatch $ do
let pats = m_pats match
let (GRHSs _ grhss whereBinds) = m_grhss match
layoutPatternBind funId binderDoc lmatch@(L _ match) = do
let Match epAnn matchCtx pats (GRHSs _ grhss whereBinds) = match
patDocs <- pats `forM` \p -> fmap return $ colsWrapPat =<< layoutPat p
let isInfix = isInfixMatch match
let matchEndLoc = case GHC.locA $ GHC.getLoc lmatch of
GHC.RealSrcSpan s _ -> Just $ GHC.realSrcSpanEnd s
GHC.UnhelpfulSpan{} -> Nothing
mIdDoc <- case match of
Match epAnn (FunRhs matchId _ _) _ _ ->
fmap Just
$ docHandleComms epAnn $ do
mIdDoc <- case matchCtx of
FunRhs matchId _ _ -> fmap Just $ do
t <- lrdrNameToTextAnn matchId
let t' = fixPatternBindIdentifier match t
docLit t'
@ -300,7 +296,7 @@ layoutPatternBind funId binderDoc lmatch@(L _ match) =
-- let mWhereArg = mWhereDocs <&> (,) (mkAnnKey lmatch)
let alignmentToken = if null pats then Nothing else funId
let hasComments = hasAnyCommentsBelow lmatch
docFlushCommsPost True matchEndLoc
docHandleComms lmatch $ docHandleComms epAnn $ docFlushCommsPost True matchEndLoc
$ layoutPatternBindFinal
alignmentToken
binderDoc

View File

@ -55,10 +55,9 @@ layoutExpr lexpr@(L _ expr) = do
HsLit epAnn lit -> docHandleComms epAnn $ do
allocateNode $ litBriDoc lit
HsLam _ (MG _ (L _ [(L _ match)]) _)
| pats <- m_pats match
, GRHSs _ [lgrhs] llocals <- m_grhss match
| Match epAnn _matchCtx pats (GRHSs _ [lgrhs] llocals) <- match
, EmptyLocalBinds{} <- llocals
, L _ (GRHS epAnn [] body) <- lgrhs
, L _ (GRHS rhsEpAnn [] body) <- lgrhs
-> do
patDocs <- zip (True : repeat False) pats `forM` \(isFirst, p) ->
fmap return $ do
@ -85,6 +84,7 @@ layoutExpr lexpr@(L _ expr) = do
shareDoc
$ docAddBaseY BrIndentRegular
$ docHandleComms epAnn
$ docHandleComms rhsEpAnn
$ layoutExpr body
let funcPatternPartLine = docCols
ColCasePattern