Remove docNameOcc under the motto "don't name compositions"

5 files changed, 17 insertions, 23 deletions

diff --git a/src/Documentation/Haddock.hs b/src/Documentation/Haddock.hs
index cfa1220d..496c1f00 100644
--- a/src/Documentation/Haddock.hs
+++ b/src/Documentation/Haddock.hs
@@ -29,7 +29,6 @@ module Documentation.Haddock (
   -- * Hyperlinking
   LinkEnv,
   DocName(..),
-  docNameOcc,
 
   -- * Instances
   DocInstance,
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