aboutsummaryrefslogtreecommitdiff
path: root/src/Haddock
diff options
context:
space:
mode:
Diffstat (limited to 'src/Haddock')
-rw-r--r--src/Haddock/Backends/LaTeX.hs14
-rw-r--r--src/Haddock/Backends/Xhtml.hs4
-rw-r--r--src/Haddock/Backends/Xhtml/Decl.hs16
-rw-r--r--src/Haddock/Types.hs5
4 files changed, 17 insertions, 22 deletions
diff --git a/src/Haddock/Backends/LaTeX.hs b/src/Haddock/Backends/LaTeX.hs
index 7bfd0e4a..7f53d926 100644
--- a/src/Haddock/Backends/LaTeX.hs
+++ b/src/Haddock/Backends/LaTeX.hs
@@ -631,7 +631,7 @@ ppSideBySideConstr subdocs unicode leader (L _ con) =
header_ = ppConstrHdr forall tyVars context
- occ = docNameOcc . unLoc . con_name $ con
+ occ = nameOccName . getName . unLoc . con_name $ con
ltvs = con_qvars con
tyVars = tyvarNames (con_qvars con)
context = unLoc (con_cxt con)
@@ -645,7 +645,7 @@ ppSideBySideConstr subdocs unicode leader (L _ con) =
ppSideBySideField :: [(DocName, DocForDecl DocName)] -> Bool -> ConDeclField DocName -> LaTeX
ppSideBySideField subdocs unicode (ConDeclField (L _ name) ltype _) =
- decltt (ppBinder (docNameOcc name)
+ decltt (ppBinder (nameOccName . getName $ name)
<+> dcolon unicode <+> ppLType unicode ltype) <-> rDoc mbDoc
where
-- don't use cd_fld_doc for same reason we don't use con_doc above
@@ -736,7 +736,7 @@ ppAppNameTypes n ts unicode = ppTypeApp n ts ppDocName (ppParendType unicode)
-- | Print an application of a DocName and a list of Names
ppAppDocNameNames :: Bool -> DocName -> [Name] -> LaTeX
ppAppDocNameNames _summ n ns =
- ppTypeApp n ns (ppBinder . docNameOcc) ppSymName
+ ppTypeApp n ns (ppBinder . nameOccName . getName) ppSymName
-- | General printing of type applications
@@ -889,7 +889,7 @@ ppr_mono_ty ctxt_prec (HsOpTy ty1 op ty2) unicode
ppr_mono_lty pREC_OP ty1 unicode <+> ppr_op <+> ppr_mono_lty pREC_OP ty2 unicode
where
ppr_op = if not (isSymOcc occName) then char '`' <> ppLDocName op <> char '`' else ppLDocName op
- occName = docNameOcc . unLoc $ op
+ occName = nameOccName . getName . unLoc $ op
ppr_mono_ty ctxt_prec (HsParTy ty) unicode
-- = parens (ppr_mono_lty pREC_TOP ty)
@@ -934,7 +934,7 @@ ppOccName = text . occNameString
ppVerbDocName :: DocName -> LaTeX
-ppVerbDocName = ppVerbOccName . docNameOcc
+ppVerbDocName = ppVerbOccName . nameOccName . getName
ppVerbRdrName :: RdrName -> LaTeX
@@ -942,7 +942,7 @@ ppVerbRdrName = ppVerbOccName . rdrNameOcc
ppDocName :: DocName -> LaTeX
-ppDocName = ppOccName . docNameOcc
+ppDocName = ppOccName . nameOccName . getName
ppLDocName :: Located DocName -> LaTeX
@@ -950,7 +950,7 @@ ppLDocName (L _ d) = ppDocName d
ppDocBinder :: DocName -> LaTeX
-ppDocBinder = ppBinder . docNameOcc
+ppDocBinder = ppBinder . nameOccName . getName
ppName :: Name -> LaTeX
diff --git a/src/Haddock/Backends/Xhtml.hs b/src/Haddock/Backends/Xhtml.hs
index e126eb9b..bb9c29d1 100644
--- a/src/Haddock/Backends/Xhtml.hs
+++ b/src/Haddock/Backends/Xhtml.hs
@@ -565,7 +565,7 @@ processForMiniSynopsis mdl unicode _ (ExportDecl (L _loc decl0) _doc _ _insts) =
(ClassDecl {}) -> Just $ keyword "class" <+> b
_ -> Nothing
SigD (TypeSig (L _ n) (L _ _)) ->
- Just $ ppNameMini mdl (docNameOcc n)
+ Just $ ppNameMini mdl (nameOccName . getName $ n)
_ -> Nothing
processForMiniSynopsis _ _ qual (ExportGroup lvl _id txt) =
Just $ groupTag lvl << docToHtml qual txt
@@ -583,7 +583,7 @@ ppTyClBinderWithVarsMini :: Module -> TyClDecl DocName -> Html
ppTyClBinderWithVarsMini mdl decl =
let n = unLoc $ tcdLName decl
ns = tyvarNames $ tcdTyVars decl
- in ppTypeApp n ns (ppNameMini mdl . docNameOcc) ppTyName
+ in ppTypeApp n ns (ppNameMini mdl . nameOccName . getName) ppTyName
ppModuleContents :: Qualification -> [ExportItem DocName] -> Html
diff --git a/src/Haddock/Backends/Xhtml/Decl.hs b/src/Haddock/Backends/Xhtml/Decl.hs
index 1efb7fd4..ce0dccda 100644
--- a/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/src/Haddock/Backends/Xhtml/Decl.hs
@@ -63,7 +63,7 @@ ppFunSig summary links loc doc docname typ unicode qual =
(ppTypeSig summary occname typ unicode qual, ppBinder False occname, dcolon unicode)
unicode qual
where
- occname = docNameOcc docname
+ occname = nameOccName . getName $ docname
ppTypeOrFunSig :: Bool -> LinksInfo -> SrcSpan -> DocName -> HsType DocName ->
@@ -124,7 +124,7 @@ ppTySyn summary links loc doc (TySynonym (L _ name) ltyvars _ ltype) unicode qua
where
hdr = hsep ([keyword "type", ppBinder summary occ] ++ ppTyVars ltyvars)
full = hdr <+> equals <+> ppLType unicode qual ltype
- occ = docNameOcc name
+ occ = nameOccName . getName $ name
ppTySyn _ _ _ _ _ _ _ = error "declaration not supported by ppTySyn"
@@ -264,7 +264,7 @@ ppAppNameTypes n ts unicode qual =
-- | Print an application of a DocName and a list of Names
ppAppDocNameNames :: Bool -> DocName -> [Name] -> Html
ppAppDocNameNames summ n ns =
- ppTypeApp n ns (ppBinder summ . docNameOcc) ppTyName
+ ppTypeApp n ns (ppBinder summ . nameOccName . getName) ppTyName
-- | General printing of type applications
@@ -521,7 +521,7 @@ ppShortConstrParts summary con unicode qual = case con_res con of
ppLType unicode qual (foldr mkFunTy resTy args) ]
header_ = ppConstrHdr forall tyVars context
- occ = docNameOcc . unLoc . con_name $ con
+ occ = nameOccName . getName . unLoc . con_name $ con
ltvs = con_qvars con
tyVars = tyvarNames ltvs
lcontext = con_cxt con
@@ -581,7 +581,7 @@ ppSideBySideConstr subdocs unicode qual (L _ con) = (decl, mbDoc, fieldPart)
ppLType unicode qual (foldr mkFunTy resTy args) ]
header_ = ppConstrHdr forall tyVars context
- occ = docNameOcc . unLoc . con_name $ con
+ occ = nameOccName . getName . unLoc . con_name $ con
ltvs = con_qvars con
tyVars = tyvarNames (con_qvars con)
context = unLoc (con_cxt con)
@@ -596,7 +596,7 @@ ppSideBySideConstr subdocs unicode qual (L _ con) = (decl, mbDoc, fieldPart)
ppSideBySideField :: [(DocName, DocForDecl DocName)] -> Bool -> Qualification
-> ConDeclField DocName -> SubDecl
ppSideBySideField subdocs unicode qual (ConDeclField (L _ name) ltype _) =
- (ppBinder False (docNameOcc name) <+> dcolon unicode <+> ppLType unicode qual ltype,
+ (ppBinder False (nameOccName . getName $ name) <+> dcolon unicode <+> ppLType unicode qual ltype,
mbDoc,
[])
where
@@ -606,7 +606,7 @@ ppSideBySideField subdocs unicode qual (ConDeclField (L _ name) ltype _) =
ppShortField :: Bool -> Bool -> Qualification -> ConDeclField DocName -> Html
ppShortField summary unicode qual (ConDeclField (L _ name) ltype _)
- = ppBinder summary (docNameOcc name)
+ = ppBinder summary (nameOccName . getName $ name)
<+> dcolon unicode <+> ppLType unicode qual ltype
@@ -726,7 +726,7 @@ ppr_mono_ty ctxt_prec (HsOpTy ty1 op ty2) unicode qual
ppr_mono_lty pREC_OP ty1 unicode qual <+> ppr_op <+> ppr_mono_lty pREC_OP ty2 unicode qual
where
ppr_op = if not (isSymOcc occName) then quote (ppLDocName qual op) else ppLDocName qual op
- occName = docNameOcc . unLoc $ op
+ occName = nameOccName . getName . unLoc $ op
ppr_mono_ty ctxt_prec (HsParTy ty) unicode qual
-- = parens (ppr_mono_lty pREC_TOP ty)
diff --git a/src/Haddock/Types.hs b/src/Haddock/Types.hs
index 6b4063c0..3cfc7875 100644
--- a/src/Haddock/Types.hs
+++ b/src/Haddock/Types.hs
@@ -235,11 +235,6 @@ data DocName = Documented Name Module | Undocumented Name deriving Eq
-- TODO: simplify to data DocName = DocName Name (Maybe Module)
--- | The 'OccName' of this name.
-docNameOcc :: DocName -> OccName
-docNameOcc = nameOccName . getName
-
-
instance NamedThing DocName where
getName (Documented name _) = name
getName (Undocumented name) = name
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-24 18:38:00 +0000