Fix a case of comments going missing

ghc92
Lennart Spitzner 2024-03-16 23:23:13 +01:00
parent 2fd6308d09
commit 8ad1f0fa2e
3 changed files with 30 additions and 4 deletions

View File

@ -1126,3 +1126,14 @@ otherFunc very long patterrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrr
where
ccccccc = "abc"
ddddd = True
#test another comment-case
getMimeType fp
-- ODT
| fp == "layout-cache"
= Just "application/binary"
| "Formula-" `isPrefixOf` fp && "/" `isSuffixOf` fp
= Just "application/vnd.oasis.opendocument.formula"
-- generic
| otherwise
= M.lookup (T.toLower $ T.drop 1 $ T.pack $ takeExtension fp) mimeTypes

View File

@ -154,13 +154,13 @@ layoutBind lbind@(L _ bind) = case bind of
funcPatDocs <- docHandleComms lbind
$ matches `forM` layoutPatternBind (Just idStr) binderDoc
return $ Left $ funcPatDocs
PatBind _epAnn pat (GRHSs _ grhss whereBinds) ([], []) -> do -- TODO92 are we ignoring something in whereBinds?
PatBind _epAnn pat (GRHSs comms grhss whereBinds) ([], []) -> do -- TODO92 are we ignoring something in whereBinds?
patDocs <- callLayouter layout_colsWrapPat =<< callLayouter layout_pat pat
mWhereDocs <- layoutLocalBinds whereBinds
-- let mWhereArg = mWhereDocs <&> (,) (mkAnnKey lbind) -- TODO: is this the right AnnKey?
binderDoc <- docLit $ Text.pack "="
let hasComments = hasAnyCommentsBelow lbind
fmap Right $ docHandleComms lbind $ layoutPatternBindFinal
fmap Right $ docHandleComms lbind $ docHandleComms comms $ layoutPatternBindFinal
Nothing
binderDoc
(Just patDocs)
@ -250,7 +250,7 @@ layoutPatternBind
-> LMatch GhcPs (LHsExpr GhcPs)
-> ToBriDocM BriDocNumbered
layoutPatternBind funId binderDoc lmatch@(L _ match) = do
let Match epAnn matchCtx pats (GRHSs _ grhss whereBinds) = match
let Match epAnn matchCtx pats (GRHSs comms grhss whereBinds) = match
patDocs <- pats `forM` \p ->
fmap return $ callLayouter layout_colsWrapPat =<< callLayouter layout_pat p
let isInfix = isInfixMatch match
@ -296,7 +296,7 @@ layoutPatternBind funId binderDoc lmatch@(L _ match) = do
-- let mWhereArg = mWhereDocs <&> (,) (mkAnnKey lmatch)
let alignmentToken = if null pats then Nothing else funId
let hasComments = hasAnyCommentsBelow lmatch
docHandleComms lmatch $ docHandleComms epAnn $ docFlushCommsPost True matchEndLoc
docHandleComms lmatch $ docHandleComms epAnn $ docHandleComms comms $ docFlushCommsPost True matchEndLoc
$ layoutPatternBindFinal
alignmentToken
binderDoc

View File

@ -518,6 +518,21 @@ instance DocHandleComms [LEpaComment] (ToBriDocM BriDocNumbered) where
i1 <- allocNodeIndex
pure (i1, BDQueueComments comms bd)
instance DocHandleComms EpAnnComments (ToBriDocM BriDocNumbered) where
docHandleComms (EpaComments comms) bdm = do
bd <- bdm
i1 <- allocNodeIndex
pure (i1, BDQueueComments comms bd)
docHandleComms (EpaCommentsBalanced commsB commsA) bdm = do
bd <- bdm
i1 <- allocNodeIndex
pure
( i1
, BDQueueComments
(commsB ++ commsA)
bd
)
instance DocHandleComms (EpAnn a) (ToBriDocM BriDocNumbered) where
docHandleComms epAnn bdm = case epAnn of
EpAnn anch _ (EpaComments []) -> do