aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDavid Waern <david.waern@gmail.com>2008-10-16 20:58:42 +0000
committerDavid Waern <david.waern@gmail.com>2008-10-16 20:58:42 +0000
commit6319cccbd95ba15db6f34101577034233cdc8f88 (patch)
treefd67a34a0d8543d73359203bee48832690fcb3f8
parent9a0be441073e25b03aa5fd96d76e15454c8cc76f (diff)
Fix #61
We were not getting docs for re-exported class methods. This was because we were looking up the docs in a map made from the declarations in the current module being rendered. Obviously, re-exported class methods come from another module. Class methods and ATs were the only thing we were looking up using the doc map, everything else we found in the ExporItems. So now I've put subordinate docs in the ExportItem's directly, to make things a bit more consistent. To do this, I added subordinates to the the declarations in the declaration map. This was easy since we were computing subordinates anyway, to store stand-alone in the map. I added a new type synonym 'DeclInfo', which is what we call what is now stored in the map. This little refactoring removes duplicate code to retrieve subordinates and documentation from the HsGroup.
-rw-r--r--src/Haddock/Backends/Hoogle.hs2
-rw-r--r--src/Haddock/Backends/Html.hs42
-rw-r--r--src/Haddock/DocName.hs1
-rw-r--r--src/Haddock/Interface/AttachInstances.hs4
-rw-r--r--src/Haddock/Interface/Create.hs87
-rw-r--r--src/Haddock/Interface/Rename.hs16
-rw-r--r--src/Haddock/Types.hs3
-rw-r--r--tests/tests/Hidden.hs2
-rw-r--r--tests/tests/Ticket61.hs3
-rw-r--r--tests/tests/Ticket61.html.ref125
-rw-r--r--tests/tests/Ticket61_Hidden.hs7
11 files changed, 226 insertions, 66 deletions
diff --git a/src/Haddock/Backends/Hoogle.hs b/src/Haddock/Backends/Hoogle.hs
index 684d4294..dfd72758 100644
--- a/src/Haddock/Backends/Hoogle.hs
+++ b/src/Haddock/Backends/Hoogle.hs
@@ -81,7 +81,7 @@ operator x = x
-- How to print each export
ppExport :: ExportItem Name -> [String]
-ppExport (ExportDecl decl dc _) = doc dc ++ f (unL decl)
+ppExport (ExportDecl decl dc _ _) = doc dc ++ f (unL decl)
where
f (TyClD d@TyData{}) = ppData d
f (TyClD d@ClassDecl{}) = ppClass d
diff --git a/src/Haddock/Backends/Html.hs b/src/Haddock/Backends/Html.hs
index 1f685c3d..579d7896 100644
--- a/src/Haddock/Backends/Html.hs
+++ b/src/Haddock/Backends/Html.hs
@@ -553,7 +553,7 @@ ifaceToHtml maybe_source_url maybe_wiki_url iface
exports = numberSectionHeadings (ifaceRnExportItems iface)
- has_doc (ExportDecl _ doc _) = isJust doc
+ has_doc (ExportDecl _ doc _ _) = isJust doc
has_doc (ExportNoDecl _ _ _) = False
has_doc (ExportModule _) = False
has_doc _ = True
@@ -630,8 +630,8 @@ numberSectionHeadings exports = go 1 exports
processExport :: Bool -> LinksInfo -> DocMap -> (ExportItem DocName) -> HtmlTable
processExport _ _ _ (ExportGroup lev id0 doc)
= ppDocGroup lev (namedAnchor id0 << docToHtml doc)
-processExport summary links docMap (ExportDecl decl doc insts)
- = ppDecl summary links decl doc insts docMap
+processExport summary links docMap (ExportDecl decl doc subdocs insts)
+ = ppDecl summary links decl doc insts docMap subdocs
processExport summmary _ _ (ExportNoDecl _ y [])
= declBox (ppDocName y)
processExport summmary _ _ (ExportNoDecl _ y subs)
@@ -660,9 +660,10 @@ declWithDoc False links loc nm (Just doc) html_decl =
topDeclBox links loc nm html_decl </> docBox (docToHtml doc)
+-- TODO: use DeclInfo DocName or something
ppDecl :: Bool -> LinksInfo -> LHsDecl DocName ->
- Maybe (HsDoc DocName) -> [InstHead DocName] -> DocMap -> HtmlTable
-ppDecl summ links (L loc decl) mbDoc instances docMap = case decl of
+ Maybe (HsDoc DocName) -> [InstHead DocName] -> DocMap -> [(DocName, HsDoc DocName)] -> HtmlTable
+ppDecl summ links (L loc decl) mbDoc instances docMap subdocs = case decl of
TyClD d@(TyFamily {}) -> ppTyFam summ False links loc mbDoc d
TyClD d@(TyData {})
| Nothing <- tcdTyPats d -> ppDataDecl summ links instances loc mbDoc d
@@ -670,7 +671,7 @@ ppDecl summ links (L loc decl) mbDoc instances docMap = case decl of
TyClD d@(TySynonym {})
| Nothing <- tcdTyPats d -> ppTySyn summ links loc mbDoc d
| Just _ <- tcdTyPats d -> ppTyInst summ False links loc mbDoc d
- TyClD d@(ClassDecl {}) -> ppClassDecl summ links instances loc mbDoc docMap d
+ TyClD d@(ClassDecl {}) -> ppClassDecl summ links instances loc mbDoc docMap subdocs d
SigD (TypeSig (L _ n) (L _ t)) -> ppFunSig summ links loc mbDoc n t
ForD d -> ppFor summ links loc mbDoc d
InstD d -> Html.emptyTable
@@ -872,13 +873,11 @@ ppTyInstHeader summary associated decl =
--------------------------------------------------------------------------------
-ppAssocType :: Bool -> LinksInfo -> DocMap -> LTyClDecl DocName -> HtmlTable
-ppAssocType summ links docMap (L loc decl) =
+ppAssocType :: Bool -> LinksInfo -> Maybe (HsDoc DocName) -> LTyClDecl DocName -> HtmlTable
+ppAssocType summ links doc (L loc decl) =
case decl of
TyFamily {} -> ppTyFam summ True links loc doc decl
TySynonym {} -> ppTySyn summ links loc doc decl
- where
- doc = Map.lookup (docNameOrig $ tcdName decl) docMap
--------------------------------------------------------------------------------
@@ -970,8 +969,8 @@ ppFds fds =
fundep (vars1,vars2) = hsep (map ppDocName vars1) <+> toHtml "->" <+>
hsep (map ppDocName vars2)
-ppShortClassDecl :: Bool -> LinksInfo -> TyClDecl DocName -> SrcSpan -> DocMap -> HtmlTable
-ppShortClassDecl summary links (ClassDecl lctxt lname tvs fds sigs _ ats _) loc docMap =
+ppShortClassDecl :: Bool -> LinksInfo -> TyClDecl DocName -> SrcSpan -> [(DocName, HsDoc DocName)] -> HtmlTable
+ppShortClassDecl summary links (ClassDecl lctxt lname tvs fds sigs _ ats _) loc subdocs =
if null sigs && null ats
then (if summary then declBox else topDeclBox links loc nm) hdr
else (if summary then declBox else topDeclBox links loc nm) (hdr <+> keyword "where")
@@ -980,12 +979,12 @@ ppShortClassDecl summary links (ClassDecl lctxt lname tvs fds sigs _ ats _) loc
bodyBox <<
aboves
(
- map (ppAssocType summary links docMap) ats ++
+ [ ppAssocType summary links doc at | at <- ats
+ , let doc = lookup (tcdName $ unL at) subdocs ] ++
- [ ppFunSig summary links loc mbDoc n typ
+ [ ppFunSig summary links loc doc n typ
| L _ (TypeSig (L _ n) (L _ typ)) <- sigs
- , let mbDoc = Map.lookup (docNameOrig n) docMap ]
-
+ , let doc = lookup n subdocs ]
)
)
where
@@ -995,11 +994,11 @@ ppShortClassDecl summary links (ClassDecl lctxt lname tvs fds sigs _ ats _) loc
ppClassDecl :: Bool -> LinksInfo -> [InstHead DocName] -> SrcSpan ->
- Maybe (HsDoc DocName) -> DocMap -> TyClDecl DocName ->
+ Maybe (HsDoc DocName) -> DocMap -> [(DocName, HsDoc DocName)] -> TyClDecl DocName ->
HtmlTable
-ppClassDecl summary links instances loc mbDoc docMap
+ppClassDecl summary links instances loc mbDoc docMap subdocs
decl@(ClassDecl lctxt lname ltyvars lfds lsigs _ ats _)
- | summary = ppShortClassDecl summary links decl loc docMap
+ | summary = ppShortClassDecl summary links decl loc subdocs
| otherwise = classheader </> bodyBox << (classdoc </> body </> instancesBit)
where
classheader
@@ -1024,9 +1023,10 @@ ppClassDecl summary links instances loc mbDoc docMap
methodTable =
abovesSep s8 [ ppFunSig summary links loc doc n typ
| L _ (TypeSig (L _ n) (L _ typ)) <- lsigs
- , let doc = Map.lookup (docNameOrig n) docMap ]
+ , let doc = lookup n subdocs ]
- atTable = abovesSep s8 $ map (ppAssocType summary links docMap) ats
+ atTable = abovesSep s8 $ [ ppAssocType summary links doc at | at <- ats
+ , let doc = lookup (tcdName $ unL at) subdocs ]
instId = collapseId (docNameOrig nm)
instancesBit
diff --git a/src/Haddock/DocName.hs b/src/Haddock/DocName.hs
index dfb21c0f..959d028b 100644
--- a/src/Haddock/DocName.hs
+++ b/src/Haddock/DocName.hs
@@ -16,6 +16,7 @@ import Binary
data DocName = Documented Name Module | Undocumented Name
+ deriving Eq
docNameOcc :: DocName -> OccName
diff --git a/src/Haddock/Interface/AttachInstances.hs b/src/Haddock/Interface/AttachInstances.hs
index 636a5149..1454bdfc 100644
--- a/src/Haddock/Interface/AttachInstances.hs
+++ b/src/Haddock/Interface/AttachInstances.hs
@@ -43,9 +43,9 @@ attachInstances modules filterNames = map attach modules
where
newItems = map attachExport (ifaceExportItems mod)
- attachExport (ExportDecl decl@(L _ (TyClD d)) doc _)
+ attachExport (ExportDecl decl@(L _ (TyClD d)) doc subs _)
| isClassDecl d || isDataDecl d || isFamilyDecl d =
- ExportDecl decl doc (case Map.lookup (tcdName d) instMap of
+ ExportDecl decl doc subs (case Map.lookup (tcdName d) instMap of
Nothing -> []
Just instheads -> instheads)
attachExport export = export
diff --git a/src/Haddock/Interface/Create.hs b/src/Haddock/Interface/Create.hs
index 5932bc64..9d0995e6 100644
--- a/src/Haddock/Interface/Create.hs
+++ b/src/Haddock/Interface/Create.hs
@@ -54,21 +54,21 @@ createInterface ghcMod flags modMap = do
exports = fmap (reverse . map unLoc) (ghcMbExports ghcMod)
localNames = ghcDefinedNames ghcMod
subMap = mkSubMap group
- decls = topDecls group
- decls' = filterOutInstances decls
- declMap = mkDeclMap decls'
+ decls0 = declInfos . topDecls $ group
+ decls = filterOutInstances decls0
+ declMap = mkDeclMap decls
-- famMap = mkFamMap decls'
ignoreExps = Flag_IgnoreAllExports `elem` flags
exportedNames = ghcExportedNames ghcMod
instances = ghcInstances ghcMod
- warnAboutFilteredDecls mod decls
+ warnAboutFilteredDecls mod decls0
visibleNames <- mkVisibleNames mod modMap localNames
(ghcNamesInScope ghcMod)
subMap exports opts declMap
- exportItems <- mkExportItems modMap mod (ghcExportedNames ghcMod) decls' declMap
+ exportItems <- mkExportItems modMap mod (ghcExportedNames ghcMod) decls declMap
subMap opts exports ignoreExps instances
-- prune the export list to just those declarations that have
@@ -137,20 +137,22 @@ type DeclWithDoc = (Decl, Maybe Doc)
-- type Family = (Maybe DeclWithDoc, [DeclWithDoc])
--- | Make a map from names to declarations with documentation. The map excludes
--- all kinds of instance declarations (including type family instances) and
--- documentation declarations.
--- Subordinate names are mapped to the parent declaration, but with the doc
--- for the subordinate declaration.
-mkDeclMap :: [(Decl, Maybe Doc)] -> Map Name DeclInfo
+-- Make a map from names to 'DeclInfo's. Exclude declarations that don't
+-- have names (instances and stand-alone documentation comments). Include
+-- subordinate names, but map them to their parent declarations.
+mkDeclMap :: [DeclInfo] -> Map Name DeclInfo
mkDeclMap decls = Map.fromList . concat $
[ (declName d, (parent, doc, subs)) : subDecls
- | (parent@(L loc d), doc) <- decls
- , let subs = subordinates d
+ | (parent@(L _ d), doc, subs) <- decls
, let subDecls = [ (n, (parent, doc', [])) | (n, doc') <- subs ]
, not (isDocD d), not (isInstD d) ]
+declInfos :: [(Decl, Maybe Doc)] -> [DeclInfo]
+declInfos decls = [ (parent, doc, subordinates d)
+ | (parent@(L _ d), doc) <- decls]
+
+
-- | Group type family instances together. Include the family declaration
-- if found.
{-mkFamMap :: [DeclWithDoc] -> Map Name Family
@@ -170,15 +172,18 @@ subordinates _ = []
classDataSubs :: TyClDecl Name -> [(Name, Maybe Doc)]
classDataSubs decl
- | isClassDecl decl = classMeths
- | isDataDecl decl = recordFields
+ | isClassDecl decl = classSubs
+ | isDataDecl decl = dataSubs
| otherwise = []
where
- classMeths = [ (declName d, doc) | (L _ d, doc) <- classDecls decl ]
- recordFields = [ (unLoc lname, fmap unLoc doc) |
- ConDeclField lname _ doc <- fields ]
- cons = [ con | L _ con <- tcdCons decl ]
- fields = concat [ fields | RecCon fields <- map con_details cons]
+ classSubs = [ (declName d, doc) | (L _ d, doc) <- classDecls decl ]
+ dataSubs = constrs ++ fields
+ where
+ cons = map unL $ tcdCons decl
+ constrs = [ (unL $ con_name c, fmap unL $ con_doc c) | c <- cons ]
+ fields = [ (unL n, fmap unL doc)
+ | RecCon flds <- map con_details cons
+ , ConDeclField n _ doc <- flds ]
-- All the sub declarations of a class (that we handle), ordered by
@@ -206,7 +211,7 @@ topDecls :: HsGroup Name -> [DeclWithDoc]
topDecls = filterClasses . filterDecls . collectDocs . sortByLoc . declsFromGroup
-filterOutInstances = filter (\(L _ d, _) -> not (isInstD d))
+filterOutInstances = filter (\(L _ d, _, _) -> not (isInstD d))
-- | Take all declarations in an 'HsGroup' and convert them into a list of
@@ -235,7 +240,7 @@ sortByLoc = sortBy (comparing getLoc)
warnAboutFilteredDecls mod decls = do
let modStr = moduleString mod
let typeInstances =
- nub [ tcdName d | (L _ (TyClD d), _) <- decls, isFamInstDecl d ]
+ nub [ tcdName d | (L _ (TyClD d), _, _) <- decls, isFamInstDecl d ]
when (not $null typeInstances) $
tell $ nub [
@@ -244,7 +249,7 @@ warnAboutFilteredDecls mod decls = do
++ "will be filtered out:\n " ++ (concat $ intersperse ", "
$ map (occNameString . nameOccName) typeInstances) ]
- let instances = nub [ pretty i | (L _ (InstD (InstDecl i _ _ ats)), _) <- decls
+ let instances = nub [ pretty i | (L _ (InstD (InstDecl i _ _ ats)), _, _) <- decls
, not (null ats) ]
when (not $ null instances) $
@@ -365,7 +370,7 @@ mkExportItems
:: ModuleMap
-> Module -- this module
-> [Name] -- exported names (orig)
- -> [(Decl, Maybe Doc)]
+ -> [DeclInfo]
-> Map Name DeclInfo -- maps local names to declarations
-> Map Name [Name] -- sub-map for this module
-> [DocOption]
@@ -380,7 +385,7 @@ mkExportItems modMap this_mod exported_names decls declMap sub_map
= everything_local_exported
| Just specs <- maybe_exps = liftM concat $ mapM lookupExport specs
where
- instances = [ d | d@(L _ decl, _) <- decls, isInstD decl ]
+ instances = [ d | d@(L _ decl, _, _) <- decls, isInstD decl ]
everything_local_exported = -- everything exported
return (fullContentsOfThisModule this_mod decls)
@@ -401,7 +406,7 @@ mkExportItems modMap this_mod exported_names decls declMap sub_map
lookupExport (IEGroup lev doc) = return [ ExportGroup lev "" doc ]
lookupExport (IEDoc doc) = return [ ExportDoc doc ]
lookupExport (IEDocNamed str) = do
- r <- findNamedDoc str (map (unLoc . fst) decls)
+ r <- findNamedDoc str [ unL d | (d,_,_) <- decls ]
case r of
Nothing -> return []
Just found -> return [ ExportDoc found ]
@@ -411,15 +416,19 @@ mkExportItems modMap this_mod exported_names decls declMap sub_map
-- temp hack: we filter out separately declared ATs, since we haven't decided how
-- to handle them yet. We should really give an warning message also, and filter the
-- name out in mkVisibleNames...
- | Just (decl, maybeDoc, _) <- findDecl t, t `notElem` declATs (unL decl) =
- return [ ExportDecl (restrictTo subs (extractDecl t mdl decl)) maybeDoc [] ]
+ | Just x@(decl,_,_) <- findDecl t,
+ t `notElem` declATs (unL decl) = return [ mkExportDecl t x ]
| otherwise = return []
- where
- mdl = nameModule t
- subs = filter (`elem` exported_names) all_subs
- all_subs
- | mdl == this_mod = Map.findWithDefault [] t sub_map
- | otherwise = allSubsOfName modMap t
+
+
+ mkExportDecl :: Name -> DeclInfo -> ExportItem Name
+ mkExportDecl n (decl, doc, subs) = decl'
+ where
+ decl' = ExportDecl (restrictTo subs' (extractDecl n mdl decl)) doc subdocs []
+ mdl = nameModule n
+ subs' = filter (`elem` exported_names) $ map fst subs
+ subdocs = [ (n, doc) | (n, Just doc) <- subs ]
+
fullContentsOf m
| m == this_mod = return (fullContentsOfThisModule this_mod decls)
@@ -441,11 +450,13 @@ mkExportItems modMap this_mod exported_names decls declMap sub_map
m = nameModule n
-fullContentsOfThisModule :: Module -> [(Decl, Maybe Doc)] -> [ExportItem Name]
+fullContentsOfThisModule :: Module -> [DeclInfo] -> [ExportItem Name]
fullContentsOfThisModule module_ decls = catMaybes (map mkExportItem decls)
where
- mkExportItem (L _ (DocD (DocGroup lev doc)), _) = Just $ ExportGroup lev "" doc
- mkExportItem (decl, doc) = Just $ ExportDecl decl doc []
+ mkExportItem (L _ (DocD (DocGroup lev doc)), _, _) = Just $ ExportGroup lev "" doc
+ mkExportItem (decl, doc, subs) = Just $ ExportDecl decl doc subdocs []
+ where subdocs = [ (n, doc) | (n, Just doc) <- subs ]
+
-- mkExportItem _ = Nothing -- TODO: see if this is really needed
@@ -513,7 +524,7 @@ extractRecSel nm mdl t tvs (L _ con : rest) =
-- Pruning
pruneExportItems :: [ExportItem Name] -> [ExportItem Name]
pruneExportItems items = filter hasDoc items
- where hasDoc (ExportDecl _ d _) = isJust d
+ where hasDoc (ExportDecl _ d _ _) = isJust d
hasDoc _ = True
diff --git a/src/Haddock/Interface/Rename.hs b/src/Haddock/Interface/Rename.hs
index 3efc2526..3675f0b4 100644
--- a/src/Haddock/Interface/Rename.hs
+++ b/src/Haddock/Interface/Rename.hs
@@ -369,9 +369,10 @@ renameTyClD d = case d of
renameSig sig = case sig of
- TypeSig (L loc name) ltype -> do
+ TypeSig lname ltype -> do
+ lname' <- renameL lname
ltype' <- renameLType ltype
- return (TypeSig (L loc (keep name)) ltype')
+ return (TypeSig lname' ltype')
-- we have filtered out all other kinds of signatures in Interface.Create
@@ -395,11 +396,12 @@ renameExportItem item = case item of
ExportGroup lev id doc -> do
doc' <- renameDoc doc
return (ExportGroup lev id doc')
- ExportDecl decl doc instances -> do
+ ExportDecl decl doc subs instances -> do
decl' <- renameLDecl decl
doc' <- mapM renameDoc doc
+ subs' <- mapM renameSub subs
instances' <- mapM renameInstHead instances
- return (ExportDecl decl' doc' instances')
+ return (ExportDecl decl' doc' subs' instances')
ExportNoDecl x y subs -> do
y' <- lookupRn id y
subs' <- mapM (lookupRn id) subs
@@ -407,3 +409,9 @@ renameExportItem item = case item of
ExportDoc doc -> do
doc' <- renameDoc doc
return (ExportDoc doc')
+
+
+renameSub (n,doc) = do
+ n' <- rename n
+ doc' <- renameDoc doc
+ return (n', doc')
diff --git a/src/Haddock/Types.hs b/src/Haddock/Types.hs
index 671637c5..24f5fd25 100644
--- a/src/Haddock/Types.hs
+++ b/src/Haddock/Types.hs
@@ -47,6 +47,9 @@ data ExportItem name
-- | Maybe a doc comment
expItemMbDoc :: Maybe (HsDoc name),
+ -- | Documentation for subordinate declarations
+ expItemSubDocs :: [(name, HsDoc name)],
+
-- | Instances relevant to this declaration
expItemInstances :: [InstHead name]
diff --git a/tests/tests/Hidden.hs b/tests/tests/Hidden.hs
index e46fc37f..896da648 100644
--- a/tests/tests/Hidden.hs
+++ b/tests/tests/Hidden.hs
@@ -1,4 +1,6 @@
{-# OPTIONS_HADDOCK hide #-}
+
module Hidden where
+
hidden :: Int -> Int
hidden a = a
diff --git a/tests/tests/Ticket61.hs b/tests/tests/Ticket61.hs
new file mode 100644
index 00000000..26ca287f
--- /dev/null
+++ b/tests/tests/Ticket61.hs
@@ -0,0 +1,3 @@
+module Ticket61 (module Ticket61_Hidden) where
+
+import Ticket61_Hidden
diff --git a/tests/tests/Ticket61.html.ref b/tests/tests/Ticket61.html.ref
new file mode 100644
index 00000000..0e0c6c0a
--- /dev/null
+++ b/tests/tests/Ticket61.html.ref
@@ -0,0 +1,125 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
+<!--Rendered using the Haskell Html Library v0.2-->
+<HTML
+><HEAD
+><META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=UTF-8"
+><TITLE
+>Ticket61</TITLE
+><LINK HREF="haddock.css" REL="stylesheet" TYPE="text/css"
+><SCRIPT SRC="haddock-util.js" TYPE="text/javascript"
+></SCRIPT
+></HEAD
+><BODY
+><TABLE CLASS="vanilla" CELLSPACING="0" CELLPADDING="0"
+><TR
+><TD CLASS="topbar"
+><TABLE CLASS="vanilla" CELLSPACING="0" CELLPADDING="0"
+><TR
+><TD
+><IMG SRC="haskell_icon.gif" WIDTH="16" HEIGHT="16" ALT=" "
+></TD
+><TD CLASS="title"
+></TD
+><TD CLASS="topbut"
+><A HREF="index.html"
+>Contents</A
+></TD
+><TD CLASS="topbut"
+><A HREF="doc-index.html"
+>Index</A
+></TD
+></TR
+></TABLE
+></TD
+></TR
+><TR
+><TD CLASS="modulebar"
+><TABLE CLASS="vanilla" CELLSPACING="0" CELLPADDING="0"
+><TR
+><TD
+><FONT SIZE="6"
+>Ticket61</FONT
+></TD
+></TR
+></TABLE
+></TD
+></TR
+><TR
+><TD CLASS="s15"
+></TD
+></TR
+><TR
+><TD CLASS="s15"
+></TD
+></TR
+><TR
+><TD CLASS="s15"
+></TD
+></TR
+><TR
+><TD CLASS="section1"
+>Documentation</TD
+></TR
+><TR
+><TD CLASS="s15"
+></TD
+></TR
+><TR
+><TD CLASS="decl"
+><SPAN CLASS="keyword"
+>class</SPAN
+> <A NAME="t%3AC"
+></A
+><B
+>C</B
+> a <SPAN CLASS="keyword"
+>where</SPAN
+></TD
+></TR
+><TR
+><TD CLASS="body"
+><TABLE CLASS="vanilla" CELLSPACING="0" CELLPADDING="0"
+><TR
+><TD CLASS="s8"
+></TD
+></TR
+><TR
+><TD CLASS="section4"
+>Methods</TD
+></TR
+><TR
+><TD CLASS="body"
+><TABLE CLASS="vanilla" CELLSPACING="0" CELLPADDING="0"
+><TR
+><TD CLASS="decl"
+><A NAME="v%3Af"
+></A
+><B
+>f</B
+> :: a</TD
+></TR
+><TR
+><TD CLASS="doc"
+>A comment about f
+</TD
+></TR
+></TABLE
+></TD
+></TR
+></TABLE
+></TD
+></TR
+><TR
+><TD CLASS="s15"
+></TD
+></TR
+><TR
+><TD CLASS="botbar"
+>Produced by <A HREF="http://www.haskell.org/haddock/"
+>Haddock</A
+> version 2.3.0</TD
+></TR
+></TABLE
+></BODY
+></HTML
+>
diff --git a/tests/tests/Ticket61_Hidden.hs b/tests/tests/Ticket61_Hidden.hs
new file mode 100644
index 00000000..583c10cd
--- /dev/null
+++ b/tests/tests/Ticket61_Hidden.hs
@@ -0,0 +1,7 @@
+{-# OPTIONS_HADDOCK hide #-}
+
+module Ticket61_Hidden where
+
+class C a where
+ -- | A comment about f
+ f :: a