aboutsummaryrefslogtreecommitdiff
path: root/src/Haddock/Backends/Xhtml/Decl.hs
diff options
context:
space:
mode:
authorDavid Waern <david.waern@gmail.com>2011-11-06 00:01:47 +0100
committerDavid Waern <david.waern@gmail.com>2011-11-06 00:01:47 +0100
commit2d0c63d4155fde1b5d8f51b66aa2393f265eaa7b (patch)
tree074f93a78bd3059e80cbfb1f1cd29aa5b960d340 /src/Haddock/Backends/Xhtml/Decl.hs
parent0a8d2696f88e0308fd689475ce2896b6ba014694 (diff)
parent2deba11b49ed5ca29e947e875349f870310d3746 (diff)
Merge branch 'master' of http://darcs.haskell.org/haddock
Diffstat (limited to 'src/Haddock/Backends/Xhtml/Decl.hs')
-rw-r--r--src/Haddock/Backends/Xhtml/Decl.hs38
1 files changed, 17 insertions, 21 deletions
diff --git a/src/Haddock/Backends/Xhtml/Decl.hs b/src/Haddock/Backends/Xhtml/Decl.hs
index add926ab..c1f3a89a 100644
--- a/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/src/Haddock/Backends/Xhtml/Decl.hs
@@ -32,9 +32,9 @@ import qualified Data.Map as Map
import Data.Maybe
import Text.XHtml hiding ( name, title, p, quote )
-import BasicTypes ( IPName(..), Boxity(..) )
import GHC
import Name
+import BasicTypes ( ipNameName )
import Outputable ( ppr, showSDoc, Outputable )
@@ -114,7 +114,7 @@ tyvarNames = map (getName . hsTyVarName . unLoc)
ppFor :: Bool -> LinksInfo -> SrcSpan -> DocForDecl DocName
-> ForeignDecl DocName -> Bool -> Qualification -> Html
-ppFor summary links loc doc (ForeignImport (L _ name) (L _ typ) _) unicode qual
+ppFor summary links loc doc (ForeignImport (L _ name) (L _ typ) _ _) unicode qual
= ppFunSig summary links loc doc [name] typ unicode qual
ppFor _ _ _ _ _ _ _ = error "ppFor"
@@ -301,7 +301,7 @@ ppContextNoArrow [] _ _ = noHtml
ppContextNoArrow cxt unicode qual = pp_hs_context (map unLoc cxt) unicode qual
-ppContextNoLocs :: [HsPred DocName] -> Bool -> Qualification -> Html
+ppContextNoLocs :: [HsType DocName] -> Bool -> Qualification -> Html
ppContextNoLocs [] _ _ = noHtml
ppContextNoLocs cxt unicode qual = pp_hs_context cxt unicode qual
<+> darrow unicode
@@ -311,18 +311,10 @@ ppContext :: HsContext DocName -> Bool -> Qualification -> Html
ppContext cxt unicode qual = ppContextNoLocs (map unLoc cxt) unicode qual
-pp_hs_context :: [HsPred DocName] -> Bool -> Qualification-> Html
+pp_hs_context :: [HsType DocName] -> Bool -> Qualification-> Html
pp_hs_context [] _ _ = noHtml
-pp_hs_context [p] unicode qual = ppPred unicode qual p
-pp_hs_context cxt unicode qual = parenList (map (ppPred unicode qual) cxt)
-
-
-ppPred :: Bool -> Qualification -> HsPred DocName -> Html
-ppPred unicode qual (HsClassP n ts) = ppAppNameTypes n (map unLoc ts) unicode qual
-ppPred unicode qual (HsEqualP t1 t2) = ppLType unicode qual t1 <+> toHtml "~"
- <+> ppLType unicode qual t2
-ppPred unicode qual (HsIParam (IPName n) t)
- = toHtml "?" +++ ppDocName qual n <+> dcolon unicode <+> ppLType unicode qual t
+pp_hs_context [p] unicode qual = ppType unicode qual p
+pp_hs_context cxt unicode qual = parenList (map (ppType unicode qual) cxt)
-------------------------------------------------------------------------------
@@ -330,7 +322,7 @@ ppPred unicode qual (HsIParam (IPName n) t)
-------------------------------------------------------------------------------
-ppClassHdr :: Bool -> Located [LHsPred DocName] -> DocName
+ppClassHdr :: Bool -> Located [LHsType DocName] -> DocName
-> [Located (HsTyVarBndr DocName)] -> [Located ([DocName], [DocName])]
-> Bool -> Qualification -> Html
ppClassHdr summ lctxt n tvs fds unicode qual =
@@ -352,7 +344,7 @@ ppFds fds unicode qual =
ppShortClassDecl :: Bool -> LinksInfo -> TyClDecl DocName -> SrcSpan
-> [(DocName, DocForDecl DocName)] -> Bool -> Qualification
-> Html
-ppShortClassDecl summary links (ClassDecl lctxt lname tvs fds sigs _ ats _) loc
+ppShortClassDecl summary links (ClassDecl lctxt lname tvs fds sigs _ ats _ _) loc
subdocs unicode qual =
if null sigs && null ats
then (if summary then id else topDeclElem links loc [nm]) hdr
@@ -381,7 +373,7 @@ ppClassDecl :: Bool -> LinksInfo -> [DocInstance DocName] -> SrcSpan
-> Maybe (Doc DocName) -> [(DocName, DocForDecl DocName)]
-> TyClDecl DocName -> Bool -> Qualification -> Html
ppClassDecl summary links instances loc mbDoc subdocs
- decl@(ClassDecl lctxt lname ltyvars lfds lsigs _ ats _) unicode qual
+ decl@(ClassDecl lctxt lname ltyvars lfds lsigs _ ats _ _) unicode qual
| summary = ppShortClassDecl summary links decl loc subdocs unicode qual
| otherwise = classheader +++ maybeDocSection qual mbDoc
+++ atBit +++ methodBit +++ instancesBit
@@ -653,9 +645,9 @@ ppBang _ = toHtml "!" -- Unpacked args is an implementation detail,
-- so we just show the strictness annotation
-tupleParens :: Boxity -> [Html] -> Html
-tupleParens Boxed = parenList
-tupleParens Unboxed = ubxParenList
+tupleParens :: HsTupleSort -> [Html] -> Html
+tupleParens (HsBoxyTuple _) = parenList
+tupleParens HsUnboxedTuple = ubxParenList
--------------------------------------------------------------------------------
@@ -724,7 +716,7 @@ ppr_mono_ty _ (HsKindSig ty kind) u q =
parens (ppr_mono_lty pREC_TOP ty u q <+> dcolon u <+> ppKind 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 _ (HsPredTy p) u q = parens (ppPred u q p)
+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 _ (HsSpliceTy {}) _ _ = error "ppr_mono_ty HsSpliceTy"
#if __GLASGOW_HASKELL__ == 612
ppr_mono_ty _ (HsSpliceTyOut {}) _ _ = error "ppr_mono_ty HsQuasiQuoteTy"
@@ -734,6 +726,10 @@ ppr_mono_ty _ (HsQuasiQuoteTy {}) _ _ = error "ppr_mono_ty HsQuasiQuoteT
ppr_mono_ty _ (HsRecTy {}) _ _ = error "ppr_mono_ty HsRecTy"
ppr_mono_ty _ (HsCoreTy {}) _ _ = error "ppr_mono_ty HsCoreTy"
+ppr_mono_ty ctxt_prec (HsEqTy ty1 ty2) unicode qual
+ = maybeParen ctxt_prec pREC_OP $
+ ppr_mono_lty pREC_OP ty1 unicode qual <+> char '~' <+> ppr_mono_lty pREC_OP ty2 unicode qual
+
ppr_mono_ty ctxt_prec (HsAppTy fun_ty arg_ty) unicode qual
= maybeParen ctxt_prec pREC_CON $
hsep [ppr_mono_lty pREC_FUN fun_ty unicode qual, ppr_mono_lty pREC_CON arg_ty unicode qual]