diff options
| author | Niklas Haas <git@nand.wakku.to> | 2014-02-23 15:21:52 +0100 |
|---|---|---|
| committer | Niklas Haas <git@nand.wakku.to> | 2014-02-23 15:21:52 +0100 |
| commit | 14531f7838c5abd0ba2aaf5217a477194d7b1897 (patch) | |
| tree | 193113d2e0c81bb918b5436f34618b5f4d5c2f77 /src/Haddock | |
| parent | 1944b94edca881d14e979d564719da6f196f8e63 (diff) | |
Make ImplicitParams render correctly (#260)
This introduces a new precedence level for single contexts (because
implicit param contexts always need parens around them, but other types
of contexts don't necessarily, even when alone)
Diffstat (limited to 'src/Haddock')
| -rw-r--r-- | src/Haddock/Backends/Xhtml/Decl.hs | 19 | ||||
| -rw-r--r-- | src/Haddock/Backends/Xhtml/Names.hs | 2 |
2 files changed, 13 insertions, 8 deletions
diff --git a/src/Haddock/Backends/Xhtml/Decl.hs b/src/Haddock/Backends/Xhtml/Decl.hs index 72369069..427d5670 100644 --- a/src/Haddock/Backends/Xhtml/Decl.hs +++ b/src/Haddock/Backends/Xhtml/Decl.hs @@ -325,7 +325,7 @@ ppContext cxt unicode qual = ppContextNoLocs (map unLoc cxt) unicode qual ppHsContext :: [HsType DocName] -> Bool -> Qualification-> Html ppHsContext [] _ _ = noHtml -ppHsContext [p] unicode qual = ppType unicode qual p +ppHsContext [p] unicode qual = ppCtxType unicode qual p ppHsContext cxt unicode qual = parenList (map (ppType unicode qual) cxt) @@ -669,14 +669,16 @@ tupleParens _ = parenList -------------------------------------------------------------------------------- -pREC_TOP, pREC_FUN, pREC_OP, pREC_CON :: Int +pREC_TOP, pREC_CTX, pREC_FUN, pREC_OP, pREC_CON :: Int pREC_TOP = 0 :: Int -- type in ParseIface.y in GHC -pREC_FUN = 1 :: Int -- btype in ParseIface.y in GHC +pREC_CTX = 1 :: Int -- Used for single contexts, eg. ctx => type + -- (as opposed to (ctx1, ctx2) => type) +pREC_FUN = 2 :: Int -- btype in ParseIface.y in GHC -- Used for LH arg of (->) -pREC_OP = 2 :: Int -- Used for arg of any infix operator +pREC_OP = 3 :: Int -- Used for arg of any infix operator -- (we don't keep their fixities around) -pREC_CON = 3 :: Int -- Used for arg of type applicn: +pREC_CON = 4 :: Int -- Used for arg of type applicn: -- always parenthesise unless atomic maybeParen :: Int -- Precedence of context @@ -693,8 +695,10 @@ ppLParendType unicode qual y = ppParendType unicode qual (unLoc y) ppLFunLhType unicode qual y = ppFunLhType unicode qual (unLoc y) -ppType, ppParendType, ppFunLhType :: Bool -> Qualification-> HsType DocName -> Html +ppType, ppCtxType, ppParendType, ppFunLhType :: Bool -> Qualification + -> HsType DocName -> Html ppType unicode qual ty = ppr_mono_ty pREC_TOP ty unicode qual +ppCtxType unicode qual ty = ppr_mono_ty pREC_CTX ty unicode qual ppParendType unicode qual ty = ppr_mono_ty pREC_CON ty unicode qual ppFunLhType unicode qual ty = ppr_mono_ty pREC_FUN ty unicode qual @@ -735,7 +739,8 @@ 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 (ppIPName n <+> dcolon u <+> ppr_mono_lty pREC_TOP ty u q) +ppr_mono_ty ctxt_prec (HsIParamTy n ty) u q = + maybeParen ctxt_prec pREC_CTX $ ppIPName n <+> dcolon u <+> ppr_mono_lty pREC_TOP ty u q 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" diff --git a/src/Haddock/Backends/Xhtml/Names.hs b/src/Haddock/Backends/Xhtml/Names.hs index 24577e2a..33cd4f78 100644 --- a/src/Haddock/Backends/Xhtml/Names.hs +++ b/src/Haddock/Backends/Xhtml/Names.hs @@ -46,7 +46,7 @@ ppRdrName :: RdrName -> Html ppRdrName = ppOccName . rdrNameOcc ppIPName :: HsIPName -> Html -ppIPName = toHtml . unpackFS . hsIPNameFS +ppIPName = toHtml . ('?':) . unpackFS . hsIPNameFS ppUncheckedLink :: Qualification -> (ModuleName, OccName) -> Html |