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 @@ +<html xmlns="http://www.w3.org/1999/xhtml" +><head + ><meta http-equiv="Content-Type" content="text/html; charset=UTF-8" + /><meta name="viewport" content="width=device-width, initial-scale=1" + /><title + >RedactTypeSynonyms</title + ><link href="#" rel="stylesheet" type="text/css" title="Linuwial" + /><link rel="stylesheet" type="text/css" href="#" + /><link rel="stylesheet" type="text/css" href="#" + /><script src="haddock-bundle.min.js" async="async" type="text/javascript" + ></script + ><script type="text/x-mathjax-config" + >MathJax.Hub.Config({ tex2jax: { processClass: "mathjax", ignoreClass: ".*" } });</script + ><script src="https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.5/MathJax.js?config=TeX-A..." type="text/javascript" + ></script + ></head + ><body + ><div id="package-header" + ><span class="caption empty" + > </span + ><ul class="links" id="page-menu" + ><li + ><a href="#" + >Contents</a + ></li + ><li + ><a href="#" + >Index</a + ></li + ></ul + ></div + ><div id="content" + ><div id="module-header" + ><table class="info" + ><tr + ><th + >Safe Haskell</th + ><td + >None</td + ></tr + ></table + ><p class="caption" + >RedactTypeSynonyms</p + ></div + ><div id="synopsis" + ><details id="syn" + ><summary + >Synopsis</summary + ><ul class="details-toggle" data-details-id="syn" + ><li class="src short" + ><span class="keyword" + >type</span + > <a href="#" + >ExportedType1</a + > :: <a href="#" title="Data.Kind" + >Type</a + ></li + ><li class="src short" + ><span class="keyword" + >type</span + > <a href="#" + >ExportedType2</a + > a :: <a href="#" title="Data.Kind" + >Type</a + ></li + ><li class="src short" + ><span class="keyword" + >type</span + > <a href="#" + >ExportedType3</a + > :: <a href="#" title="Data.Kind" + >Constraint</a + ></li + ><li class="src short" + ><span class="keyword" + >type</span + > <a href="#" + >ExportedType4</a + > a = (a, <a href="#" title="RedactTypeSynonyms" + >ExportedType2</a + > a)</li + ><li class="src short" + ><span class="keyword" + >type</span + > <a href="#" + >ExportedType5</a + > (f :: k1 -> k2) (a :: k1) :: (k1, k2, <a href="#" title="Data.Kind" + >Type</a + >)</li + ><li class="src short" + ><a href="#" + >exportedFn</a + > :: <a href="#" title="Data.Bool" + >Bool</a + > -> AlsoHidden</li + ></ul + ></details + ></div + ><div id="interface" + ><h1 + >Documentation</h1 + ><div class="top" + ><p class="src" + ><span class="keyword" + >type</span + > <a id="t:ExportedType1" class="def" + >ExportedType1</a + > :: <a href="#" title="Data.Kind" + >Type</a + > <a href="#" class="selflink" + >#</a + ></p + ><div class="doc" + ><p + >A type that should be redacted.</p + ></div + ></div + ><div class="top" + ><p class="src" + ><span class="keyword" + >type</span + > <a id="t:ExportedType2" class="def" + >ExportedType2</a + > a :: <a href="#" title="Data.Kind" + >Type</a + > <a href="#" class="selflink" + >#</a + ></p + ><div class="doc" + ><p + >Another type that should be redacted, but that shouldn't suppress the + warning about AlsoHidden, because it's also visible in <code + ><a href="#" title="RedactTypeSynonyms" + >exportedFn</a + ></code + >.</p + ></div + ></div + ><div class="top" + ><p class="src" + ><span class="keyword" + >type</span + > <a id="t:ExportedType3" class="def" + >ExportedType3</a + > :: <a href="#" title="Data.Kind" + >Constraint</a + > <a href="#" class="selflink" + >#</a + ></p + ><div class="doc" + ><p + >For a little kind variety.</p + ></div + ></div + ><div class="top" + ><p class="src" + ><span class="keyword" + >type</span + > <a id="t:ExportedType4" class="def" + >ExportedType4</a + > a = (a, <a href="#" title="RedactTypeSynonyms" + >ExportedType2</a + > a) <a href="#" class="selflink" + >#</a + ></p + ><div class="doc" + ><p + >This type does not need to be redacted.</p + ></div + ></div + ><div class="top" + ><p class="src" + ><span class="keyword" + >type</span + > <a id="t:ExportedType5" class="def" + >ExportedType5</a + > (f :: k1 -> k2) (a :: k1) :: (k1, k2, <a href="#" title="Data.Kind" + >Type</a + >) <a href="#" class="selflink" + >#</a + ></p + ><div class="doc" + ><p + >This type has parameters in the result kind.</p + ></div + ></div + ><div class="top" + ><p class="src" + ><a id="v:exportedFn" class="def" + >exportedFn</a + > :: <a href="#" title="Data.Bool" + >Bool</a + > -> AlsoHidden <a href="#" class="selflink" + >#</a + ></p + ><div class="doc" + ><p + >A function.</p + ></div + ></div + ></div + ></div + ></body + ></html +> ===================================== 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.