diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/Haddock/Backends/LaTeX.hs | 5 | ||||
| -rw-r--r-- | src/Haddock/Backends/Xhtml/Decl.hs | 3 | ||||
| -rw-r--r-- | src/Haddock/Backends/Xhtml/Names.hs | 5 | ||||
| -rw-r--r-- | src/Haddock/Convert.hs | 9 | ||||
| -rw-r--r-- | src/Haddock/Interface/Rename.hs | 3 | 
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  | 
