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 where
ccccccc = "abc" ccccccc = "abc"
ddddd = True 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 funcPatDocs <- docHandleComms lbind
$ matches `forM` layoutPatternBind (Just idStr) binderDoc $ matches `forM` layoutPatternBind (Just idStr) binderDoc
return $ Left $ funcPatDocs 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 patDocs <- callLayouter layout_colsWrapPat =<< callLayouter layout_pat pat
mWhereDocs <- layoutLocalBinds whereBinds mWhereDocs <- layoutLocalBinds whereBinds
-- let mWhereArg = mWhereDocs <&> (,) (mkAnnKey lbind) -- TODO: is this the right AnnKey? -- let mWhereArg = mWhereDocs <&> (,) (mkAnnKey lbind) -- TODO: is this the right AnnKey?
binderDoc <- docLit $ Text.pack "=" binderDoc <- docLit $ Text.pack "="
let hasComments = hasAnyCommentsBelow lbind let hasComments = hasAnyCommentsBelow lbind
fmap Right $ docHandleComms lbind $ layoutPatternBindFinal fmap Right $ docHandleComms lbind $ docHandleComms comms $ layoutPatternBindFinal
Nothing Nothing
binderDoc binderDoc
(Just patDocs) (Just patDocs)
@ -250,7 +250,7 @@ layoutPatternBind
-> LMatch GhcPs (LHsExpr GhcPs) -> LMatch GhcPs (LHsExpr GhcPs)
-> ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
layoutPatternBind funId binderDoc lmatch@(L _ match) = do 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 -> patDocs <- pats `forM` \p ->
fmap return $ callLayouter layout_colsWrapPat =<< callLayouter layout_pat p fmap return $ callLayouter layout_colsWrapPat =<< callLayouter layout_pat p
let isInfix = isInfixMatch match let isInfix = isInfixMatch match
@ -296,7 +296,7 @@ layoutPatternBind funId binderDoc lmatch@(L _ match) = do
-- let mWhereArg = mWhereDocs <&> (,) (mkAnnKey lmatch) -- let mWhereArg = mWhereDocs <&> (,) (mkAnnKey lmatch)
let alignmentToken = if null pats then Nothing else funId let alignmentToken = if null pats then Nothing else funId
let hasComments = hasAnyCommentsBelow lmatch let hasComments = hasAnyCommentsBelow lmatch
docHandleComms lmatch $ docHandleComms epAnn $ docFlushCommsPost True matchEndLoc docHandleComms lmatch $ docHandleComms epAnn $ docHandleComms comms $ docFlushCommsPost True matchEndLoc
$ layoutPatternBindFinal $ layoutPatternBindFinal
alignmentToken alignmentToken
binderDoc binderDoc

View File

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