Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
fd5b5177 by Ryan Hendrickson at 2025-06-18T22:30:06-04:00
haddock: Add redact-type-synonyms pragma
`{-# OPTIONS_HADDOCK redact-type-synonyms #-}` pragma will hide the RHS
of type synonyms, and display the result kind instead, if the RHS
contains any unexported types.
- - - - -
17 changed files:
- utils/haddock/CHANGES.md
- utils/haddock/doc/cheatsheet/haddocks.md
- utils/haddock/doc/markup.rst
- utils/haddock/haddock-api/src/Haddock/Backends/LaTeX.hs
- utils/haddock/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
- utils/haddock/haddock-api/src/Haddock/Convert.hs
- utils/haddock/haddock-api/src/Haddock/GhcUtils.hs
- utils/haddock/haddock-api/src/Haddock/Interface.hs
- utils/haddock/haddock-api/src/Haddock/Interface/AttachInstances.hs
- utils/haddock/haddock-api/src/Haddock/Interface/Create.hs
- utils/haddock/haddock-api/src/Haddock/Interface/Rename.hs
- utils/haddock/haddock-api/src/Haddock/InterfaceFile.hs
- utils/haddock/haddock-api/src/Haddock/Types.hs
- + utils/haddock/html-test/ref/RedactTypeSynonyms.html
- + utils/haddock/html-test/src/RedactTypeSynonyms.hs
- + utils/haddock/latex-test/ref/RedactTypeSynonyms/RedactTypeSynonyms.tex
- + utils/haddock/latex-test/src/RedactTypeSynonyms/RedactTypeSynonyms.hs
Changes:
=====================================
utils/haddock/CHANGES.md
=====================================
@@ -11,6 +11,10 @@
* Include `package_info` with haddock's `--show-interface` option.
+ * `{-# OPTIONS_HADDOCK redact-type-synonyms #-}` pragma will hide the RHS of
+ type synonyms, and display the result kind instead, if the RHS contains any
+ unexported types.
+
## Changes in 2.28.0
* `hi-haddock` is integrated, which means docstrings are no longer extracted
through typchecked module results. Instead, docstrings are taken from Haskell
=====================================
utils/haddock/doc/cheatsheet/haddocks.md
=====================================
@@ -116,6 +116,8 @@ definitions with "[thing]"
Show all enabled LANGUAGE extensions
{-# OPTIONS_HADDOCK print-explicit-runtime-reps #-}
Show all `RuntimeRep` type variables
+{-# OPTIONS_HADDOCK redact-type-synonyms #-}
+ Hide the RHS of type synonyms that use unexported types
```
# Grid tables
=====================================
utils/haddock/doc/markup.rst
=====================================
@@ -201,6 +201,21 @@ Individual arguments to a function may be documented like this: ::
Pattern synonyms, GADT-style data constructors, and class methods also
support this style of documentation.
+.. _instance-documentation:
+
+Instance Documentation
+~~~~~~~~~~~~~~~~~~~~~~
+
+As instances are not exported, their documentation appears as part of the
+documentation for the corresponding class and the data types that appear in the
+instance head. This may result in the documentation appearing in multiple
+modules.
+
+If the class is *hidden* (meaning defined in this package but not exported by
+any exposed module), or if any of the data types that appear in the instance
+head are hidden (ditto), then no documentation for the instance is produced,
+even if the instance has an associated documentation comment.
+
.. _module-description:
The Module Description
@@ -785,6 +800,12 @@ The following attributes are currently understood by Haddock:
underlying levity polymorphism. This flag is analogous to GHC's
``-fprint-explicit-runtime-reps`` flag.
+``redact-type-synonyms``
+ Hide the RHS of type synonyms, and display the result kind instead, if the
+ RHS contains any hidden types. ("Hidden" here means the same as in the
+ feature that hides class instances if those instances contain any hidden
+ types; see :ref:`instance-documentation`.)
+
.. _markup:
Markup
=====================================
utils/haddock/haddock-api/src/Haddock/Backends/LaTeX.hs
=====================================
@@ -478,7 +478,11 @@ ppTySyn
: ppDocBinder name
: map ppWcSymName (tyvarNames ltyvars)
)
- full = hdr <+> char '=' <+> ppLType unicode ltype
+ full = hdr <+> def
+ def = case unLoc ltype of
+ XHsType (HsRedacted k) ->
+ dcolon unicode <+> ppType unicode k
+ _ -> equals <+> ppLType unicode ltype
ppTySyn _ _ _ = error "declaration not supported by ppTySyn"
-------------------------------------------------------------------------------
@@ -1360,6 +1364,7 @@ ppr_mono_ty (HsDocTy _ ty _) unicode =
ppr_mono_ty (HsWildCardTy _) _ = char '_'
ppr_mono_ty (HsTyLit _ t) u = ppr_tylit t u
ppr_mono_ty (HsStarTy _ isUni) unicode = starSymbol (isUni || unicode)
+ppr_mono_ty (XHsType HsRedacted{}) _ = error "ppr_mono_ty: HsRedacted can't be used here"
ppr_tylit :: HsTyLit DocNameI -> Bool -> LaTeX
ppr_tylit (HsNumTy _ n) _ = integer n
=====================================
utils/haddock/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
=====================================
@@ -469,7 +469,11 @@ ppTySyn
( [keyword "type", ppBinder summary occ]
++ ppTyVars unicode qual (hsQTvExplicit ltyvars)
)
- full = hdr <+> equals <+> ppPatSigType unicode qual (noLocA sig_type)
+ full = hdr <+> def
+ def = case unLoc ltype of
+ XHsType (HsRedacted k) ->
+ dcolon unicode <+> ppType unicode qual HideEmptyContexts k
+ _ -> equals <+> ppPatSigType unicode qual (noLocA sig_type)
occ = nameOccName . getName $ name
fixs
| summary = noHtml
@@ -1874,6 +1878,7 @@ ppr_mono_ty (HsDocTy _ ty _) unicode qual emptyCtxts =
ppr_mono_lty ty unicode qual emptyCtxts
ppr_mono_ty (HsWildCardTy _) _ _ _ = char '_'
ppr_mono_ty (HsTyLit _ n) _ _ _ = ppr_tylit n
+ppr_mono_ty (XHsType HsRedacted{}) _ _ _ = error "ppr_mono_ty: HsRedacted can't be used here"
ppr_tylit :: HsTyLit DocNameI -> Html
ppr_tylit (HsNumTy _ n) = toHtml (show n)
=====================================
utils/haddock/haddock-api/src/Haddock/Convert.hs
=====================================
@@ -23,6 +23,7 @@ module Haddock.Convert
( tyThingToLHsDecl
, synifyInstHead
, synifyFamInst
+ , synifyKindSig
, PrintRuntimeReps (..)
) where
=====================================
utils/haddock/haddock-api/src/Haddock/GhcUtils.hs
=====================================
@@ -66,7 +66,7 @@ import GHC.Utils.Outputable (Outputable, SDocContext, ppr)
import qualified GHC.Utils.Outputable as Outputable
import GHC.Utils.Panic (panic)
-import Haddock.Types (DocName, DocNameI, XRecCond, HsTypeDocNameIExt(..))
+import Haddock.Types (DocName, DocNameI, ExportInfo, XRecCond, HsTypeDocNameIExt(..))
moduleString :: Module -> String
moduleString = moduleNameString . moduleName
@@ -771,6 +771,26 @@ typeNames ty = go ty Set.empty
CastTy t' _ -> go t' acc
CoercionTy{} -> acc
+
+-- | A class or data type is hidden iff
+--
+-- * it is defined in one of the modules that are being processed
+--
+-- * and it is not exported by any non-hidden module
+isNameHidden :: ExportInfo -> Name -> Bool
+isNameHidden (names, modules) name =
+ nameModule name `Set.member` modules
+ && not (name `Set.member` names)
+
+isTypeHidden :: ExportInfo -> Type -> Bool
+isTypeHidden expInfo = typeHidden
+ where
+ typeHidden :: Type -> Bool
+ typeHidden t = any nameHidden $ typeNames t
+
+ nameHidden :: Name -> Bool
+ nameHidden = isNameHidden expInfo
+
-------------------------------------------------------------------------------
-- * Free variables of a 'Type'
=====================================
utils/haddock/haddock-api/src/Haddock/Interface.hs
=====================================
@@ -102,7 +102,6 @@ processModules
-- environment
processModules verbosity modules flags extIfaces = do
liftIO Compat.setEncoding
- dflags <- getDynFlags
-- Map from a module to a corresponding installed interface
let instIfaceMap :: InstIfaceMap
@@ -122,10 +121,11 @@ processModules verbosity modules flags extIfaces = do
Set.unions $ map (Set.fromList . ifaceExports) $
filter (\i -> not $ OptHide `elem` ifaceOptions i) interfaces
mods = Set.fromList $ map ifaceMod interfaces
+ expInfo = (exportedNames, mods)
interfaces' <- {-# SCC attachInstances #-}
withTimingM "attachInstances" (const ()) $ do
- attachInstances (exportedNames, mods) interfaces instIfaceMap (isJust oneShotHiFile)
+ attachInstances expInfo interfaces instIfaceMap (isJust oneShotHiFile)
-- Combine the link envs of the external packages into one
let extLinks = Map.unions (map ifLinkEnv extIfaces)
@@ -140,7 +140,7 @@ processModules verbosity modules flags extIfaces = do
withTimingM "renameAllInterfaces" (const ()) $
for interfaces' $ \i -> do
withTimingM ("renameInterface: " <+> pprModuleName (moduleName (ifaceMod i))) (const ()) $
- renameInterface dflags ignoredSymbolSet links warnings (Flag_Hoogle `elem` flags) i
+ renameInterface ignoredSymbolSet links expInfo warnings (Flag_Hoogle `elem` flags) i
return (interfaces'', homeLinks)
=====================================
utils/haddock/haddock-api/src/Haddock/Interface/AttachInstances.hs
=====================================
@@ -31,7 +31,6 @@ import qualified Data.Map.Strict as Map
import Data.Maybe (fromMaybe, mapMaybe, maybeToList)
import Data.Ord (comparing)
import qualified Data.Sequence as Seq
-import qualified Data.Set as Set
import GHC
import GHC.Builtin.Types (unrestrictedFunTyConName)
import GHC.Core (isOrphan)
@@ -62,13 +61,9 @@ import GHC.Unit.State
import GHC.Utils.Outputable (sep, text, (<+>))
import Haddock.Convert
-import Haddock.GhcUtils (typeNames)
+import Haddock.GhcUtils (isNameHidden, isTypeHidden)
import Haddock.Types
-type ExportedNames = Set.Set Name
-type Modules = Set.Set Module
-type ExportInfo = (ExportedNames, Modules)
-
-- Also attaches fixities
attachInstances :: ExportInfo -> [Interface] -> InstIfaceMap -> Bool -> Ghc [Interface]
attachInstances expInfo ifaces instIfaceMap isOneShot = do
@@ -389,16 +384,6 @@ instFam FamInst{fi_fam = n, fi_tys = ts, fi_rhs = t} =
-- Filtering hidden instances
--------------------------------------------------------------------------------
--- | A class or data type is hidden iff
---
--- * it is defined in one of the modules that are being processed
---
--- * and it is not exported by any non-hidden module
-isNameHidden :: ExportInfo -> Name -> Bool
-isNameHidden (names, modules) name =
- nameModule name `Set.member` modules
- && not (name `Set.member` names)
-
-- | We say that an instance is «hidden» iff its class or any (part)
-- of its type(s) is hidden.
isInstanceHidden :: ExportInfo -> Name -> [Type] -> Bool
@@ -410,12 +395,3 @@ isInstanceHidden expInfo cls tyNames =
instTypeHidden :: Bool
instTypeHidden = any (isTypeHidden expInfo) tyNames
-
-isTypeHidden :: ExportInfo -> Type -> Bool
-isTypeHidden expInfo = typeHidden
- where
- typeHidden :: Type -> Bool
- typeHidden t = any nameHidden $ typeNames t
-
- nameHidden :: Name -> Bool
- nameHidden = isNameHidden expInfo
=====================================
utils/haddock/haddock-api/src/Haddock/Interface/Create.hs
=====================================
@@ -395,6 +395,7 @@ parseOption "prune" = return (Just OptPrune)
parseOption "not-home" = return (Just OptNotHome)
parseOption "show-extensions" = return (Just OptShowExtensions)
parseOption "print-explicit-runtime-reps" = return (Just OptPrintRuntimeRep)
+parseOption "redact-type-synonyms" = return (Just OptRedactTypeSyns)
parseOption other = warn ("Unrecognised option: " ++ other) >> return Nothing
--------------------------------------------------------------------------------
=====================================
utils/haddock/haddock-api/src/Haddock/Interface/Rename.hs
=====================================
@@ -25,7 +25,9 @@ import Control.Applicative ()
import Control.DeepSeq (force)
import Control.Monad hiding (mapM)
import Control.Monad.Reader
-import Control.Monad.Writer.CPS
+import Control.Monad.Trans.Maybe (MaybeT (..), hoistMaybe)
+import Control.Monad.Trans.Writer.CPS (WriterT, runWriterT)
+import Control.Monad.Writer.Class
import Data.Foldable (traverse_)
import qualified Data.Map.Strict as Map
import qualified Data.Set as Set
@@ -33,12 +35,15 @@ import Data.Traversable (mapM)
import GHC hiding (NoLink, HsTypeGhcPsExt (..))
import GHC.Builtin.Types (eqTyCon_RDR, tupleDataConName, tupleTyConName)
+import GHC.Core.TyCon (tyConResKind)
+import GHC.Driver.DynFlags (getDynFlags)
import GHC.Types.Basic (Boxity (..), TopLevelFlag (..), TupleSort (..))
import GHC.Types.Name
import GHC.Types.Name.Reader (RdrName (Exact))
import Language.Haskell.Syntax.BooleanFormula(BooleanFormula(..))
import Haddock.Backends.Hoogle (ppExportD)
+import Haddock.Convert (synifyKindSig)
import Haddock.GhcUtils
import Haddock.Types
@@ -51,9 +56,7 @@ import Haddock.Types
-- The renamed output gets written into fields in the Haddock interface record
-- that were previously left empty.
renameInterface
- :: DynFlags
- -- ^ GHC session dyn flags
- -> Map.Map (Maybe String) (Set.Set String)
+ :: Map.Map (Maybe String) (Set.Set String)
-- ^ Ignored symbols. A map from module names to unqualified names. Module
-- 'Just M' mapping to name 'f' means that link warnings should not be
-- generated for occurances of specifically 'M.f'. Module 'Nothing' mapping to
@@ -61,6 +64,7 @@ renameInterface
-> LinkEnv
-- ^ Link environment. A map from 'Name' to 'Module', where name 'n' maps to
-- module 'M' if 'M' is the preferred link destination for name 'n'.
+ -> ExportInfo
-> Bool
-- ^ Are warnings enabled?
-> Bool
@@ -68,18 +72,17 @@ renameInterface
-> Interface
-- ^ The interface we are renaming.
-> Ghc Interface
- -- ^ The renamed interface. Note that there is nothing really special about
- -- this being in the 'Ghc' monad. This could very easily be any 'MonadIO' or
- -- even pure, depending on the link warnings are reported.
-renameInterface dflags ignoreSet renamingEnv warnings hoogle iface = do
- let (iface', warnedNames) =
- runRnM
- dflags
- mdl
- localLinkEnv
- warnName
- (hoogle && not (OptHide `elem` ifaceOptions iface))
- (renameInterfaceRn iface)
+ -- ^ The renamed interface. The 'Ghc' monad is used to look up type
+ -- information and to get dynamic flags.
+renameInterface ignoreSet renamingEnv expInfo warnings hoogle iface = do
+ (iface', warnedNames) <-
+ runRnM
+ mdl
+ localLinkEnv
+ (expInfo <$ guard (OptRedactTypeSyns `elem` ifaceOptions iface))
+ warnName
+ (hoogle && not (OptHide `elem` ifaceOptions iface))
+ (renameInterfaceRn iface)
reportMissingLinks mdl warnedNames
return iface'
where
@@ -144,14 +147,20 @@ reportMissingLinks mdl names
-- | A renaming monad which provides 'MonadReader' access to a renaming
-- environment, and 'MonadWriter' access to a 'Set' of names for which link
-- warnings should be generated, based on the renaming environment.
-newtype RnM a = RnM {unRnM :: ReaderT RnMEnv (Writer (Set.Set Name)) a}
+newtype RnM a = RnM {unRnM :: ReaderT RnMEnv (WriterT (Set.Set Name) Ghc) a}
deriving newtype (Functor, Applicative, Monad, MonadReader RnMEnv, MonadWriter (Set.Set Name))
+liftGhc :: Ghc a -> RnM a
+liftGhc = RnM . lift . lift
+
-- | The renaming monad environment. Stores the linking environment (mapping
-- names to modules), the link warning predicate, and the current module.
data RnMEnv = RnMEnv
{ rnLinkEnv :: LinkEnv
-- ^ The linking environment (map from names to modules)
+ , rnExportInfo :: Maybe ExportInfo
+ -- ^ Information about exported names and modules, only if
+ -- redact-type-synonyms is enabled
, rnWarnName :: (Name -> Bool)
-- ^ Link warning predicate (whether failing to find a link destination
-- for a given name should result in a warning)
@@ -159,26 +168,24 @@ data RnMEnv = RnMEnv
-- ^ The current module
, rnHoogleOutput :: Bool
-- ^ Should Hoogle output be generated for this module?
- , rnDynFlags :: DynFlags
- -- ^ GHC Session DynFlags, necessary for Hoogle output generation
}
-- | Run the renamer action in a renaming environment built using the given
-- module, link env, and link warning predicate. Returns the renamed value along
-- with a set of 'Name's that were not renamed and should be warned for (i.e.
-- they satisfied the link warning predicate).
-runRnM :: DynFlags -> Module -> LinkEnv -> (Name -> Bool) -> Bool -> RnM a -> (a, Set.Set Name)
-runRnM dflags mdl linkEnv warnName hoogleOutput rn =
- runWriter $ runReaderT (unRnM rn) rnEnv
+runRnM :: Module -> LinkEnv -> Maybe ExportInfo -> (Name -> Bool) -> Bool -> RnM a -> Ghc (a, Set.Set Name)
+runRnM mdl linkEnv mbExpInfo warnName hoogleOutput rn =
+ runWriterT $ runReaderT (unRnM rn) rnEnv
where
rnEnv :: RnMEnv
rnEnv =
RnMEnv
{ rnLinkEnv = linkEnv
+ , rnExportInfo = mbExpInfo
, rnWarnName = warnName
, rnModuleString = moduleString mdl
, rnHoogleOutput = hoogleOutput
- , rnDynFlags = dflags
}
--------------------------------------------------------------------------------
@@ -243,12 +250,13 @@ renameExportItem item = case item of
ExportDecl ed@(ExportD decl pats doc subs instances fixities splice) -> do
-- If Hoogle output should be generated, generate it
RnMEnv{..} <- ask
+ dflags0 <- liftGhc getDynFlags
let !hoogleOut =
force $
if rnHoogleOutput
then
-- Since Hoogle is line based, we want to avoid breaking long lines.
- let dflags = rnDynFlags{pprCols = maxBound}
+ let dflags = dflags0{pprCols = maxBound}
in ppExportD dflags ed
else []
@@ -536,7 +544,16 @@ renameTyClD d = case d of
SynDecl{tcdLName = lname, tcdTyVars = tyvars, tcdFixity = fixity, tcdRhs = rhs} -> do
lname' <- renameNameL lname
tyvars' <- renameLHsQTyVars tyvars
- rhs' <- renameLType rhs
+ rhs' <- maybe (renameLType rhs) pure <=< runMaybeT $ do
+ expInfo <- MaybeT $ asks rnExportInfo
+ -- Given that we have matched on a 'SynDecl', this lookup /really should/
+ -- be 'ATyCon', and the 'synTyConRhs_maybe' result /really should/ be
+ -- 'Just', but out of an abundance of caution, failing either expectation
+ -- gracefully exits the monad instead of erroring.
+ ATyCon tc <- MaybeT $ liftGhc $ GHC.lookupName $ getName lname
+ guard . isTypeHidden expInfo <=< hoistMaybe $ synTyConRhs_maybe tc
+ let hsKind = synifyKindSig $ tyConResKind tc
+ lift $ fmap (XHsType . HsRedacted) <$> renameLType hsKind
return
( SynDecl
{ tcdSExt = noExtField
=====================================
utils/haddock/haddock-api/src/Haddock/InterfaceFile.hs
=====================================
@@ -423,6 +423,8 @@ instance Binary DocOption where
putByte bh 4
put_ bh OptPrintRuntimeRep = do
putByte bh 5
+ put_ bh OptRedactTypeSyns = do
+ putByte bh 6
get bh = do
h <- getByte bh
case h of
@@ -438,6 +440,8 @@ instance Binary DocOption where
return OptShowExtensions
5 -> do
return OptPrintRuntimeRep
+ 6 -> do
+ return OptRedactTypeSyns
n -> fail $ "invalid binary data found: " <> show n
instance Binary Example where
=====================================
utils/haddock/haddock-api/src/Haddock/Types.hs
=====================================
@@ -87,6 +87,9 @@ data DocPaths = DocPaths
-- ^ path to hyperlinked sources
}
type WarningMap = Map Name (Doc Name)
+type ExportedNames = Set.Set Name
+type Modules = Set.Set Module
+type ExportInfo = (ExportedNames, Modules)
-----------------------------------------------------------------------------
@@ -697,6 +700,9 @@ data DocOption
| -- | Render runtime reps for this module (see
-- the GHC @-fprint-explicit-runtime-reps@ flag)
OptPrintRuntimeRep
+ | -- | Hide the RHS of type synonyms in this module
+ -- that use unexported types.
+ OptRedactTypeSyns
deriving (Eq, Show)
-- | Option controlling how to qualify names
@@ -874,6 +880,8 @@ data HsTypeDocNameIExt
| HsRecTy [LHsConDeclRecField DocNameI]
+ | HsRedacted (HsType DocNameI) -- ^ contains the kind of the redacted type
+
type instance XNumTy DocNameI = NoExtField
type instance XStrTy DocNameI = NoExtField
type instance XCharTy DocNameI = NoExtField
=====================================
utils/haddock/html-test/ref/RedactTypeSynonyms.html
=====================================
@@ -0,0 +1,205 @@
+http://www.w3.org/1999/xhtml"
+>
=====================================
utils/haddock/html-test/src/RedactTypeSynonyms.hs
=====================================
@@ -0,0 +1,46 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE StandaloneKindSignatures #-}
+{-# OPTIONS_HADDOCK redact-type-synonyms #-}
+module RedactTypeSynonyms (
+ ExportedType1,
+ ExportedType2,
+ ExportedType3,
+ ExportedType4,
+ ExportedType5,
+ exportedFn,
+) where
+
+import Data.Kind (Type)
+
+-- We don't want to see a warning about this being undocumented, because it is
+-- only used in 'ExportedType', which is redacted.
+--
+-- (Warnings aren't currently tested, but this module would be a good case for
+-- it.)
+data Hidden
+
+-- We do want to see a warning here, though.
+data AlsoHidden
+
+class ThisIsHiddenToo where
+
+-- | A type that should be redacted.
+type ExportedType1 = (Bool, Hidden)
+
+-- | Another type that should be redacted, but that shouldn't suppress the
+-- warning about AlsoHidden, because it's also visible in 'exportedFn'.
+type ExportedType2 a = (a, AlsoHidden)
+
+-- | For a little kind variety.
+type ExportedType3 = ThisIsHiddenToo
+
+-- | This type does not need to be redacted.
+type ExportedType4 a = (a, ExportedType2 a)
+
+-- | This type has parameters in the result kind.
+type ExportedType5 :: forall k1 k2. (k1 -> k2) -> k1 -> (k1, k2, Type)
+type ExportedType5 f a = '(a, f a, Hidden)
+
+-- | A function.
+exportedFn :: Bool -> AlsoHidden
+exportedFn = undefined
=====================================
utils/haddock/latex-test/ref/RedactTypeSynonyms/RedactTypeSynonyms.tex
=====================================
@@ -0,0 +1,53 @@
+\haddockmoduleheading{RedactTypeSynonyms}
+\label{module:RedactTypeSynonyms}
+\haddockbeginheader
+{\haddockverb\begin{verbatim}
+module RedactTypeSynonyms (
+ ExportedType1, ExportedType2, ExportedType3, ExportedType4, ExportedType5,
+ exportedFn
+ ) where\end{verbatim}}
+\haddockendheader
+
+\begin{haddockdesc}
+\item[\begin{tabular}{@{}l}
+type ExportedType1 :: Type
+\end{tabular}]
+{\haddockbegindoc
+A type that should be redacted.\par}
+\end{haddockdesc}
+\begin{haddockdesc}
+\item[\begin{tabular}{@{}l}
+type ExportedType2 a :: Type
+\end{tabular}]
+{\haddockbegindoc
+Another type that should be redacted, but that shouldn't suppress the
+ warning about AlsoHidden, because it's also visible in \haddockid{exportedFn}.\par}
+\end{haddockdesc}
+\begin{haddockdesc}
+\item[\begin{tabular}{@{}l}
+type ExportedType3 :: Constraint
+\end{tabular}]
+{\haddockbegindoc
+For a little kind variety.\par}
+\end{haddockdesc}
+\begin{haddockdesc}
+\item[\begin{tabular}{@{}l}
+type ExportedType4 a = (a, ExportedType2 a)
+\end{tabular}]
+{\haddockbegindoc
+This type does not need to be redacted.\par}
+\end{haddockdesc}
+\begin{haddockdesc}
+\item[\begin{tabular}{@{}l}
+type ExportedType5 f a :: (k1, k2, Type)
+\end{tabular}]
+{\haddockbegindoc
+This type has parameters in the result kind.\par}
+\end{haddockdesc}
+\begin{haddockdesc}
+\item[\begin{tabular}{@{}l}
+exportedFn :: Bool -> AlsoHidden
+\end{tabular}]
+{\haddockbegindoc
+A function.\par}
+\end{haddockdesc}
\ No newline at end of file
=====================================
utils/haddock/latex-test/src/RedactTypeSynonyms/RedactTypeSynonyms.hs
=====================================
@@ -0,0 +1,46 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE StandaloneKindSignatures #-}
+{-# OPTIONS_HADDOCK redact-type-synonyms #-}
+module RedactTypeSynonyms (
+ ExportedType1,
+ ExportedType2,
+ ExportedType3,
+ ExportedType4,
+ ExportedType5,
+ exportedFn,
+) where
+
+import Data.Kind (Type)
+
+-- We don't want to see a warning about this being undocumented, because it is
+-- only used in 'ExportedType', which is redacted.
+--
+-- (Warnings aren't currently tested, but this module would be a good case for
+-- it.)
+data Hidden
+
+-- We do want to see a warning here, though.
+data AlsoHidden
+
+class ThisIsHiddenToo where
+
+-- | A type that should be redacted.
+type ExportedType1 = (Bool, Hidden)
+
+-- | Another type that should be redacted, but that shouldn't suppress the
+-- warning about AlsoHidden, because it's also visible in 'exportedFn'.
+type ExportedType2 a = (a, AlsoHidden)
+
+-- | For a little kind variety.
+type ExportedType3 = ThisIsHiddenToo
+
+-- | This type does not need to be redacted.
+type ExportedType4 a = (a, ExportedType2 a)
+
+-- | This type has parameters in the result kind.
+type ExportedType5 :: forall k1 k2. (k1 -> k2) -> k1 -> (k1, k2, Type)
+type ExportedType5 f a = '(a, f a, Hidden)
+
+-- | A function.
+exportedFn :: Bool -> AlsoHidden
+exportedFn = undefined
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fd5b51771ac726ecceaaf3480ad7c7c3...
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fd5b51771ac726ecceaaf3480ad7c7c3...
You're receiving this email because of your account on gitlab.haskell.org.