From 5121a4edd216491095ec09790a1535105e1c9006 Mon Sep 17 00:00:00 2001
From: Ben Gamari <ben@smart-cactus.org>
Date: Wed, 14 Feb 2024 10:47:44 -0500
Subject: [PATCH] Allow docstrings after exports
Here we extend the parser and AST to preserve docstrings following
export items. We then extend Haddock to parse `@since` annotations in
such docstrings, allowing changes in export structure to be properly
documented.
Bumps haddock submodule.
---
compiler/GHC/Hs/Doc.hs | 13 +++-
compiler/GHC/Hs/ImpExp.hs | 63 +++++++++++-------
compiler/GHC/HsToCore/Docs.hs | 21 ++++++
compiler/GHC/Iface/Ext/Ast.hs | 8 +--
compiler/GHC/Parser.y | 19 +++---
compiler/GHC/Parser/PostProcess.hs | 15 +++--
compiler/GHC/Parser/PostProcess/Haddock.hs | 16 ++++-
compiler/GHC/Rename/Names.hs | 49 +++++++-------
compiler/GHC/Tc/Errors/Ppr.hs | 2 +-
compiler/GHC/Tc/Gen/Export.hs | 24 ++++---
compiler/Language/Haskell/Syntax/ImpExp.hs | 66 ++++++++++++++++---
.../tests/haddock/haddock_examples/Test.hs | 15 +++++
.../haddock_examples/haddock.Test.stderr | 11 +++-
.../should_compile/DumpRenamedAst.stderr | 3 +-
.../tests/parser/should_compile/T14189.stderr | 3 +-
.../tests/showIface/DocsInHiFile1.stdout | 2 +
.../tests/showIface/DocsInHiFileTH.stdout | 2 +
.../tests/showIface/HaddockIssue849.stdout | 2 +
testsuite/tests/showIface/HaddockOpts.stdout | 2 +
.../showIface/HaddockSpanIssueT24378.stdout | 3 +
testsuite/tests/showIface/LanguageExts.stdout | 2 +
.../showIface/MagicHashInHaddocks.stdout | 2 +
testsuite/tests/showIface/NoExportList.stdout | 2 +
testsuite/tests/showIface/PragmaDocs.stdout | 2 +
testsuite/tests/showIface/ReExports.stdout | 2 +
utils/check-exact/ExactPrint.hs | 20 +++---
utils/check-exact/Main.hs | 8 +--
utils/haddock | 2 +-
28 files changed, 276 insertions(+), 103 deletions(-)
diff --git a/compiler/GHC/Hs/Doc.hs b/compiler/GHC/Hs/Doc.hs
index 93c0a734fe37..e7e34c5d246a 100644
--- a/compiler/GHC/Hs/Doc.hs
+++ b/compiler/GHC/Hs/Doc.hs
@@ -196,6 +196,8 @@ type DocStructure = [DocStructureItem]
data Docs = Docs
{ docs_mod_hdr :: Maybe (HsDoc GhcRn)
-- ^ Module header.
+ , docs_exports :: UniqMap Name (HsDoc GhcRn)
+ -- ^ Docs attached to module exports.
, docs_decls :: UniqMap Name [HsDoc GhcRn]
-- ^ Docs for declarations: functions, data types, instances, methods etc.
-- A list because sometimes subsequent haddock comments can be combined into one
@@ -216,14 +218,15 @@ data Docs = Docs
}
instance NFData Docs where
- rnf (Docs mod_hdr decls args structure named_chunks haddock_opts language extentions)
- = rnf mod_hdr `seq` rnf decls `seq` rnf args `seq` rnf structure `seq` rnf named_chunks
+ rnf (Docs mod_hdr exps decls args structure named_chunks haddock_opts language extentions)
+ = rnf mod_hdr `seq` rnf exps `seq` rnf decls `seq` rnf args `seq` rnf structure `seq` rnf named_chunks
`seq` rnf haddock_opts `seq` rnf language `seq` rnf extentions
`seq` ()
instance Binary Docs where
put_ bh docs = do
put_ bh (docs_mod_hdr docs)
+ put_ bh (sortBy (\a b -> (fst a) `stableNameCmp` fst b) $ nonDetUniqMapToList $ docs_exports docs)
put_ bh (sortBy (\a b -> (fst a) `stableNameCmp` fst b) $ nonDetUniqMapToList $ docs_decls docs)
put_ bh (sortBy (\a b -> (fst a) `stableNameCmp` fst b) $ nonDetUniqMapToList $ docs_args docs)
put_ bh (docs_structure docs)
@@ -233,6 +236,7 @@ instance Binary Docs where
put_ bh (docs_extensions docs)
get bh = do
mod_hdr <- get bh
+ exports <- listToUniqMap <$> get bh
decls <- listToUniqMap <$> get bh
args <- listToUniqMap <$> get bh
structure <- get bh
@@ -241,7 +245,8 @@ instance Binary Docs where
language <- get bh
exts <- get bh
pure Docs { docs_mod_hdr = mod_hdr
- , docs_decls = decls
+ , docs_exports = exports
+ , docs_decls = decls
, docs_args = args
, docs_structure = structure
, docs_named_chunks = named_chunks
@@ -254,6 +259,7 @@ instance Outputable Docs where
ppr docs =
vcat
[ pprField (pprMaybe pprHsDocDebug) "module header" docs_mod_hdr
+ , pprField (ppr . fmap pprHsDocDebug) "export docs" docs_exports
, pprField (ppr . fmap (ppr . map pprHsDocDebug)) "declaration docs" docs_decls
, pprField (ppr . fmap (pprIntMap ppr pprHsDocDebug)) "arg docs" docs_args
, pprField (vcat . map ppr) "documentation structure" docs_structure
@@ -283,6 +289,7 @@ instance Outputable Docs where
emptyDocs :: Docs
emptyDocs = Docs
{ docs_mod_hdr = Nothing
+ , docs_exports = emptyUniqMap
, docs_decls = emptyUniqMap
, docs_args = emptyUniqMap
, docs_structure = []
diff --git a/compiler/GHC/Hs/ImpExp.hs b/compiler/GHC/Hs/ImpExp.hs
index 329a38a41d97..7f025485583a 100644
--- a/compiler/GHC/Hs/ImpExp.hs
+++ b/compiler/GHC/Hs/ImpExp.hs
@@ -42,6 +42,7 @@ import GHC.Unit.Module.Warnings
import Data.Data
import Data.Maybe
+import GHC.Hs.Doc (LHsDoc)
{-
@@ -245,18 +246,17 @@ type instance XXIE (GhcPass _) = DataConCantHappen
type instance Anno (LocatedA (IE (GhcPass p))) = SrcSpanAnnA
ieName :: IE (GhcPass p) -> IdP (GhcPass p)
-ieName (IEVar _ (L _ n)) = ieWrappedName n
-ieName (IEThingAbs _ (L _ n)) = ieWrappedName n
-ieName (IEThingWith _ (L _ n) _ _) = ieWrappedName n
-ieName (IEThingAll _ (L _ n)) = ieWrappedName n
+ieName (IEVar _ (L _ n) _) = ieWrappedName n
+ieName (IEThingAbs _ (L _ n) _) = ieWrappedName n
+ieName (IEThingWith _ (L _ n) _ _ _) = ieWrappedName n
+ieName (IEThingAll _ (L _ n) _) = ieWrappedName n
ieName _ = panic "ieName failed pattern match!"
ieNames :: IE (GhcPass p) -> [IdP (GhcPass p)]
-ieNames (IEVar _ (L _ n) ) = [ieWrappedName n]
-ieNames (IEThingAbs _ (L _ n) ) = [ieWrappedName n]
-ieNames (IEThingAll _ (L _ n) ) = [ieWrappedName n]
-ieNames (IEThingWith _ (L _ n) _ ns) = ieWrappedName n
- : map (ieWrappedName . unLoc) ns
+ieNames (IEVar _ (L _ n) _) = [ieWrappedName n]
+ieNames (IEThingAbs _ (L _ n) _) = [ieWrappedName n]
+ieNames (IEThingAll _ (L _ n) _) = [ieWrappedName n]
+ieNames (IEThingWith _ (L _ n) _ ns _) = ieWrappedName n : map (ieWrappedName . unLoc) ns
-- NB the above case does not include names of field selectors
ieNames (IEModuleContents {}) = []
ieNames (IEGroup {}) = []
@@ -267,15 +267,15 @@ ieDeprecation :: forall p. IsPass p => IE (GhcPass p) -> Maybe (WarningTxt (GhcP
ieDeprecation = fmap unLoc . ie_deprecation (ghcPass @p)
where
ie_deprecation :: GhcPass p -> IE (GhcPass p) -> Maybe (LWarningTxt (GhcPass p))
- ie_deprecation GhcPs (IEVar xie _) = xie
- ie_deprecation GhcPs (IEThingAbs (xie, _) _) = xie
- ie_deprecation GhcPs (IEThingAll (xie, _) _) = xie
- ie_deprecation GhcPs (IEThingWith (xie, _) _ _ _) = xie
+ ie_deprecation GhcPs (IEVar xie _ _) = xie
+ ie_deprecation GhcPs (IEThingAbs (xie, _) _ _) = xie
+ ie_deprecation GhcPs (IEThingAll (xie, _) _ _) = xie
+ ie_deprecation GhcPs (IEThingWith (xie, _) _ _ _ _) = xie
ie_deprecation GhcPs (IEModuleContents (xie, _) _) = xie
- ie_deprecation GhcRn (IEVar xie _) = xie
- ie_deprecation GhcRn (IEThingAbs (xie, _) _) = xie
- ie_deprecation GhcRn (IEThingAll (xie, _) _) = xie
- ie_deprecation GhcRn (IEThingWith (xie, _) _ _ _) = xie
+ ie_deprecation GhcRn (IEVar xie _ _) = xie
+ ie_deprecation GhcRn (IEThingAbs (xie, _) _ _) = xie
+ ie_deprecation GhcRn (IEThingAll (xie, _) _ _) = xie
+ ie_deprecation GhcRn (IEThingWith (xie, _) _ _ _ _) = xie
ie_deprecation GhcRn (IEModuleContents xie _) = xie
ie_deprecation _ _ = Nothing
@@ -302,12 +302,31 @@ replaceWrappedName (IEType r (L l _)) n = IEType r (L l n)
replaceLWrappedName :: LIEWrappedName GhcPs -> IdP GhcRn -> LIEWrappedName GhcRn
replaceLWrappedName (L l n) n' = L l (replaceWrappedName n n')
+exportDocstring :: LHsDoc pass -> SDoc
+exportDocstring doc = braces (text "docstring: " <> ppr doc)
+
instance OutputableBndrId p => Outputable (IE (GhcPass p)) where
- ppr ie@(IEVar _ var) = sep $ catMaybes [ppr <$> ieDeprecation ie, Just $ ppr (unLoc var)]
- ppr ie@(IEThingAbs _ thing) = sep $ catMaybes [ppr <$> ieDeprecation ie, Just $ ppr (unLoc thing)]
- ppr ie@(IEThingAll _ thing) = sep $ catMaybes [ppr <$> ieDeprecation ie, Just $ hcat [ppr (unLoc thing), text "(..)"]]
- ppr ie@(IEThingWith _ thing wc withs)
- = sep $ catMaybes [ppr <$> ieDeprecation ie, Just $ ppr (unLoc thing) <> parens (fsep (punctuate comma ppWiths))]
+ ppr ie@(IEVar _ var doc) =
+ sep $ catMaybes [ ppr <$> ieDeprecation ie
+ , Just $ ppr (unLoc var)
+ , exportDocstring <$> doc
+ ]
+ ppr ie@(IEThingAbs _ thing doc) =
+ sep $ catMaybes [ ppr <$> ieDeprecation ie
+ , Just $ ppr (unLoc thing)
+ , exportDocstring <$> doc
+ ]
+ ppr ie@(IEThingAll _ thing doc) =
+ sep $ catMaybes [ ppr <$> ieDeprecation ie
+ , Just $ hcat [ppr (unLoc thing)
+ , text "(..)"]
+ , exportDocstring <$> doc
+ ]
+ ppr ie@(IEThingWith _ thing wc withs doc) =
+ sep $ catMaybes [ ppr <$> ieDeprecation ie
+ , Just $ ppr (unLoc thing) <> parens (fsep (punctuate comma ppWiths))
+ , exportDocstring <$> doc
+ ]
where
ppWiths =
case wc of
diff --git a/compiler/GHC/HsToCore/Docs.hs b/compiler/GHC/HsToCore/Docs.hs
index c5dca829f30c..1cc76ef267b8 100644
--- a/compiler/GHC/HsToCore/Docs.hs
+++ b/compiler/GHC/HsToCore/Docs.hs
@@ -73,6 +73,7 @@ extractDocs dflags
mod_docs
= Docs
{ docs_mod_hdr = th_hdr <|> doc_hdr
+ , docs_exports = exports_docs
-- Left biased union (see #21220)
, docs_decls = plusUniqMap_C (\a _ -> a)
((:[]) <$> th_decl_docs `plusUniqMap` th_inst_docs)
@@ -100,6 +101,7 @@ extractDocs dflags
, isDefaultMethodOcc occ
]
+ exports_docs = maybe emptyUniqMap mkExportsDocs mb_rn_exports
(doc_map, arg_map) = mkMaps def_meths_env local_insts decls_with_docs
decls_with_docs = topDecls rn_decls
local_insts = filter (nameIsLocalOrFrom semantic_mdl)
@@ -109,6 +111,25 @@ extractDocs dflags
named_chunks = getNamedChunks (isJust mb_rn_exports) rn_decls
extractDocs _ _ = pure Nothing
+mkExportsDocs :: [(LIE GhcRn, Avails)] -> UniqMap Name (HsDoc GhcRn)
+mkExportsDocs = foldMap f
+ where
+ f :: (LIE GhcRn, Avails) -> UniqMap Name (HsDoc GhcRn)
+ f (L _ ie, avails)
+ | Just (L _ doc) <- ieExportDoc ie =
+ listToUniqMap [ (availName nm, doc) | nm <- avails ]
+ f _ = emptyUniqMap
+
+ ieExportDoc :: IE GhcRn -> Maybe (ExportDoc GhcRn)
+ ieExportDoc (IEVar _ _ doc) = doc
+ ieExportDoc (IEThingAbs _ _ doc) = doc
+ ieExportDoc (IEThingAll _ _ doc) = doc
+ ieExportDoc (IEThingWith _ _ _ _ doc) = doc
+ ieExportDoc (IEModuleContents _ _) = Nothing
+ ieExportDoc (IEGroup _ _ _) = Nothing
+ ieExportDoc (IEDoc _ _) = Nothing
+ ieExportDoc (IEDocNamed _ _) = Nothing
+
-- | If we have an explicit export list, we extract the documentation structure
-- from that.
-- Otherwise we use the renamed exports and declarations.
diff --git a/compiler/GHC/Iface/Ext/Ast.hs b/compiler/GHC/Iface/Ext/Ast.hs
index 09cc0dfef19a..9e8490f3f815 100644
--- a/compiler/GHC/Iface/Ext/Ast.hs
+++ b/compiler/GHC/Iface/Ext/Ast.hs
@@ -2191,16 +2191,16 @@ instance ToHie (LocatedA (ImportDecl GhcRn)) where
instance ToHie (IEContext (LocatedA (IE GhcRn))) where
toHie (IEC c (L span ie)) = concatM $ makeNode ie (locA span) : case ie of
- IEVar _ n ->
+ IEVar _ n _ ->
[ toHie $ IEC c n
]
- IEThingAbs _ n ->
+ IEThingAbs _ n _ ->
[ toHie $ IEC c n
]
- IEThingAll _ n ->
+ IEThingAll _ n _ ->
[ toHie $ IEC c n
]
- IEThingWith _ n _ ns ->
+ IEThingWith _ n _ ns _ ->
[ toHie $ IEC c n
, toHie $ map (IEC c) ns
]
diff --git a/compiler/GHC/Parser.y b/compiler/GHC/Parser.y
index 9835652f4e72..20b1cbca2bea 100644
--- a/compiler/GHC/Parser.y
+++ b/compiler/GHC/Parser.y
@@ -989,7 +989,7 @@ exportlist :: { ([AddEpAnn], OrdList (LIE GhcPs)) }
| ',' { ([mj AnnComma $1], nilOL) }
exportlist1 :: { OrdList (LIE GhcPs) }
- : exportlist1 ',' export
+ : exportlist1 ',' export_cs
{% let ls = $1
in if isNilOL ls
then return (ls `appOL` $3)
@@ -997,21 +997,24 @@ exportlist1 :: { OrdList (LIE GhcPs) }
SnocOL hs t -> do
t' <- addTrailingCommaA t (gl $2)
return (snocOL hs t' `appOL` $3)}
- | export { $1 }
+ | export_cs { $1 }
+export_cs :: { OrdList (LIE GhcPs) }
+export_cs : export {% return (unitOL $1) }
+
-- No longer allow things like [] and (,,,) to be exported
-- They are built in syntax, always available
-export :: { OrdList (LIE GhcPs) }
+export :: { LIE GhcPs }
: maybe_warning_pragma qcname_ext export_subspec {% do { let { span = (maybe comb2 comb3 $1) $2 $> }
; impExp <- mkModuleImpExp $1 (fst $ unLoc $3) $2 (snd $ unLoc $3)
- ; return $ unitOL $ reLoc $ sL span $ impExp } }
+ ; return $ reLoc $ sL span $ impExp } }
| maybe_warning_pragma 'module' modid {% do { let { span = (maybe comb2 comb3 $1) $2 $>
- ; anchor = (maybe glR (\loc -> spanAsAnchor . comb2 loc) $1) $2 }
+ ; anchor = (maybe glR (\loc -> spanAsAnchor . comb2 loc) $1) $2 }
; locImpExp <- return (sL span (IEModuleContents ($1, [mj AnnModule $2]) $3))
- ; return $ unitOL $ reLoc $ locImpExp } }
+ ; return $ reLoc $ locImpExp } }
| maybe_warning_pragma 'pattern' qcon { let span = (maybe comb2 comb3 $1) $2 $>
- in unitOL $ reLoc $ sL span $ IEVar $1 (sLLa $2 $> (IEPattern (glAA $2) $3)) }
+ in reLoc $ sL span $ IEVar $1 (sLLa $2 $> (IEPattern (glAA $2) $3)) Nothing }
export_subspec :: { Located ([AddEpAnn],ImpExpSubSpec) }
: {- empty -} { sL0 ([],ImpExpAbs) }
@@ -1180,7 +1183,7 @@ importlist1 :: { OrdList (LIE GhcPs) }
import :: { OrdList (LIE GhcPs) }
: qcname_ext export_subspec {% fmap (unitOL . reLoc . (sLL $1 $>)) $ mkModuleImpExp Nothing (fst $ unLoc $2) $1 (snd $ unLoc $2) }
| 'module' modid {% fmap (unitOL . reLoc) $ return (sLL $1 $> (IEModuleContents (Nothing, [mj AnnModule $1]) $2)) }
- | 'pattern' qcon { unitOL $ reLoc $ sLL $1 $> $ IEVar Nothing (sLLa $1 $> (IEPattern (glAA $1) $2)) }
+ | 'pattern' qcon { unitOL $ reLoc $ sLL $1 $> $ IEVar Nothing (sLLa $1 $> (IEPattern (glAA $1) $2)) Nothing }
-----------------------------------------------------------------------------
-- Fixity Declarations
diff --git a/compiler/GHC/Parser/PostProcess.hs b/compiler/GHC/Parser/PostProcess.hs
index f27bc529c94b..8193e1712c8f 100644
--- a/compiler/GHC/Parser/PostProcess.hs
+++ b/compiler/GHC/Parser/PostProcess.hs
@@ -2850,12 +2850,12 @@ mkModuleImpExp warning anns (L l specname) subs = do
ImpExpAbs
| isVarNameSpace (rdrNameSpace name)
-> return $ IEVar warning
- (L l (ieNameFromSpec specname))
- | otherwise -> IEThingAbs (warning, anns) . L l <$> nameT
- ImpExpAll -> IEThingAll (warning, anns) . L l <$> nameT
+ (L l (ieNameFromSpec specname)) Nothing
+ | otherwise -> IEThingAbs (warning, anns) . L l <$> nameT <*> pure noExportDoc
+ ImpExpAll -> IEThingAll (warning, anns) . L l <$> nameT <*> pure noExportDoc
ImpExpList xs ->
(\newName -> IEThingWith (warning, anns) (L l newName)
- NoIEWildcard (wrapped xs)) <$> nameT
+ NoIEWildcard (wrapped xs)) <$> nameT <*> pure noExportDoc
ImpExpAllWith xs ->
do allowed <- getBit PatternSynonymsBit
if allowed
@@ -2867,10 +2867,13 @@ mkModuleImpExp warning anns (L l specname) subs = do
ies = wrapped $ filter (not . isImpExpQcWildcard . unLoc) xs
in (\newName
-> IEThingWith (warning, anns) (L l newName) pos ies)
- <$> nameT
+ <$> nameT <*> pure noExportDoc
else addFatalError $ mkPlainErrorMsgEnvelope (locA l) $
PsErrIllegalPatSynExport
where
+ noExportDoc :: Maybe (LHsDoc GhcPs)
+ noExportDoc = Nothing
+
name = ieNameVal specname
nameT =
if isVarNameSpace (rdrNameSpace name)
@@ -2897,7 +2900,7 @@ mkTypeImpExp name =
checkImportSpec :: LocatedL [LIE GhcPs] -> P (LocatedL [LIE GhcPs])
checkImportSpec ie@(L _ specs) =
- case [l | (L l (IEThingWith _ _ (IEWildcard _) _)) <- specs] of
+ case [l | (L l (IEThingWith _ _ (IEWildcard _) _ _)) <- specs] of
[] -> return ie
(l:_) -> importSpecError (locA l)
where
diff --git a/compiler/GHC/Parser/PostProcess/Haddock.hs b/compiler/GHC/Parser/PostProcess/Haddock.hs
index a5a7da6ec1f2..2ca6813c1aae 100644
--- a/compiler/GHC/Parser/PostProcess/Haddock.hs
+++ b/compiler/GHC/Parser/PostProcess/Haddock.hs
@@ -299,7 +299,7 @@ lexHsDocString = lexHsDoc parseIdentifier
lexLHsDocString :: Located HsDocString -> LHsDoc GhcPs
lexLHsDocString = fmap lexHsDocString
--- Only for module exports, not module imports.
+-- | Only for module exports, not module imports.
--
-- module M (a, b, c) where -- use on this [LIE GhcPs]
-- import I (a, b, c) -- do not use here!
@@ -314,7 +314,19 @@ instance HasHaddock (LocatedL [LocatedA (IE GhcPs)]) where
-- Needed to use 'addHaddockInterleaveItems' in 'instance HasHaddock (Located [LIE GhcPs])'.
instance HasHaddock (LocatedA (IE GhcPs)) where
- addHaddock a = a <$ registerHdkA a
+ addHaddock (L l_export ie ) =
+ extendHdkA (locA l_export) $ liftHdkA $ do
+ docs <- inLocRange (locRangeFrom (getBufPos (srcSpanEnd (locA l_export)))) $
+ takeHdkComments mkDocPrev
+ mb_doc <- selectDocString docs
+ let mb_ldoc = lexLHsDocString <$> mb_doc
+ let ie' = case ie of
+ IEVar ext nm _ -> IEVar ext nm mb_ldoc
+ IEThingAbs ext nm _ -> IEThingAbs ext nm mb_ldoc
+ IEThingAll ext nm _ -> IEThingAll ext nm mb_ldoc
+ IEThingWith ext nm wild subs _ -> IEThingWith ext nm wild subs mb_ldoc
+ x -> x
+ pure $ L l_export ie'
{- Add Haddock items to a list of non-Haddock items.
Used to process export lists (with mkDocIE) and declarations (with mkDocHsDecl).
diff --git a/compiler/GHC/Rename/Names.hs b/compiler/GHC/Rename/Names.hs
index c47e30af4c59..015e4d7ae32b 100644
--- a/compiler/GHC/Rename/Names.hs
+++ b/compiler/GHC/Rename/Names.hs
@@ -1318,7 +1318,7 @@ filterImports hsc_env iface decl_spec (Just (want_hiding, L l import_items))
-> IELookupM ([(IE GhcRn, [GlobalRdrElt])], [IELookupWarning])
lookup_ie ie = handle_bad_import $
case ie of
- IEVar _ (L l n) -> do
+ IEVar _ (L l n) _ -> do
-- See Note [Importing DuplicateRecordFields]
xs <- lookup_names ie (ieWrappedName n)
let gres = map imp_item $ NE.toList xs
@@ -1326,12 +1326,12 @@ filterImports hsc_env iface decl_spec (Just (want_hiding, L l import_items))
| want_hiding == Exactly
= mapMaybe mk_depr_export_warning gres
| otherwise = []
- return ( [ (IEVar Nothing (L l (replaceWrappedName n name)), [gre])
+ return ( [ (IEVar Nothing (L l (replaceWrappedName n name)) noDocstring, [gre])
| gre <- gres
, let name = greName gre ]
, export_depr_warns )
- IEThingAll _ (L l tc) -> do
+ IEThingAll _ (L l tc) _ -> do
ImpOccItem { imp_item = gre
, imp_bundled = bundled_gres
, imp_is_parent = is_par
@@ -1352,7 +1352,7 @@ filterImports hsc_env iface decl_spec (Just (want_hiding, L l import_items))
| otherwise
= []
- renamed_ie = IEThingAll (Nothing, noAnn) (L l (replaceWrappedName tc name))
+ renamed_ie = IEThingAll (Nothing, noAnn) (L l (replaceWrappedName tc name)) noDocstring
export_depr_warn
| want_hiding == Exactly
= maybeToList $ mk_depr_export_warning gre
@@ -1365,7 +1365,7 @@ filterImports hsc_env iface decl_spec (Just (want_hiding, L l import_items))
, imp_list_warn ++ export_depr_warn)
- IEThingAbs _ (L l tc')
+ IEThingAbs _ (L l tc') _
| want_hiding == EverythingBut -- hiding ( C )
-- Here the 'C' can be a data constructor
-- *or* a type/class, or even both
@@ -1381,9 +1381,9 @@ filterImports hsc_env iface decl_spec (Just (want_hiding, L l import_items))
return ( [mkIEThingAbs tc' l gre]
, maybeToList $ mk_depr_export_warning gre)
- IEThingWith (deprecation, ann) ltc@(L l rdr_tc) wc rdr_ns -> do
+ IEThingWith (deprecation, ann) ltc@(L l rdr_tc) wc rdr_ns _ -> do
ImpOccItem { imp_item = gre, imp_bundled = subnames }
- <- lookup_parent (IEThingAbs (Nothing, noAnn) ltc) (ieWrappedName rdr_tc)
+ <- lookup_parent (IEThingAbs (Nothing, noAnn) ltc noDocstring) (ieWrappedName rdr_tc)
let name = greName gre
-- Look up the children in the sub-names of the parent
@@ -1391,14 +1391,14 @@ filterImports hsc_env iface decl_spec (Just (want_hiding, L l import_items))
case lookupChildren subnames rdr_ns of
Failed rdrs -> failLookupWith $
- BadImport (IEThingWith (deprecation, ann) ltc wc rdrs) IsSubordinate
+ BadImport (IEThingWith (deprecation, ann) ltc wc rdrs noDocstring) IsSubordinate
-- We are trying to import T( a,b,c,d ), and failed
-- to find 'b' and 'd'. So we make up an import item
-- to report as failing, namely T( b, d ).
-- c.f. #15412
Succeeded childnames ->
- return ([ (IEThingWith (Nothing, ann) (L l name') wc childnames'
+ return ([ (IEThingWith (Nothing, ann) (L l name') wc childnames' noDocstring
,gres)]
, export_depr_warns)
@@ -1415,9 +1415,12 @@ filterImports hsc_env iface decl_spec (Just (want_hiding, L l import_items))
where
mkIEThingAbs tc l gre
- = (IEThingAbs (Nothing, noAnn) (L l (replaceWrappedName tc n)), [gre])
+ = (IEThingAbs (Nothing, noAnn) (L l (replaceWrappedName tc n)) noDocstring, [gre])
where n = greName gre
+ -- N.B. imports never have docstrings
+ noDocstring = Nothing
+
handle_bad_import m = catchIELookup m $ \err -> case err of
BadImport ie _
| want_hiding == EverythingBut
@@ -1574,8 +1577,8 @@ gresFromIE decl_spec (L loc ie, gres)
= map set_gre_imp gres
where
is_explicit = case ie of
- IEThingAll _ name -> \n -> n == lieWrappedName name
- _ -> \_ -> True
+ IEThingAll _ name _ -> \n -> n == lieWrappedName name
+ _ -> \_ -> True
prov_fn name
= ImpSpec { is_decl = decl_spec, is_item = item_spec }
where
@@ -1880,10 +1883,10 @@ findImportUsage imports used_gres
_other -> emptyNameSet -- No explicit import list => no unused-name list
add_unused :: IE GhcRn -> NameSet -> NameSet
- add_unused (IEVar _ n) acc = add_unused_name (lieWrappedName n) acc
- add_unused (IEThingAbs _ n) acc = add_unused_name (lieWrappedName n) acc
- add_unused (IEThingAll _ n) acc = add_unused_all (lieWrappedName n) acc
- add_unused (IEThingWith _ p wc ns) acc =
+ add_unused (IEVar _ n _) acc = add_unused_name (lieWrappedName n) acc
+ add_unused (IEThingAbs _ n _) acc = add_unused_name (lieWrappedName n) acc
+ add_unused (IEThingAll _ n _) acc = add_unused_all (lieWrappedName n) acc
+ add_unused (IEThingWith _ p wc ns _) acc =
add_wc_all (add_unused_with pn xs acc)
where pn = lieWrappedName p
xs = map lieWrappedName ns
@@ -2051,10 +2054,10 @@ getMinimalImports ie_decls
to_ie rdr_env _ (Avail c) -- Note [Overloaded field import]
= do { let
gre = expectJust "getMinimalImports Avail" $ lookupGRE_Name rdr_env c
- ; return $ [IEVar Nothing (to_ie_post_rn $ noLocA $ greName gre)] }
+ ; return $ [IEVar Nothing (to_ie_post_rn $ noLocA $ greName gre) Nothing] }
to_ie _ _ avail@(AvailTC n [_]) -- Exporting the main decl and nothing else
| availExportsDecl avail
- = return [IEThingAbs (Nothing, noAnn) (to_ie_post_rn $ noLocA n)]
+ = return [IEThingAbs (Nothing, noAnn) (to_ie_post_rn $ noLocA n) Nothing]
to_ie rdr_env iface (AvailTC n cs) =
case [ xs | avail@(AvailTC x xs) <- mi_exports iface
, x == n
@@ -2062,12 +2065,12 @@ getMinimalImports ie_decls
] of
[xs]
| all_used xs
- -> return [IEThingAll (Nothing, noAnn) (to_ie_post_rn $ noLocA n)]
+ -> return [IEThingAll (Nothing, noAnn) (to_ie_post_rn $ noLocA n) Nothing]
| otherwise
-> do { let ns_gres = map (expectJust "getMinimalImports AvailTC" . lookupGRE_Name rdr_env) cs
ns = map greName ns_gres
; return [IEThingWith (Nothing, noAnn) (to_ie_post_rn $ noLocA n) NoIEWildcard
- (map (to_ie_post_rn . noLocA) (filter (/= n) ns))] }
+ (map (to_ie_post_rn . noLocA) (filter (/= n) ns)) Nothing] }
-- Note [Overloaded field import]
_other
-> do { let infos = map (expectJust "getMinimalImports AvailTC" . lookupGRE_Name rdr_env) cs
@@ -2076,9 +2079,9 @@ getMinimalImports ie_decls
fs = map fieldGREInfo fs_gres
; return $
if all_non_overloaded fs
- then map (IEVar Nothing . to_ie_post_rn_var . noLocA) ns
+ then map (\nm -> IEVar Nothing (to_ie_post_rn_var $ noLocA nm) Nothing) ns
else [IEThingWith (Nothing, noAnn) (to_ie_post_rn $ noLocA n) NoIEWildcard
- (map (to_ie_post_rn . noLocA) (filter (/= n) ns))] }
+ (map (to_ie_post_rn . noLocA) (filter (/= n) ns)) Nothing] }
where
all_used avail_cs = all (`elem` cs) avail_cs
@@ -2263,7 +2266,7 @@ badImportItemErr iface decl_spec ie sub avails = do
imp_spec = ImpSpec { is_decl = decl_spec, is_item = ImpAll }
all_avails = mi_exports iface
unavailableChildren = case ie of
- IEThingWith _ _ _ ns -> map (rdrNameOcc . ieWrappedName . unLoc) ns
+ IEThingWith _ _ _ ns _ -> map (rdrNameOcc . ieWrappedName . unLoc) ns
_ -> panic "importedChildren failed pattern match: no children"
addDupDeclErr :: NonEmpty GlobalRdrElt -> TcRn ()
diff --git a/compiler/GHC/Tc/Errors/Ppr.hs b/compiler/GHC/Tc/Errors/Ppr.hs
index 1801c1f60b3a..9ed29c8a4438 100644
--- a/compiler/GHC/Tc/Errors/Ppr.hs
+++ b/compiler/GHC/Tc/Errors/Ppr.hs
@@ -3340,7 +3340,7 @@ dodgy_msg kind tc ie
, text "but it is not a type constructor or a class" ]
dodgy_msg_insert :: GlobalRdrElt -> IE GhcRn
-dodgy_msg_insert tc_gre = IEThingAll (Nothing, noAnn) ii
+dodgy_msg_insert tc_gre = IEThingAll (Nothing, noAnn) ii Nothing
where
ii = noLocA (IEName noExtField $ noLocA $ greName tc_gre)
diff --git a/compiler/GHC/Tc/Gen/Export.hs b/compiler/GHC/Tc/Gen/Export.hs
index 2ed30cbe123d..e18819853871 100644
--- a/compiler/GHC/Tc/Gen/Export.hs
+++ b/compiler/GHC/Tc/Gen/Export.hs
@@ -206,7 +206,7 @@ rnExports explicit_mod exports
| explicit_mod = exports
| has_main
= Just (noLocA [noLocA (IEVar Nothing
- (noLocA (IEName noExtField $ noLocA default_main)))])
+ (noLocA (IEName noExtField $ noLocA default_main)) Nothing)])
-- ToDo: the 'noLoc' here is unhelpful if 'main'
-- turns out to be out of scope
| otherwise = Nothing
@@ -391,7 +391,7 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod
expacc_exp_occs = occs,
expacc_warn_spans = export_warn_spans,
expacc_dont_warn = dont_warn_export
- } (L loc ie@(IEVar warn_txt_ps l))
+ } (L loc ie@(IEVar warn_txt_ps l doc))
= do mb_gre <- lookupGreAvailRn $ lieWrappedName l
for mb_gre $ \ gre -> do
let avail = availFromGRE gre
@@ -405,17 +405,18 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod
warn_txt_ps
(locA loc)
+ doc' <- traverse rnLHsDoc doc
return ( expacc{ expacc_exp_occs = occs'
, expacc_warn_spans = export_warn_spans'
, expacc_dont_warn = dont_warn_export' }
- , L loc (IEVar warn_txt_rn (replaceLWrappedName l name))
+ , L loc (IEVar warn_txt_rn (replaceLWrappedName l name) doc')
, avail )
lookup_ie expacc@ExportAccum{
expacc_exp_occs = occs,
expacc_warn_spans = export_warn_spans,
expacc_dont_warn = dont_warn_export
- } (L loc ie@(IEThingAbs (warn_txt_ps, ann) l))
+ } (L loc ie@(IEThingAbs (warn_txt_ps, ann) l doc))
= do mb_gre <- lookupGreAvailRn $ lieWrappedName l
for mb_gre $ \ gre -> do
let avail = availFromGRE gre
@@ -429,17 +430,18 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod
warn_txt_ps
(locA loc)
+ doc' <- traverse rnLHsDoc doc
return ( expacc{ expacc_exp_occs = occs'
, expacc_warn_spans = export_warn_spans'
, expacc_dont_warn = dont_warn_export' }
- , L loc (IEThingAbs (warn_txt_rn, ann) (replaceLWrappedName l name))
+ , L loc (IEThingAbs (warn_txt_rn, ann) (replaceLWrappedName l name) doc')
, avail )
lookup_ie expacc@ExportAccum{
expacc_exp_occs = occs,
expacc_warn_spans = export_warn_spans,
expacc_dont_warn = dont_warn_export
- } (L loc ie@(IEThingAll (warn_txt_ps, ann) l))
+ } (L loc ie@(IEThingAll (warn_txt_ps, ann) l doc))
= do mb_gre <- lookupGreAvailRn $ lieWrappedName l
for mb_gre $ \ par -> do
all_kids <- lookup_ie_kids_all ie l par
@@ -455,17 +457,18 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod
warn_txt_ps
(locA loc)
+ doc' <- traverse rnLHsDoc doc
return ( expacc{ expacc_exp_occs = occs'
, expacc_warn_spans = export_warn_spans'
, expacc_dont_warn = dont_warn_export' }
- , L loc (IEThingAll (warn_txt_rn, ann) (replaceLWrappedName l name))
+ , L loc (IEThingAll (warn_txt_rn, ann) (replaceLWrappedName l name) doc')
, AvailTC name all_names )
lookup_ie expacc@ExportAccum{
expacc_exp_occs = occs,
expacc_warn_spans = export_warn_spans,
expacc_dont_warn = dont_warn_export
- } (L loc ie@(IEThingWith (warn_txt_ps, ann) l wc sub_rdrs))
+ } (L loc ie@(IEThingWith (warn_txt_ps, ann) l wc sub_rdrs doc))
= do mb_gre <- addExportErrCtxt ie
$ lookupGreAvailRn $ lieWrappedName l
for mb_gre $ \ par -> do
@@ -491,10 +494,11 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod
warn_txt_ps
(locA loc)
+ doc' <- traverse rnLHsDoc doc
return ( expacc{ expacc_exp_occs = occs'
, expacc_warn_spans = export_warn_spans'
, expacc_dont_warn = dont_warn_export' }
- , L loc (IEThingWith (warn_txt_rn, ann) (replaceLWrappedName l name) wc subs)
+ , L loc (IEThingWith (warn_txt_rn, ann) (replaceLWrappedName l name) wc subs doc')
, AvailTC name all_names )
lookup_ie _ _ = panic "lookup_ie" -- Other cases covered earlier
@@ -903,7 +907,7 @@ dupExport_ok child ie1 ie2
|| (explicit_in ie1 && explicit_in ie2) )
where
explicit_in (IEModuleContents {}) = False -- module M
- explicit_in (IEThingAll _ r)
+ explicit_in (IEThingAll _ r _)
= occName child == rdrNameOcc (ieWrappedName $ unLoc r) -- T(..)
explicit_in _ = True
diff --git a/compiler/Language/Haskell/Syntax/ImpExp.hs b/compiler/Language/Haskell/Syntax/ImpExp.hs
index 08be6380030f..8c7e2901fb94 100644
--- a/compiler/Language/Haskell/Syntax/ImpExp.hs
+++ b/compiler/Language/Haskell/Syntax/ImpExp.hs
@@ -94,28 +94,45 @@ type LIE pass = XRec pass (IE pass)
-- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
+-- | A docstring attached to an export list item.
+type ExportDoc pass = LHsDoc pass
+
-- | Imported or exported entity.
data IE pass
- = IEVar (XIEVar pass) (LIEWrappedName pass)
- -- ^ Imported or Exported Variable
+ = IEVar (XIEVar pass) (LIEWrappedName pass) (Maybe (ExportDoc pass))
+ -- ^ Imported or exported variable
+ --
+ -- @
+ -- module Mod ( test )
+ -- import Mod ( test )
+ -- @
- | IEThingAbs (XIEThingAbs pass) (LIEWrappedName pass)
- -- ^ Imported or exported Thing with Absent list
+ | IEThingAbs (XIEThingAbs pass) (LIEWrappedName pass) (Maybe (ExportDoc pass))
+ -- ^ Imported or exported Thing with absent subordinate list
--
- -- The thing is a Class/Type (can't tell)
+ -- The thing is a typeclass or type (can't tell)
-- - 'GHC.Parser.Annotation.AnnKeywordId's : 'GHC.Parser.Annotation.AnnPattern',
-- 'GHC.Parser.Annotation.AnnType','GHC.Parser.Annotation.AnnVal'
+ --
+ -- @
+ -- module Mod ( Test )
+ -- import Mod ( Test )
+ -- @
-- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
-- See Note [Located RdrNames] in GHC.Hs.Expr
- | IEThingAll (XIEThingAll pass) (LIEWrappedName pass)
- -- ^ Imported or exported Thing with All imported or exported
+ | IEThingAll (XIEThingAll pass) (LIEWrappedName pass) (Maybe (ExportDoc pass))
+ -- ^ Imported or exported thing with wildcard subordinate list (e..g @(..)@)
--
-- The thing is a Class/Type and the All refers to methods/constructors
--
-- - 'GHC.Parser.Annotation.AnnKeywordId's : 'GHC.Parser.Annotation.AnnOpen',
-- 'GHC.Parser.Annotation.AnnDotdot','GHC.Parser.Annotation.AnnClose',
-- 'GHC.Parser.Annotation.AnnType'
+ -- @
+ -- module Mod ( Test(..) )
+ -- import Mod ( Test(..) )
+ -- @
-- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
-- See Note [Located RdrNames] in GHC.Hs.Expr
@@ -124,7 +141,8 @@ data IE pass
(LIEWrappedName pass)
IEWildcard
[LIEWrappedName pass]
- -- ^ Imported or exported Thing With given imported or exported
+ (Maybe (ExportDoc pass))
+ -- ^ Imported or exported thing with explicit subordinate list.
--
-- The thing is a Class/Type and the imported or exported things are
-- its children.
@@ -132,6 +150,10 @@ data IE pass
-- 'GHC.Parser.Annotation.AnnClose',
-- 'GHC.Parser.Annotation.AnnComma',
-- 'GHC.Parser.Annotation.AnnType'
+ -- @
+ -- module Mod ( Test(..) )
+ -- import Mod ( Test(..) )
+ -- @
-- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
| IEModuleContents (XIEModuleContents pass) (XRec pass ModuleName)
@@ -140,11 +162,39 @@ data IE pass
-- (Export Only)
--
-- - 'GHC.Parser.Annotation.AnnKeywordId's : 'GHC.Parser.Annotation.AnnModule'
+ --
+ -- @
+ -- module Mod ( module Mod2 )
+ -- @
-- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
| IEGroup (XIEGroup pass) Int (LHsDoc pass) -- ^ Doc section heading
+ -- ^ A Haddock section in an export list.
+ --
+ -- @
+ -- module Mod
+ -- ( -- * Section heading
+ -- ...
+ -- )
+ -- @
| IEDoc (XIEDoc pass) (LHsDoc pass) -- ^ Some documentation
+ -- ^ A bit of unnamed documentation.
+ --
+ -- @
+ -- module Mod
+ -- ( -- | Documentation
+ -- ...
+ -- )
+ -- @
| IEDocNamed (XIEDocNamed pass) String -- ^ Reference to named doc
+ -- ^ A reference to a named documentation chunk.
+ --
+ -- @
+ -- module Mod
+ -- ( -- $chunkName
+ -- ...
+ -- )
+ -- @
| XIE !(XXIE pass)
-- | Wildcard in an import or export sublist, like the @..@ in
diff --git a/testsuite/tests/haddock/haddock_examples/Test.hs b/testsuite/tests/haddock/haddock_examples/Test.hs
index 71744f73257a..18d2f54addca 100644
--- a/testsuite/tests/haddock/haddock_examples/Test.hs
+++ b/testsuite/tests/haddock/haddock_examples/Test.hs
@@ -98,6 +98,13 @@ module Test (
-}
f',
+
+ -- * Test that export @since declarations work
+ since1, -- ^ @since 1.0
+ since2 -- ^ @since 2.0
+ , since3 -- ^ @since 3.0
+ , SinceType(..) -- ^ @since 4.0
+ , SinceClass(..) -- ^ @since 5.0
) where
import Hidden
@@ -406,3 +413,11 @@ type CInt = Int
k = undefined
l = undefined
m = undefined
+
+since1 = undefined
+since2 = undefined
+since3 = undefined
+
+data SinceType = SinceType
+class SinceClass a where
+
diff --git a/testsuite/tests/haddock/haddock_examples/haddock.Test.stderr b/testsuite/tests/haddock/haddock_examples/haddock.Test.stderr
index 3f194aed68ce..69fd92b0ad61 100644
--- a/testsuite/tests/haddock/haddock_examples/haddock.Test.stderr
+++ b/testsuite/tests/haddock/haddock_examples/haddock.Test.stderr
@@ -53,7 +53,11 @@ module Test (
> a literal line
$ a non /literal/ line $
-, f'
+, f', <IEGroup: 1>,
+ since1 {docstring: @since 1.0}, since2 {docstring: @since 2.0},
+ since3 {docstring: @since 3.0},
+ SinceType(..) {docstring: @since 4.0},
+ SinceClass(..) {docstring: @since 5.0}
) where
import Hidden
import Visible
@@ -223,6 +227,11 @@ type CInt = Int
k = undefined
l = undefined
m = undefined
+since1 = undefined
+since2 = undefined
+since3 = undefined
+data SinceType = SinceType
+class SinceClass a
diff --git a/testsuite/tests/parser/should_compile/DumpRenamedAst.stderr b/testsuite/tests/parser/should_compile/DumpRenamedAst.stderr
index 87d8cd20e349..6e04633f639f 100644
--- a/testsuite/tests/parser/should_compile/DumpRenamedAst.stderr
+++ b/testsuite/tests/parser/should_compile/DumpRenamedAst.stderr
@@ -2397,7 +2397,8 @@
[])
(EpaComments
[]))
- {Name: GHC.Types.Type})))))])))))]
+ {Name: GHC.Types.Type})))
+ (Nothing)))])))))]
(Nothing)
(Nothing)))
diff --git a/testsuite/tests/parser/should_compile/T14189.stderr b/testsuite/tests/parser/should_compile/T14189.stderr
index f961ec214f8f..4fc563a56b78 100644
--- a/testsuite/tests/parser/should_compile/T14189.stderr
+++ b/testsuite/tests/parser/should_compile/T14189.stderr
@@ -309,7 +309,8 @@
[])
(EpaComments
[]))
- {Name: T14189.NT})))]))
+ {Name: T14189.NT})))]
+ (Nothing)))
[(AvailTC
{Name: T14189.MyType}
[{Name: T14189.MyType}
diff --git a/testsuite/tests/showIface/DocsInHiFile1.stdout b/testsuite/tests/showIface/DocsInHiFile1.stdout
index 1c737e28f3cc..6d272ef41935 100644
--- a/testsuite/tests/showIface/DocsInHiFile1.stdout
+++ b/testsuite/tests/showIface/DocsInHiFile1.stdout
@@ -16,6 +16,8 @@ docs:
GHC.Base.<>
{DocsInHiFile.hs:4:15-18}
GHC.Types.Bool
+ export docs:
+ []
declaration docs:
[elem -> [text:
-- | '()', 'elem'.
diff --git a/testsuite/tests/showIface/DocsInHiFileTH.stdout b/testsuite/tests/showIface/DocsInHiFileTH.stdout
index 1eac242a68cf..86d67fc60dfb 100644
--- a/testsuite/tests/showIface/DocsInHiFileTH.stdout
+++ b/testsuite/tests/showIface/DocsInHiFileTH.stdout
@@ -3,6 +3,8 @@ docs:
Just text:
-- |This is the new module header
identifiers:
+ export docs:
+ []
declaration docs:
[Tup2 -> [text:
-- |Matches a tuple of (a, a)
diff --git a/testsuite/tests/showIface/HaddockIssue849.stdout b/testsuite/tests/showIface/HaddockIssue849.stdout
index 197f83df6248..baf611627202 100644
--- a/testsuite/tests/showIface/HaddockIssue849.stdout
+++ b/testsuite/tests/showIface/HaddockIssue849.stdout
@@ -1,6 +1,8 @@
docs:
Just module header:
Nothing
+ export docs:
+ []
declaration docs:
[]
arg docs:
diff --git a/testsuite/tests/showIface/HaddockOpts.stdout b/testsuite/tests/showIface/HaddockOpts.stdout
index 60a05354572b..b3f057e50eb2 100644
--- a/testsuite/tests/showIface/HaddockOpts.stdout
+++ b/testsuite/tests/showIface/HaddockOpts.stdout
@@ -1,6 +1,8 @@
docs:
Just module header:
Nothing
+ export docs:
+ []
declaration docs:
[]
arg docs:
diff --git a/testsuite/tests/showIface/HaddockSpanIssueT24378.stdout b/testsuite/tests/showIface/HaddockSpanIssueT24378.stdout
index fe1c252cb7a6..4a5c661a6871 100644
--- a/testsuite/tests/showIface/HaddockSpanIssueT24378.stdout
+++ b/testsuite/tests/showIface/HaddockSpanIssueT24378.stdout
@@ -16,6 +16,8 @@ docs:
GHC.Base.<>
{HaddockSpanIssueT24378.hs:3:15-18}
GHC.Types.Bool
+ export docs:
+ []
declaration docs:
[elem -> [text:
{-| '()', 'elem'.-}
@@ -81,3 +83,4 @@ docs:
StandaloneKindSignatures
FieldSelectors
extensible fields:
+
diff --git a/testsuite/tests/showIface/LanguageExts.stdout b/testsuite/tests/showIface/LanguageExts.stdout
index 1e0a2a89bee9..30f8b9c1301b 100644
--- a/testsuite/tests/showIface/LanguageExts.stdout
+++ b/testsuite/tests/showIface/LanguageExts.stdout
@@ -1,6 +1,8 @@
docs:
Just module header:
Nothing
+ export docs:
+ []
declaration docs:
[]
arg docs:
diff --git a/testsuite/tests/showIface/MagicHashInHaddocks.stdout b/testsuite/tests/showIface/MagicHashInHaddocks.stdout
index 3b3d44f08d86..d105d04801f6 100644
--- a/testsuite/tests/showIface/MagicHashInHaddocks.stdout
+++ b/testsuite/tests/showIface/MagicHashInHaddocks.stdout
@@ -7,6 +7,8 @@ docs:
foo#
{MagicHashInHaddocks.hs:3:14-18}
Bar##
+ export docs:
+ []
declaration docs:
[]
arg docs:
diff --git a/testsuite/tests/showIface/NoExportList.stdout b/testsuite/tests/showIface/NoExportList.stdout
index 3fec2d6c880a..fb8d3e8e4b3b 100644
--- a/testsuite/tests/showIface/NoExportList.stdout
+++ b/testsuite/tests/showIface/NoExportList.stdout
@@ -3,6 +3,8 @@ docs:
Just text:
-- | Module header
identifiers:
+ export docs:
+ []
declaration docs:
[fα -> [text:
-- ^ Documentation for 'R'\'s 'fα' field.
diff --git a/testsuite/tests/showIface/PragmaDocs.stdout b/testsuite/tests/showIface/PragmaDocs.stdout
index 17ebd47b1d75..341a065b2c01 100644
--- a/testsuite/tests/showIface/PragmaDocs.stdout
+++ b/testsuite/tests/showIface/PragmaDocs.stdout
@@ -8,6 +8,8 @@ require own pkg trusted: False
docs:
Just module header:
Nothing
+ export docs:
+ []
declaration docs:
[]
arg docs:
diff --git a/testsuite/tests/showIface/ReExports.stdout b/testsuite/tests/showIface/ReExports.stdout
index 31007df259f7..17bf91259e16 100644
--- a/testsuite/tests/showIface/ReExports.stdout
+++ b/testsuite/tests/showIface/ReExports.stdout
@@ -1,6 +1,8 @@
docs:
Just module header:
Nothing
+ export docs:
+ []
declaration docs:
[]
arg docs:
diff --git a/utils/check-exact/ExactPrint.hs b/utils/check-exact/ExactPrint.hs
index 00072fc3dc51..f1888f9f0e37 100644
--- a/utils/check-exact/ExactPrint.hs
+++ b/utils/check-exact/ExactPrint.hs
@@ -4566,23 +4566,26 @@ instance ExactPrint (IE GhcPs) where
getAnnotationEntry _ = NoEntryVal
setAnnotationAnchor a _ _ _ = a
- exact (IEVar depr ln) = do
+ exact (IEVar depr ln doc) = do
depr' <- markAnnotated depr
ln' <- markAnnotated ln
- return (IEVar depr' ln')
- exact (IEThingAbs (depr, an) thing) = do
+ doc' <- markAnnotated doc
+ return (IEVar depr' ln' doc')
+ exact (IEThingAbs (depr, an) thing doc) = do
depr' <- markAnnotated depr
thing' <- markAnnotated thing
- return (IEThingAbs (depr', an) thing')
- exact (IEThingAll (depr, an) thing) = do
+ doc' <- markAnnotated doc
+ return (IEThingAbs (depr', an) thing' doc')
+ exact (IEThingAll (depr, an) thing doc) = do
depr' <- markAnnotated depr
thing' <- markAnnotated thing
an0 <- markEpAnnL' an lidl AnnOpenP
an1 <- markEpAnnL' an0 lidl AnnDotdot
an2 <- markEpAnnL' an1 lidl AnnCloseP
- return (IEThingAll (depr', an2) thing')
+ doc' <- markAnnotated doc
+ return (IEThingAll (depr', an2) thing' doc')
- exact (IEThingWith (depr, an) thing wc withs) = do
+ exact (IEThingWith (depr, an) thing wc withs doc) = do
depr' <- markAnnotated depr
thing' <- markAnnotated thing
an0 <- markEpAnnL' an lidl AnnOpenP
@@ -4599,7 +4602,8 @@ instance ExactPrint (IE GhcPs) where
as' <- markAnnotated as
return (an2, wc, bs'++as')
an2 <- markEpAnnL' an1 lidl AnnCloseP
- return (IEThingWith (depr', an2) thing' wc' withs')
+ doc' <- markAnnotated doc
+ return (IEThingWith (depr', an2) thing' wc' withs' doc')
exact (IEModuleContents (depr, an) m) = do
depr' <- markAnnotated depr
diff --git a/utils/check-exact/Main.hs b/utils/check-exact/Main.hs
index 570f2790ec04..31f4a0faf004 100644
--- a/utils/check-exact/Main.hs
+++ b/utils/check-exact/Main.hs
@@ -900,8 +900,8 @@ addHiding1 _libdir (L l p) = do
[L li imp1,imp2] = hsmodImports p
n1 = L noAnnSrcSpanDP0 (mkVarUnqual (mkFastString "n1"))
n2 = L noAnnSrcSpanDP0 (mkVarUnqual (mkFastString "n2"))
- v1 = L (addComma $ noAnnSrcSpanDP0) (IEVar Nothing (L noAnnSrcSpanDP0 (IEName noExtField n1)))
- v2 = L ( noAnnSrcSpanDP0) (IEVar Nothing (L noAnnSrcSpanDP0 (IEName noExtField n2)))
+ v1 = L (addComma $ noAnnSrcSpanDP0) (IEVar Nothing (L noAnnSrcSpanDP0 (IEName noExtField n1)) Nothing)
+ v2 = L ( noAnnSrcSpanDP0) (IEVar Nothing (L noAnnSrcSpanDP0 (IEName noExtField n2)) Nothing)
impHiding = L (EpAnn d0
(AnnList Nothing
(Just (AddEpAnn AnnOpenP d1))
@@ -936,8 +936,8 @@ addHiding2 _libdir top = do
emptyComments)
n1 = L (noAnnSrcSpanDP0) (mkVarUnqual (mkFastString "n1"))
n2 = L (noAnnSrcSpanDP0) (mkVarUnqual (mkFastString "n2"))
- v1 = L (addComma $ noAnnSrcSpanDP0) (IEVar Nothing (L noAnnSrcSpanDP0 (IEName noExtField n1)))
- v2 = L ( noAnnSrcSpanDP0) (IEVar Nothing (L noAnnSrcSpanDP0 (IEName noExtField n2)))
+ v1 = L (addComma $ noAnnSrcSpanDP0) (IEVar Nothing (L noAnnSrcSpanDP0 (IEName noExtField n1)) Nothing)
+ v2 = L ( noAnnSrcSpanDP0) (IEVar Nothing (L noAnnSrcSpanDP0 (IEName noExtField n2)) Nothing)
L ln n = last ns
n' = L (addComma ln) n
imp1' = imp1 { ideclImportList = Just (EverythingBut, L lh' (init ns ++ [n',v1,v2]))}
diff --git a/utils/haddock b/utils/haddock
index 8099c062416e..46a436557469 160000
--- a/utils/haddock
+++ b/utils/haddock
@@ -1 +1 @@
-Subproject commit 8099c062416e170cb0efd461b2485db1f9d57af5
+Subproject commit 46a436557469b53a7f7371322af5a0bb85c161fc
--
GitLab