aboutsummaryrefslogtreecommitdiff
path: root/src/Haddock
diff options
context:
space:
mode:
Diffstat (limited to 'src/Haddock')
-rw-r--r--src/Haddock/Backends/Hoogle.hs18
-rw-r--r--src/Haddock/Backends/LaTeX.hs56
-rw-r--r--src/Haddock/Backends/Xhtml.hs12
-rw-r--r--src/Haddock/Backends/Xhtml/Decl.hs32
-rw-r--r--src/Haddock/Backends/Xhtml/DocMarkup.hs10
-rw-r--r--src/Haddock/Interface/Create.hs12
-rw-r--r--src/Haddock/Interface/Rename.hs14
-rw-r--r--src/Haddock/Types.hs20
8 files changed, 89 insertions, 85 deletions
diff --git a/src/Haddock/Backends/Hoogle.hs b/src/Haddock/Backends/Hoogle.hs
index e7a78fc2..98eeaab8 100644
--- a/src/Haddock/Backends/Hoogle.hs
+++ b/src/Haddock/Backends/Hoogle.hs
@@ -48,7 +48,7 @@ ppHoogle package version synopsis prologue ifaces odir = do
hClose h
ppModule :: Interface -> [String]
-ppModule iface = "" : doc (ifaceDoc iface) ++
+ppModule iface = "" : ppDocumentation (ifaceDoc iface) ++
["module " ++ moduleString (ifaceMod iface)] ++
concatMap ppExport (ifaceExportItems iface) ++
concatMap ppInstance (ifaceInstances iface)
@@ -109,7 +109,7 @@ operator x = x
-- How to print each export
ppExport :: ExportItem Name -> [String]
-ppExport (ExportDecl decl dc subdocs _) = doc (fst dc) ++ f (unL decl)
+ppExport (ExportDecl decl dc subdocs _) = ppDocumentation (fst dc) ++ f (unL decl)
where
f (TyClD d@TyData{}) = ppData d subdocs
f (TyClD d@ClassDecl{}) = ppClass d
@@ -167,19 +167,19 @@ ppData x subdocs = showData x{tcdCons=[],tcdDerivs=Nothing} :
f w = if w == nam then operator nam else w
-- | for constructors, and named-fields...
-lookupCon :: [(Name, DocForDecl Name)] -> Located Name -> Maybe (Doc Name)
+lookupCon :: [(Name, DocForDecl Name)] -> Located Name -> [String]
lookupCon subdocs (L _ name) = case lookup name subdocs of
- Just (d, _) -> d
- _ -> Nothing
+ Just (d, _) -> ppDocumentation d
+ _ -> []
ppCtor :: TyClDecl Name -> [(Name, DocForDecl Name)] -> ConDecl Name -> [String]
-ppCtor dat subdocs con = doc (lookupCon subdocs (con_name con))
+ppCtor dat subdocs con = lookupCon subdocs (con_name con)
++ f (con_details con)
where
f (PrefixCon args) = [typeSig name $ args ++ [resType]]
f (InfixCon a1 a2) = f $ PrefixCon [a1,a2]
f (RecCon recs) = f (PrefixCon $ map cd_fld_type recs) ++ concat
- [doc (lookupCon subdocs (cd_fld_name r)) ++
+ [lookupCon subdocs (cd_fld_name r) ++
[out (unL $ cd_fld_name r) `typeSig` [resType, cd_fld_type r]]
| r <- recs]
@@ -197,6 +197,10 @@ ppCtor dat subdocs con = doc (lookupCon subdocs (con_name con))
---------------------------------------------------------------------
-- DOCUMENTATION
+ppDocumentation :: Outputable o => Documentation o -> [String]
+ppDocumentation (Documentation d) = doc d
+
+
doc :: Outputable o => Maybe (Doc o) -> [String]
doc = docWith ""
diff --git a/src/Haddock/Backends/LaTeX.hs b/src/Haddock/Backends/LaTeX.hs
index efe05b9e..6cce753c 100644
--- a/src/Haddock/Backends/LaTeX.hs
+++ b/src/Haddock/Backends/LaTeX.hs
@@ -158,9 +158,7 @@ ppLaTeXModule _title odir iface = do
]
description
- = case ifaceRnDoc iface of
- Nothing -> empty
- Just doc -> docToLaTeX doc
+ = (fromMaybe empty . documentationToLaTeX . ifaceRnDoc) iface
body = processExports exports
--
@@ -210,7 +208,7 @@ processExports (e : es) =
isSimpleSig :: ExportItem DocName -> Maybe ([DocName], HsType DocName)
isSimpleSig (ExportDecl (L _ (SigD (TypeSig lnames (L _ t))))
- (Nothing, argDocs) _ _)
+ (Documentation Nothing, argDocs) _ _)
| Map.null argDocs = Just (map unLoc lnames, t)
isSimpleSig _ = Nothing
@@ -276,24 +274,24 @@ ppDecl :: LHsDecl DocName
-> [(DocName, DocForDecl DocName)]
-> LaTeX
-ppDecl (L loc decl) (mbDoc, fnArgsDoc) instances subdocs = case decl of
- TyClD d@(TyFamily {}) -> ppTyFam False loc mbDoc d unicode
+ppDecl (L loc decl) (doc, fnArgsDoc) instances subdocs = case decl of
+ TyClD d@(TyFamily {}) -> ppTyFam False loc doc d unicode
TyClD d@(TyData {})
- | Nothing <- tcdTyPats d -> ppDataDecl instances subdocs loc mbDoc d unicode
- | Just _ <- tcdTyPats d -> ppDataInst loc mbDoc d
+ | Nothing <- tcdTyPats d -> ppDataDecl instances subdocs loc doc d unicode
+ | Just _ <- tcdTyPats d -> ppDataInst loc doc d
TyClD d@(TySynonym {})
- | Nothing <- tcdTyPats d -> ppTySyn loc (mbDoc, fnArgsDoc) d unicode
- | Just _ <- tcdTyPats d -> ppTyInst False loc mbDoc d unicode
- TyClD d@(ClassDecl {}) -> ppClassDecl instances loc mbDoc subdocs d unicode
- SigD (TypeSig lnames (L _ t)) -> ppFunSig loc (mbDoc, fnArgsDoc) (map unLoc lnames) t unicode
- ForD d -> ppFor loc (mbDoc, fnArgsDoc) d unicode
+ | Nothing <- tcdTyPats d -> ppTySyn loc (doc, fnArgsDoc) d unicode
+ | Just _ <- tcdTyPats d -> ppTyInst False loc doc d unicode
+ TyClD d@(ClassDecl {}) -> ppClassDecl instances loc doc subdocs d unicode
+ SigD (TypeSig lnames (L _ t)) -> ppFunSig loc (doc, fnArgsDoc) (map unLoc lnames) t unicode
+ ForD d -> ppFor loc (doc, fnArgsDoc) d unicode
InstD _ -> empty
_ -> error "declaration not supported by ppDecl"
where
unicode = False
-ppTyFam :: Bool -> SrcSpan -> Maybe (Doc DocName) ->
+ppTyFam :: Bool -> SrcSpan -> Documentation DocName ->
TyClDecl DocName -> Bool -> LaTeX
ppTyFam _ _ _ _ _ =
error "type family declarations are currently not supported by --latex"
@@ -304,7 +302,7 @@ ppDataInst =
error "data instance declarations are currently not supported by --latex"
-ppTyInst :: Bool -> SrcSpan -> Maybe (Doc DocName) ->
+ppTyInst :: Bool -> SrcSpan -> Documentation DocName ->
TyClDecl DocName -> Bool -> LaTeX
ppTyInst _ _ _ _ _ =
error "type instance declarations are currently not supported by --latex"
@@ -355,13 +353,13 @@ ppTypeOrFunSig :: SrcSpan -> [DocName] -> HsType DocName
ppTypeOrFunSig _ _ typ (doc, argDocs) (pref1, pref2, sep0)
unicode
| Map.null argDocs =
- declWithDoc pref1 (fmap docToLaTeX doc)
+ declWithDoc pref1 (documentationToLaTeX doc)
| otherwise =
declWithDoc pref2 $ Just $
text "\\haddockbeginargs" $$
do_args 0 sep0 typ $$
text "\\end{tabulary}\\par" $$
- maybe empty docToLaTeX doc
+ fromMaybe empty (documentationToLaTeX doc)
where
do_largs n leader (L _ t) = do_args n leader t
@@ -469,9 +467,9 @@ ppFds fds unicode =
ppClassDecl :: [DocInstance DocName] -> SrcSpan
- -> Maybe (Doc DocName) -> [(DocName, DocForDecl DocName)]
+ -> Documentation DocName -> [(DocName, DocForDecl DocName)]
-> TyClDecl DocName -> Bool -> LaTeX
-ppClassDecl instances loc mbDoc subdocs
+ppClassDecl instances loc doc subdocs
(ClassDecl lctxt lname ltyvars lfds lsigs _ ats at_defs _) unicode
= declWithDoc classheader (if null body then Nothing else Just (vcat body)) $$
instancesBit
@@ -482,7 +480,7 @@ ppClassDecl instances loc mbDoc subdocs
hdr = ppClassHdr False lctxt (unLoc lname) ltyvars lfds
- body = catMaybes [fmap docToLaTeX mbDoc, body_]
+ body = catMaybes [documentationToLaTeX doc, body_]
body_
| null lsigs, null ats, null at_defs = Nothing
@@ -523,8 +521,8 @@ isUndocdInstance _ = Nothing
-- an 'argBox'. The comment is printed to the right of the box in normal comment
-- style.
ppDocInstance :: Bool -> DocInstance DocName -> LaTeX
-ppDocInstance unicode (instHead, mbDoc) =
- declWithDoc (ppInstDecl unicode instHead) (fmap docToLaTeX mbDoc)
+ppDocInstance unicode (instHead, doc) =
+ declWithDoc (ppInstDecl unicode instHead) (fmap docToLaTeX doc)
ppInstDecl :: Bool -> InstHead DocName -> LaTeX
@@ -550,9 +548,9 @@ lookupAnySubdoc n subdocs = case lookup n subdocs of
ppDataDecl :: [DocInstance DocName] ->
[(DocName, DocForDecl DocName)] ->
- SrcSpan -> Maybe (Doc DocName) -> TyClDecl DocName -> Bool ->
+ SrcSpan -> Documentation DocName -> TyClDecl DocName -> Bool ->
LaTeX
-ppDataDecl instances subdocs _loc mbDoc dataDecl unicode
+ppDataDecl instances subdocs _loc doc dataDecl unicode
= declWithDoc (ppDataHeader dataDecl unicode <+> whereBit)
(if null body then Nothing else Just (vcat body))
@@ -562,7 +560,7 @@ ppDataDecl instances subdocs _loc mbDoc dataDecl unicode
cons = tcdCons dataDecl
resTy = (con_res . unLoc . head) cons
- body = catMaybes [constrBit, fmap docToLaTeX mbDoc]
+ body = catMaybes [constrBit, documentationToLaTeX doc]
(whereBit, leaders)
| null cons = (empty,[])
@@ -642,7 +640,7 @@ ppSideBySideConstr subdocs unicode leader (L _ con) =
forall = con_explicit con
-- don't use "con_doc con", in case it's reconstructed from a .hi file,
-- or also because we want Haddock to do the doc-parsing, not GHC.
- mbDoc = lookup (unLoc $ con_name con) subdocs >>= fst
+ mbDoc = lookup (unLoc $ con_name con) subdocs >>= (\(Documentation mDoc) -> mDoc) . fst
mkFunTy a b = noLoc (HsFunTy a b)
@@ -652,7 +650,7 @@ ppSideBySideField subdocs unicode (ConDeclField (L _ name) ltype _) =
<+> dcolon unicode <+> ppLType unicode ltype) <-> rDoc mbDoc
where
-- don't use cd_fld_doc for same reason we don't use con_doc above
- mbDoc = lookup name subdocs >>= fst
+ mbDoc = lookup name subdocs >>= (\(Documentation mDoc) -> mDoc) . fst
-- {-
-- ppHsFullConstr :: HsConDecl -> LaTeX
@@ -1042,6 +1040,10 @@ docToLaTeX :: Doc DocName -> LaTeX
docToLaTeX doc = markup latexMarkup doc Plain
+documentationToLaTeX :: Documentation DocName -> Maybe LaTeX
+documentationToLaTeX (Documentation mDoc) = docToLaTeX `fmap` mDoc
+
+
rdrDocToLaTeX :: Doc RdrName -> LaTeX
rdrDocToLaTeX doc = markup rdrLatexMarkup doc Plain
diff --git a/src/Haddock/Backends/Xhtml.hs b/src/Haddock/Backends/Xhtml.hs
index 94ca6d10..c5925cda 100644
--- a/src/Haddock/Backends/Xhtml.hs
+++ b/src/Haddock/Backends/Xhtml.hs
@@ -508,18 +508,16 @@ ifaceToHtml maybe_source_url maybe_wiki_url iface unicode qual
-- todo: if something has only sub-docs, or fn-args-docs, should
-- it be measured here and thus prevent omitting the synopsis?
- has_doc (ExportDecl _ doc _ _) = isJust (fst doc)
+ has_doc (ExportDecl _ (Documentation mDoc, _) _ _) = isJust mDoc
has_doc (ExportNoDecl _ _) = False
has_doc (ExportModule _) = False
has_doc _ = True
no_doc_at_all = not (any has_doc exports)
- description
- = case ifaceRnDoc iface of
- Nothing -> noHtml
- Just doc -> divDescription $
- sectionName << "Description" +++ docSection qual doc
+ description | isNoHtml doc = doc
+ | otherwise = divDescription $ sectionName << "Description" +++ doc
+ where doc = docSection qual (ifaceRnDoc iface)
-- omit the synopsis if there are no documentation annotations at all
synopsis
@@ -639,7 +637,7 @@ processExport summary _ _ qual (ExportNoDecl y subs)
= processDeclOneLiner summary $
ppDocName qual y +++ parenList (map (ppDocName qual) subs)
processExport summary _ _ qual (ExportDoc doc)
- = nothingIf summary $ docSection qual doc
+ = nothingIf summary $ docSection_ qual doc
processExport summary _ _ _ (ExportModule mdl)
= processDeclOneLiner summary $ toHtml "module" <+> ppModule mdl
diff --git a/src/Haddock/Backends/Xhtml/Decl.hs b/src/Haddock/Backends/Xhtml/Decl.hs
index 3cfba1de..66b78cbd 100644
--- a/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/src/Haddock/Backends/Xhtml/Decl.hs
@@ -71,9 +71,9 @@ ppTypeOrFunSig :: Bool -> LinksInfo -> SrcSpan -> [DocName] -> HsType DocName
-> DocForDecl DocName -> (Html, Html, Html) -> Bool -> Qualification -> Html
ppTypeOrFunSig summary links loc docnames typ (doc, argDocs) (pref1, pref2, sep) unicode qual
| summary = pref1
- | Map.null argDocs = topDeclElem links loc docnames pref1 +++ maybeDocSection qual doc
+ | Map.null argDocs = topDeclElem links loc docnames pref1 +++ docSection qual doc
| otherwise = topDeclElem links loc docnames pref2 +++
- subArguments qual (do_args 0 sep typ) +++ maybeDocSection qual doc
+ subArguments qual (do_args 0 sep typ) +++ docSection qual doc
where
argDoc n = Map.lookup n argDocs
@@ -166,12 +166,12 @@ ppTyFamHeader summary associated decl unicode qual =
Nothing -> noHtml
-ppTyFam :: Bool -> Bool -> LinksInfo -> SrcSpan -> Maybe (Doc DocName) ->
+ppTyFam :: Bool -> Bool -> LinksInfo -> SrcSpan -> Documentation DocName ->
TyClDecl DocName -> Bool -> Qualification -> Html
-ppTyFam summary associated links loc mbDoc decl unicode qual
+ppTyFam summary associated links loc doc decl unicode qual
| summary = ppTyFamHeader True associated decl unicode qual
- | otherwise = header_ +++ maybeDocSection qual mbDoc +++ instancesBit
+ | otherwise = header_ +++ docSection qual doc +++ instancesBit
where
docname = tcdName decl
@@ -206,12 +206,12 @@ ppDataInst = undefined
--------------------------------------------------------------------------------
-ppTyInst :: Bool -> Bool -> LinksInfo -> SrcSpan -> Maybe (Doc DocName) ->
+ppTyInst :: Bool -> Bool -> LinksInfo -> SrcSpan -> Documentation DocName ->
TyClDecl DocName -> Bool -> Qualification -> Html
-ppTyInst summary associated links loc mbDoc decl unicode qual
+ppTyInst summary associated links loc doc decl unicode qual
| summary = ppTyInstHeader True associated decl unicode qual
- | otherwise = header_ +++ maybeDocSection qual mbDoc
+ | otherwise = header_ +++ docSection qual doc
where
docname = tcdName decl
@@ -367,12 +367,12 @@ ppShortClassDecl _ _ _ _ _ _ _ = error "declaration type not supported by ppShor
ppClassDecl :: Bool -> LinksInfo -> [DocInstance DocName] -> SrcSpan
- -> Maybe (Doc DocName) -> [(DocName, DocForDecl DocName)]
+ -> Documentation DocName -> [(DocName, DocForDecl DocName)]
-> TyClDecl DocName -> Bool -> Qualification -> Html
-ppClassDecl summary links instances loc mbDoc subdocs
+ppClassDecl summary links instances loc d subdocs
decl@(ClassDecl lctxt lname ltyvars lfds lsigs _ ats _ _) unicode qual
| summary = ppShortClassDecl summary links decl loc subdocs unicode qual
- | otherwise = classheader +++ maybeDocSection qual mbDoc
+ | otherwise = classheader +++ docSection qual d
+++ atBit +++ methodBit +++ instancesBit
where
classheader
@@ -449,12 +449,12 @@ ppShortDataDecl summary _links _loc dataDecl unicode qual
ppDataDecl :: Bool -> LinksInfo -> [DocInstance DocName] ->
[(DocName, DocForDecl DocName)] ->
- SrcSpan -> Maybe (Doc DocName) -> TyClDecl DocName -> Bool ->
+ SrcSpan -> Documentation DocName -> TyClDecl DocName -> Bool ->
Qualification -> Html
-ppDataDecl summary links instances subdocs loc mbDoc dataDecl unicode qual
+ppDataDecl summary links instances subdocs loc doc dataDecl unicode qual
| summary = ppShortDataDecl summary links loc dataDecl unicode qual
- | otherwise = header_ +++ maybeDocSection qual mbDoc +++ constrBit +++ instancesBit
+ | otherwise = header_ +++ docSection qual doc +++ constrBit +++ instancesBit
where
docname = unLoc . tcdLName $ dataDecl
@@ -588,7 +588,7 @@ ppSideBySideConstr subdocs unicode qual (L _ con) = (decl, mbDoc, fieldPart)
forall_ = con_explicit con
-- don't use "con_doc con", in case it's reconstructed from a .hi file,
-- or also because we want Haddock to do the doc-parsing, not GHC.
- mbDoc = lookup (unLoc $ con_name con) subdocs >>= fst
+ mbDoc = lookup (unLoc $ con_name con) subdocs >>= (\(Documentation mDoc) -> mDoc) . fst
mkFunTy a b = noLoc (HsFunTy a b)
@@ -600,7 +600,7 @@ ppSideBySideField subdocs unicode qual (ConDeclField (L _ name) ltype _) =
[])
where
-- don't use cd_fld_doc for same reason we don't use con_doc above
- mbDoc = lookup name subdocs >>= fst
+ mbDoc = lookup name subdocs >>= (\(Documentation mDoc) -> mDoc) . fst
ppShortField :: Bool -> Bool -> Qualification -> ConDeclField DocName -> Html
diff --git a/src/Haddock/Backends/Xhtml/DocMarkup.hs b/src/Haddock/Backends/Xhtml/DocMarkup.hs
index ee0a549f..cd1595f6 100644
--- a/src/Haddock/Backends/Xhtml/DocMarkup.hs
+++ b/src/Haddock/Backends/Xhtml/DocMarkup.hs
@@ -15,7 +15,7 @@ module Haddock.Backends.Xhtml.DocMarkup (
rdrDocToHtml,
origDocToHtml,
- docElement, docSection, maybeDocSection,
+ docElement, docSection, docSection_,
) where
@@ -85,12 +85,12 @@ docElement el content_ =
else el ! [theclass "doc"] << content_
-docSection :: Qualification -> Doc DocName -> Html
-docSection qual = (docElement thediv <<) . docToHtml qual
+docSection :: Qualification -> Documentation DocName -> Html
+docSection qual (Documentation doc) = maybe noHtml (docSection_ qual) doc
-maybeDocSection :: Qualification -> Maybe (Doc DocName) -> Html
-maybeDocSection qual = maybe noHtml (docSection qual)
+docSection_ :: Qualification -> Doc DocName -> Html
+docSection_ qual = (docElement thediv <<) . docToHtml qual
cleanup :: Doc a -> Doc a
diff --git a/src/Haddock/Interface/Create.hs b/src/Haddock/Interface/Create.hs
index ea4636fe..e2cc9959 100644
--- a/src/Haddock/Interface/Create.hs
+++ b/src/Haddock/Interface/Create.hs
@@ -117,8 +117,8 @@ createInterface tm flags modMap instIfaceMap = do
ifaceMod = mdl,
ifaceOrigFilename = msHsFilePath ms,
ifaceInfo = info,
- ifaceDoc = mbDoc,
- ifaceRnDoc = Nothing,
+ ifaceDoc = Documentation mbDoc,
+ ifaceRnDoc = Documentation Nothing,
ifaceOptions = opts,
ifaceDocMap = docMap,
ifaceArgMap = argMap,
@@ -609,10 +609,12 @@ hiValExportItem name doc = do
lookupDocs :: Name -> DocMap Name -> ArgMap Name -> SubMap -> (DocForDecl Name, [(Name, DocForDecl Name)])
lookupDocs n docMap argMap subMap =
let lookupArgDoc x = M.findWithDefault M.empty x argMap in
- let doc = (M.lookup n docMap, lookupArgDoc n) in
+ let doc = (lookupDoc n, lookupArgDoc n) in
let subs = M.findWithDefault [] n subMap in
- let subDocs = [ (s, (M.lookup s docMap, lookupArgDoc s)) | s <- subs ] in
+ let subDocs = [ (s, (lookupDoc s, lookupArgDoc s)) | s <- subs ] in
(doc, subDocs)
+ where
+ lookupDoc = Documentation . (`M.lookup` docMap)
-- | Return all export items produced by an exported module. That is, we're
@@ -772,7 +774,7 @@ extractRecSel nm mdl t tvs (L _ con : rest) =
pruneExportItems :: [ExportItem Name] -> [ExportItem Name]
pruneExportItems = filter hasDoc
where
- hasDoc (ExportDecl{expItemMbDoc = (d, _)}) = isJust d
+ hasDoc (ExportDecl{expItemMbDoc = (Documentation d, _)}) = isJust d
hasDoc _ = True
diff --git a/src/Haddock/Interface/Rename.hs b/src/Haddock/Interface/Rename.hs
index cffe68b8..fd2a1f10 100644
--- a/src/Haddock/Interface/Rename.hs
+++ b/src/Haddock/Interface/Rename.hs
@@ -47,7 +47,7 @@ renameInterface renamingEnv warnings iface =
(rnArgMap, missingNames3) = runRnFM localEnv (mapM (mapM renameDoc) (ifaceArgMap iface))
(finalModuleDoc, missingNames4)
- = runRnFM localEnv (renameMaybeDoc (ifaceDoc iface))
+ = runRnFM localEnv (renameDocumentation (ifaceDoc iface))
-- combine the missing names and filter out the built-ins, which would
-- otherwise allways be missing.
@@ -142,15 +142,13 @@ renameExportItems :: [ExportItem Name] -> RnM [ExportItem DocName]
renameExportItems = mapM renameExportItem
-renameDocForDecl :: (Maybe (Doc Name), FnArgsDoc Name) -> RnM (Maybe (Doc DocName), FnArgsDoc DocName)
-renameDocForDecl (mbDoc, fnArgsDoc) = do
- mbDoc' <- renameMaybeDoc mbDoc
- fnArgsDoc' <- renameFnArgsDoc fnArgsDoc
- return (mbDoc', fnArgsDoc')
+renameDocForDecl :: DocForDecl Name -> RnM (DocForDecl DocName)
+renameDocForDecl (doc, fnArgsDoc) =
+ (,) `fmap` renameDocumentation doc `ap` renameFnArgsDoc fnArgsDoc
-renameMaybeDoc :: Maybe (Doc Name) -> RnM (Maybe (Doc DocName))
-renameMaybeDoc = mapM renameDoc
+renameDocumentation :: Documentation Name -> RnM (Documentation DocName)
+renameDocumentation (Documentation mDoc) = Documentation <$> mapM renameDoc mDoc
renameLDocHsSyn :: LHsDocString -> RnM LHsDocString
diff --git a/src/Haddock/Types.hs b/src/Haddock/Types.hs
index 97d56a52..f8d51b2b 100644
--- a/src/Haddock/Types.hs
+++ b/src/Haddock/Types.hs
@@ -67,10 +67,10 @@ data Interface = Interface
, ifaceInfo :: !(HaddockModInfo Name)
-- | Documentation header.
- , ifaceDoc :: !(Maybe (Doc Name))
+ , ifaceDoc :: !(Documentation Name)
-- | Documentation header with cross-reference information.
- , ifaceRnDoc :: Maybe (Doc DocName)
+ , ifaceRnDoc :: Documentation DocName
-- | Haddock options for this module (prune, ignore-exports, etc).
, ifaceOptions :: ![DocOption]
@@ -214,19 +214,23 @@ data ExportItem name
| ExportModule Module
+newtype Documentation name = Documentation (Maybe (Doc name))
+ deriving Functor
+
+
-- | Arguments and result are indexed by Int, zero-based from the left,
-- because that's the easiest to use when recursing over types.
type FnArgsDoc name = Map Int (Doc name)
-type DocForDecl name = (Maybe (Doc name), FnArgsDoc name)
+type DocForDecl name = (Documentation name, FnArgsDoc name)
noDocForDecl :: DocForDecl name
-noDocForDecl = (Nothing, Map.empty)
+noDocForDecl = (Documentation Nothing, Map.empty)
unrenameDocForDecl :: DocForDecl DocName -> DocForDecl Name
-unrenameDocForDecl (mbDoc, fnArgsDoc) =
- (fmap unrenameDoc mbDoc, fmap unrenameDoc fnArgsDoc)
+unrenameDocForDecl (doc, fnArgsDoc) =
+ (fmap getName doc, (fmap . fmap) getName fnArgsDoc)
-----------------------------------------------------------------------------
@@ -304,10 +308,6 @@ instance Monoid (Doc id) where
mappend = DocAppend
-unrenameDoc :: Doc DocName -> Doc Name
-unrenameDoc = fmap getName
-
-
data Example = Example
{ exampleExpression :: String
, exampleResult :: [String]
generated by cgit v1.2.3 (git 2.39.1) at 2025-10-31 05:18:19 +0000