Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Fix the balance of haddock comment exact printing. #129

Merged
merged 1 commit into from
Jun 4, 2023
Merged

Fix the balance of haddock comment exact printing. #129

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
9 changes: 3 additions & 6 deletions src/Language/Haskell/GHC/ExactPrint/ExactPrint.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -4271,7 +4271,6 @@ instance ExactPrint (ConDecl GhcPs) where
, con_mb_cxt = mcxt
, con_args = args
, con_doc = doc }) = do
doc' <- mapM markAnnotated doc
an0 <- if has_forall
then markEpAnnL an lidl AnnForall
else return an
Expand All @@ -4291,7 +4290,7 @@ instance ExactPrint (ConDecl GhcPs) where
, con_ex_tvs = ex_tvs'
, con_mb_cxt = mcxt'
, con_args = args'
, con_doc = doc' })
, con_doc = doc })

where
-- -- In ppr_details: let's not print the multiplicities (they are always 1, by
Expand All @@ -4318,7 +4317,6 @@ instance ExactPrint (ConDecl GhcPs) where
, con_bndrs = bndrs
, con_mb_cxt = mcxt, con_g_args = args
, con_res_ty = res_ty, con_doc = doc }) = do
doc' <- mapM markAnnotated doc
cons' <- mapM markAnnotated cons
an0 <- markEpAnnL an lidl AnnDcolon
an1 <- annotationsToComments an0 lidl [AnnOpenP, AnnCloseP]
Expand Down Expand Up @@ -4346,7 +4344,7 @@ instance ExactPrint (ConDecl GhcPs) where
, con_names = cons'
, con_bndrs = bndrs'
, con_mb_cxt = mcxt', con_g_args = args'
, con_res_ty = res_ty', con_doc = doc' })
, con_res_ty = res_ty', con_doc = doc })

-- ---------------------------------------------------------------------

Expand Down Expand Up @@ -4382,8 +4380,7 @@ instance ExactPrint (ConDeclField GhcPs) where
names' <- markAnnotated names
an0 <- markEpAnnL an lidl AnnDcolon
ftype' <- markAnnotated ftype
mdoc' <- mapM markAnnotated mdoc
return (ConDeclField an0 names' ftype' mdoc')
return (ConDeclField an0 names' ftype' mdoc)

-- ---------------------------------------------------------------------

Expand Down
9 changes: 6 additions & 3 deletions src/Language/Haskell/GHC/ExactPrint/Utils.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -215,13 +215,16 @@ tokComment t@(L lt c) =
hsDocStringComments :: Anchor -> RealSrcSpan -> GHC.HsDocString -> [Comment]
hsDocStringComments _ pt (MultiLineDocString dec (x :| xs)) =
let
L lx x' = dedentDocChunkBy 4 x
str = "-- " ++ printDecorator dec ++ unpackHDSC x'
decStr = printDecorator dec
L lx x' = dedentDocChunkBy (3 + length decStr) x
str = "-- " ++ decStr ++ unpackHDSC x'
docChunk _ [] = []
docChunk pt' (L l chunk:cs)
= Comment ("--" ++ unpackHDSC chunk) (spanAsAnchor l) pt' Nothing : docChunk (rs l) cs
in
(Comment str (spanAsAnchor lx) pt Nothing : docChunk pt (map dedentDocChunk xs))
(Comment str (spanAsAnchor lx) pt Nothing : docChunk (rs lx) (map dedentDocChunk xs))
hsDocStringComments anc pt (NestedDocString dec@(HsDocStringNamed _) (L _ chunk))
= [Comment ("{- " ++ printDecorator dec ++ unpackHDSC chunk ++ "-}") anc pt Nothing ]
hsDocStringComments anc pt (NestedDocString dec (L _ chunk))
= [Comment ("{-" ++ printDecorator dec ++ unpackHDSC chunk ++ "-}") anc pt Nothing ]
hsDocStringComments _ _ (GeneratedDocString _) = [] -- Should not appear in user-written code
Expand Down
2 changes: 1 addition & 1 deletion tests/examples/ghc94/Haddock.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,4 +1,4 @@
{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
{-# OPTIONS_GHC -fno-warn-redundant-constraints -haddock #-}
-----------------------------------------------------------------------------
-- |
-- Module : Test
Expand Down