aboutsummaryrefslogtreecommitdiff
path: root/src/Haddock
diff options
context:
space:
mode:
Diffstat (limited to 'src/Haddock')
-rw-r--r--src/Haddock/Backends/LaTeX.hs5
-rw-r--r--src/Haddock/Backends/Xhtml/Decl.hs3
-rw-r--r--src/Haddock/Backends/Xhtml/Names.hs5
-rw-r--r--src/Haddock/Convert.hs9
-rw-r--r--src/Haddock/Interface/Rename.hs3
5 files changed, 16 insertions, 9 deletions
diff --git a/src/Haddock/Backends/LaTeX.hs b/src/Haddock/Backends/LaTeX.hs
index fc07a07e..f03801bb 100644
--- a/src/Haddock/Backends/LaTeX.hs
+++ b/src/Haddock/Backends/LaTeX.hs
@@ -24,7 +24,6 @@ import GHC
import OccName
import Name ( nameOccName )
import RdrName ( rdrNameOcc )
-import BasicTypes ( ipNameName )
import FastString ( unpackFS, unpackLitString )
import qualified Data.Map as Map
@@ -853,7 +852,7 @@ ppr_mono_ty _ (HsTupleTy con tys) u = tupleParens con (map (ppLType u) t
ppr_mono_ty _ (HsKindSig ty kind) u = parens (ppr_mono_lty pREC_TOP ty u <+> dcolon u <+> ppLKind u kind)
ppr_mono_ty _ (HsListTy ty) u = brackets (ppr_mono_lty pREC_TOP ty u)
ppr_mono_ty _ (HsPArrTy ty) u = pabrackets (ppr_mono_lty pREC_TOP ty u)
-ppr_mono_ty _ (HsIParamTy n ty) u = brackets (ppDocName (ipNameName n) <+> dcolon u <+> ppr_mono_lty pREC_TOP ty u)
+ppr_mono_ty _ (HsIParamTy n ty) u = brackets (ppIPName n <+> dcolon u <+> ppr_mono_lty pREC_TOP ty u)
ppr_mono_ty _ (HsSpliceTy {}) _ = error "ppr_mono_ty HsSpliceTy"
ppr_mono_ty _ (HsQuasiQuoteTy {}) _ = error "ppr_mono_ty HsQuasiQuoteTy"
ppr_mono_ty _ (HsRecTy {}) _ = error "ppr_mono_ty HsRecTy"
@@ -923,6 +922,8 @@ ppSymName name
ppVerbOccName :: OccName -> LaTeX
ppVerbOccName = text . latexFilter . occNameString
+ppIPName :: HsIPName -> LaTeX
+ppIPName ip = text $ unpackFS $ hsIPNameFS ip
ppOccName :: OccName -> LaTeX
ppOccName = text . occNameString
diff --git a/src/Haddock/Backends/Xhtml/Decl.hs b/src/Haddock/Backends/Xhtml/Decl.hs
index b4afee3d..b5ad1a8f 100644
--- a/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/src/Haddock/Backends/Xhtml/Decl.hs
@@ -33,7 +33,6 @@ import Text.XHtml hiding ( name, title, p, quote )
import GHC
import Name
-import BasicTypes ( ipNameName )
-- TODO: use DeclInfo DocName or something
@@ -674,7 +673,7 @@ ppr_mono_ty _ (HsKindSig ty kind) u q =
parens (ppr_mono_lty pREC_TOP ty u q <+> dcolon u <+> ppLKind u q kind)
ppr_mono_ty _ (HsListTy ty) u q = brackets (ppr_mono_lty pREC_TOP ty u q)
ppr_mono_ty _ (HsPArrTy ty) u q = pabrackets (ppr_mono_lty pREC_TOP ty u q)
-ppr_mono_ty _ (HsIParamTy n ty) u q = brackets (ppDocName q (ipNameName n) <+> dcolon u <+> ppr_mono_lty pREC_TOP ty u q)
+ppr_mono_ty _ (HsIParamTy n ty) u q = brackets (ppIPName n <+> dcolon u <+> ppr_mono_lty pREC_TOP ty u q)
ppr_mono_ty _ (HsSpliceTy {}) _ _ = error "ppr_mono_ty HsSpliceTy"
#if __GLASGOW_HASKELL__ == 612
ppr_mono_ty _ (HsSpliceTyOut {}) _ _ = error "ppr_mono_ty HsQuasiQuoteTy"
diff --git a/src/Haddock/Backends/Xhtml/Names.hs b/src/Haddock/Backends/Xhtml/Names.hs
index 7c2375cf..f07f42e0 100644
--- a/src/Haddock/Backends/Xhtml/Names.hs
+++ b/src/Haddock/Backends/Xhtml/Names.hs
@@ -14,6 +14,7 @@ module Haddock.Backends.Xhtml.Names (
ppName, ppDocName, ppLDocName, ppRdrName, ppUncheckedLink,
ppBinder, ppBinder',
ppModule, ppModuleRef,
+ ppIPName,
linkId
) where
@@ -29,6 +30,7 @@ import qualified Data.List as List
import GHC
import Name
import RdrName
+import FastString (unpackFS)
ppOccName :: OccName -> Html
@@ -38,6 +40,9 @@ ppOccName = toHtml . occNameString
ppRdrName :: RdrName -> Html
ppRdrName = ppOccName . rdrNameOcc
+ppIPName :: HsIPName -> Html
+ppIPName = toHtml . unpackFS . hsIPNameFS
+
ppUncheckedLink :: Qualification -> (ModuleName, OccName) -> Html
ppUncheckedLink _ (mdl, occ) = linkIdOcc' mdl (Just occ) << ppOccName occ -- TODO: apply ppQualifyName
diff --git a/src/Haddock/Convert.hs b/src/Haddock/Convert.hs
index b5b905e7..7c9a2ee5 100644
--- a/src/Haddock/Convert.hs
+++ b/src/Haddock/Convert.hs
@@ -20,6 +20,7 @@ module Haddock.Convert where
import HsSyn
import TcType ( tcSplitTyConApp_maybe, tcSplitSigmaTy )
import TypeRep
+import Type(isStrLitTy)
import Kind ( splitKindFunTys, synTyConResKind )
import Name
import Var
@@ -29,6 +30,7 @@ import DataCon
import BasicTypes ( TupleSort(..) )
import TysPrim ( alphaTyVars )
import TysWiredIn ( listTyConName, eqTyCon )
+import PrelNames (ipClassName)
import Bag ( emptyBag )
import SrcLoc ( Located, noLoc, unLoc )
import Data.List( partition )
@@ -275,9 +277,10 @@ synifyType _ (TyConApp tc tys)
| getName tc == listTyConName, [ty] <- tys =
noLoc $ HsListTy (synifyType WithinType ty)
-- ditto for implicit parameter tycons
- | Just ip <- tyConIP_maybe tc
- , [ty] <- tys
- = noLoc $ HsIParamTy ip (synifyType WithinType ty)
+ | tyConName tc == ipClassName
+ , [name, ty] <- tys
+ , Just x <- isStrLitTy name
+ = noLoc $ HsIParamTy (HsIPName x) (synifyType WithinType ty)
-- and equalities
| tc == eqTyCon
, [ty1, ty2] <- tys
diff --git a/src/Haddock/Interface/Rename.hs b/src/Haddock/Interface/Rename.hs
index b762bcbb..380147be 100644
--- a/src/Haddock/Interface/Rename.hs
+++ b/src/Haddock/Interface/Rename.hs
@@ -18,7 +18,6 @@ import Haddock.GhcUtils
import GHC hiding (NoLink)
import Name
import Bag (emptyBag)
-import BasicTypes ( IPName(..), ipNameName )
import Data.List
import qualified Data.Map as Map hiding ( Map )
@@ -236,7 +235,7 @@ renameType t = case t of
HsListTy ty -> return . HsListTy =<< renameLType ty
HsPArrTy ty -> return . HsPArrTy =<< renameLType ty
- HsIParamTy n ty -> liftM2 HsIParamTy (liftM IPName (rename (ipNameName n))) (renameLType ty)
+ HsIParamTy n ty -> liftM (HsIParamTy n) (renameLType ty)
HsEqTy ty1 ty2 -> liftM2 HsEqTy (renameLType ty1) (renameLType ty2)
HsTupleTy b ts -> return . HsTupleTy b =<< mapM renameLType ts