From 3792158f04a7cf14c700ecab448f043b8ddec6b7 Mon Sep 17 00:00:00 2001 From: David Waern Date: Mon, 15 Nov 2010 21:44:19 +0000 Subject: Remove docNameOcc under the motto "don't name compositions" --- src/Haddock/Backends/LaTeX.hs | 14 +++++++------- src/Haddock/Backends/Xhtml.hs | 4 ++-- src/Haddock/Backends/Xhtml/Decl.hs | 16 ++++++++-------- src/Haddock/Types.hs | 5 ----- 4 files changed, 17 insertions(+), 22 deletions(-) (limited to 'src/Haddock') 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 -- cgit v1.2.3