aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Haddock/Backends/Xhtml/Decl.hs146
1 files changed, 73 insertions, 73 deletions
diff --git a/src/Haddock/Backends/Xhtml/Decl.hs b/src/Haddock/Backends/Xhtml/Decl.hs
index 8ebe8f6b..fac99530 100644
--- a/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/src/Haddock/Backends/Xhtml/Decl.hs
@@ -12,7 +12,7 @@
-----------------------------------------------------------------------------
module Haddock.Backends.Xhtml.Decl (
ppDecl,
-
+
ppTyName, ppTyFamHeader, ppTypeApp,
tyvarNames
) where
@@ -37,13 +37,13 @@ import Outputable ( ppr, showSDoc, Outputable )
-- TODO: use DeclInfo DocName or something
-ppDecl :: Bool -> LinksInfo -> LHsDecl DocName ->
+ppDecl :: Bool -> LinksInfo -> LHsDecl DocName ->
DocForDecl DocName -> [DocInstance DocName] -> [(DocName, DocForDecl DocName)] -> Bool -> Html
ppDecl summ links (L loc decl) (mbDoc, fnArgsDoc) instances subdocs unicode = case decl of
TyClD d@(TyFamily {}) -> ppTyFam summ False links loc mbDoc d unicode
TyClD d@(TyData {})
| Nothing <- tcdTyPats d -> ppDataDecl summ links instances subdocs loc mbDoc d unicode
- | Just _ <- tcdTyPats d -> ppDataInst summ links loc mbDoc d
+ | Just _ <- tcdTyPats d -> ppDataInst summ links loc mbDoc d
TyClD d@(TySynonym {})
| Nothing <- tcdTyPats d -> ppTySyn summ links loc (mbDoc, fnArgsDoc) d unicode
| Just _ <- tcdTyPats d -> ppTyInst summ False links loc mbDoc d unicode
@@ -68,13 +68,13 @@ ppTypeOrFunSig summary links loc docname typ (doc, argDocs) (pref1, pref2, sep)
| Map.null argDocs = topDeclElem links loc docname pref1 +++ maybeDocSection doc
| otherwise = topDeclElem links loc docname pref2 +++
subArguments (do_args 0 sep typ) +++ maybeDocSection doc
- where
+ where
argDoc n = Map.lookup n argDocs
- do_largs n leader (L _ t) = do_args n leader t
+ do_largs n leader (L _ t) = do_args n leader t
do_args :: Int -> Html -> (HsType DocName) -> [SubDecl]
do_args n leader (HsForAllTy Explicit tvs lctxt ltype)
- = (leader <+>
+ = (leader <+>
hsep (forallSymbol unicode : ppTyVars tvs ++ [dot]) <+>
ppLContextNoArrow lctxt unicode,
Nothing, [])
@@ -101,7 +101,7 @@ ppTyVars tvs = map ppTyName (tyvarNames tvs)
tyvarNames :: [LHsTyVarBndr DocName] -> [Name]
tyvarNames = map (getName . hsTyVarName . unLoc)
-
+
ppFor :: Bool -> LinksInfo -> SrcSpan -> DocForDecl DocName -> ForeignDecl DocName -> Bool -> Html
ppFor summary links loc doc (ForeignImport (L _ name) (L _ typ) _) unicode
@@ -112,7 +112,7 @@ ppFor _ _ _ _ _ _ = error "ppFor"
-- we skip type patterns for now
ppTySyn :: Bool -> LinksInfo -> SrcSpan -> DocForDecl DocName -> TyClDecl DocName -> Bool -> Html
ppTySyn summary links loc doc (TySynonym (L _ name) ltyvars _ ltype) unicode
- = ppTypeOrFunSig summary links loc name (unLoc ltype) doc
+ = ppTypeOrFunSig summary links loc name (unLoc ltype) doc
(full, hdr, spaceHtml +++ equals) unicode
where
hdr = hsep ([keyword "type", ppBinder summary occ] ++ ppTyVars ltyvars)
@@ -151,15 +151,15 @@ ppTyFamHeader summary associated decl unicode =
ppTyClBinderWithVars summary decl <+>
case tcdKind decl of
- Just kind -> dcolon unicode <+> ppKind kind
+ Just kind -> dcolon unicode <+> ppKind kind
Nothing -> noHtml
ppTyFam :: Bool -> Bool -> LinksInfo -> SrcSpan -> Maybe (Doc DocName) ->
TyClDecl DocName -> Bool -> Html
ppTyFam summary associated links loc mbDoc decl unicode
-
- | summary = ppTyFamHeader True associated decl unicode
+
+ | summary = ppTyFamHeader True associated decl unicode
| otherwise = header_ +++ maybeDocSection mbDoc +++ instancesBit
where
@@ -194,13 +194,13 @@ ppDataInst = undefined
-- Indexed types
--------------------------------------------------------------------------------
-
+
ppTyInst :: Bool -> Bool -> LinksInfo -> SrcSpan -> Maybe (Doc DocName) ->
TyClDecl DocName -> Bool -> Html
ppTyInst summary associated links loc mbDoc decl unicode
-
+
| summary = ppTyInstHeader True associated decl unicode
- | otherwise = header_ +++ maybeDocSection mbDoc
+ | otherwise = header_ +++ maybeDocSection mbDoc
where
docname = tcdName decl
@@ -219,14 +219,14 @@ ppTyInstHeader _ _ decl unicode =
--------------------------------------------------------------------------------
-- Associated Types
--------------------------------------------------------------------------------
-
+
ppAssocType :: Bool -> LinksInfo -> DocForDecl DocName -> LTyClDecl DocName -> Bool -> Html
-ppAssocType summ links doc (L loc decl) unicode =
+ppAssocType summ links doc (L loc decl) unicode =
case decl of
TyFamily {} -> ppTyFam summ True links loc (fst doc) decl unicode
TySynonym {} -> ppTySyn summ links loc doc decl unicode
- _ -> error "declaration type not supported by ppAssocType"
+ _ -> error "declaration type not supported by ppAssocType"
--------------------------------------------------------------------------------
@@ -236,7 +236,7 @@ ppAssocType summ links doc (L loc decl) unicode =
-- | Print a type family / newtype / data / class binder and its variables
ppTyClBinderWithVars :: Bool -> TyClDecl DocName -> Html
-ppTyClBinderWithVars summ decl =
+ppTyClBinderWithVars summ decl =
ppAppDocNameNames summ (unLoc $ tcdLName decl) (tyvarNames $ tcdTyVars decl)
@@ -252,7 +252,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] -> Html
-ppAppDocNameNames summ n ns =
+ppAppDocNameNames summ n ns =
ppTypeApp n ns (ppBinder summ . docNameOcc) ppTyName
@@ -269,7 +269,7 @@ ppTypeApp n ts ppDN ppT = ppDN n <+> hsep (map ppT ts)
-------------------------------------------------------------------------------
--- Contexts
+-- Contexts
-------------------------------------------------------------------------------
@@ -313,8 +313,8 @@ ppPred unicode (HsIParam (IPName n) t)
ppClassHdr :: Bool -> Located [LHsPred DocName] -> DocName
-> [Located (HsTyVarBndr DocName)] -> [Located ([DocName], [DocName])]
-> Bool -> Html
-ppClassHdr summ lctxt n tvs fds unicode =
- keyword "class"
+ppClassHdr summ lctxt n tvs fds unicode =
+ keyword "class"
<+> (if not . null . unLoc $ lctxt then ppLContext lctxt unicode else noHtml)
<+> ppAppDocNameNames summ n (tyvarNames $ tvs)
<+> ppFds fds unicode
@@ -322,7 +322,7 @@ ppClassHdr summ lctxt n tvs fds unicode =
ppFds :: [Located ([DocName], [DocName])] -> Bool -> Html
ppFds fds unicode =
- if null fds then noHtml else
+ if null fds then noHtml else
char '|' <+> hsep (punctuate comma (map (fundep . unLoc) fds))
where
fundep (vars1,vars2) = hsep (map ppDocName vars1) <+> arrow unicode <+>
@@ -340,13 +340,13 @@ ppShortClassDecl summary links (ClassDecl lctxt lname tvs fds sigs _ ats _) loc
[ ppFunSig summary links loc doc n typ unicode
| L _ (TypeSig (L _ n) (L _ typ)) <- sigs
- , let doc = lookupAnySubdoc n subdocs ]
+ , let doc = lookupAnySubdoc n subdocs ]
)
where
hdr = ppClassHdr summary lctxt (unLoc lname) tvs fds unicode
nm = unLoc lname
ppShortClassDecl _ _ _ _ _ _ = error "declaration type not supported by ppShortClassDecl"
-
+
ppClassDecl :: Bool -> LinksInfo -> [DocInstance DocName] -> SrcSpan
@@ -357,7 +357,7 @@ ppClassDecl summary links instances loc mbDoc subdocs
| summary = ppShortClassDecl summary links decl loc subdocs unicode
| otherwise = classheader +++ maybeDocSection mbDoc
+++ atBit +++ methodBit +++ instancesBit
- where
+ where
classheader
| null lsigs = topDeclElem links loc nm (hdr unicode)
| otherwise = topDeclElem links loc nm (hdr unicode <+> keyword "where")
@@ -365,7 +365,7 @@ ppClassDecl summary links instances loc mbDoc subdocs
nm = unLoc $ tcdLName decl
hdr = ppClassHdr summary lctxt (unLoc lname) ltyvars lfds
-
+
atBit = subAssociatedTypes [ ppAssocType summary links doc at unicode
| at <- ats
, let doc = lookupAnySubdoc (tcdName $ unL at) subdocs ]
@@ -375,7 +375,7 @@ ppClassDecl summary links instances loc mbDoc subdocs
, let doc = lookupAnySubdoc n subdocs ]
instancesBit = ppInstances instances nm unicode
-
+
ppClassDecl _ _ _ _ _ _ _ _ = error "declaration type not supported by ppShortClassDecl"
@@ -396,7 +396,7 @@ lookupAnySubdoc :: (Eq name1) =>
lookupAnySubdoc n subdocs = case lookup n subdocs of
Nothing -> noDocForDecl
Just docs -> docs
-
+
-- -----------------------------------------------------------------------------
@@ -410,7 +410,7 @@ ppShortDataDecl summary _links _loc dataDecl unicode
| [] <- cons = dataHeader
| [lcon] <- cons, ResTyH98 <- resTy,
- (cHead,cBody,cFoot) <- ppShortConstrParts summary (unLoc lcon) unicode
+ (cHead,cBody,cFoot) <- ppShortConstrParts summary (unLoc lcon) unicode
= (dataHeader <+> equals <+> cHead) +++ cBody +++ cFoot
| ResTyH98 <- resTy = dataHeader
@@ -418,7 +418,7 @@ ppShortDataDecl summary _links _loc dataDecl unicode
| otherwise = (dataHeader <+> keyword "where")
+++ shortSubDecls (map doGADTConstr cons)
-
+
where
dataHeader = ppDataHeader summary dataDecl unicode
doConstr c con = toHtml [c] <+> ppShortConstr summary (unLoc con) unicode
@@ -431,25 +431,25 @@ ppDataDecl :: Bool -> LinksInfo -> [DocInstance DocName] ->
[(DocName, DocForDecl DocName)] ->
SrcSpan -> Maybe (Doc DocName) -> TyClDecl DocName -> Bool -> Html
ppDataDecl summary links instances subdocs loc mbDoc dataDecl unicode
-
+
| summary = ppShortDataDecl summary links loc dataDecl unicode
| otherwise = header_ +++ maybeDocSection mbDoc +++ constrBit +++ instancesBit
where
docname = unLoc . tcdLName $ dataDecl
cons = tcdCons dataDecl
- resTy = (con_res . unLoc . head) cons
-
+ resTy = (con_res . unLoc . head) cons
+
header_ = topDeclElem links loc docname (ppDataHeader summary dataDecl unicode
<+> whereBit)
- whereBit
- | null cons = noHtml
- | otherwise = case resTy of
+ whereBit
+ | null cons = noHtml
+ | otherwise = case resTy of
ResTyGADT _ -> keyword "where"
- _ -> noHtml
+ _ -> noHtml
- constrBit = subConstructors
+ constrBit = subConstructors
(map (ppSideBySideConstr subdocs unicode) cons)
instancesBit = ppInstances instances docname unicode
@@ -460,14 +460,14 @@ ppShortConstr :: Bool -> ConDecl DocName -> Bool -> Html
ppShortConstr summary con unicode = cHead <+> cBody <+> cFoot
where
(cHead,cBody,cFoot) = ppShortConstrParts summary con unicode
-
+
-- returns three pieces: header, body, footer so that header & footer can be
-- incorporated into the declaration
ppShortConstrParts :: Bool -> ConDecl DocName -> Bool -> (Html, Html, Html)
-ppShortConstrParts summary con unicode = case con_res con of
- ResTyH98 -> case con_details con of
- PrefixCon args ->
+ppShortConstrParts summary con unicode = case con_res con of
+ ResTyH98 -> case con_details con of
+ PrefixCon args ->
(header_ unicode +++ hsep (ppBinder summary occ : map (ppLParendType unicode) args),
noHtml, noHtml)
RecCon fields ->
@@ -478,7 +478,7 @@ ppShortConstrParts summary con unicode = case con_res con of
(header_ unicode +++ hsep [ppLParendType unicode arg1, ppBinder summary occ, ppLParendType unicode arg2],
noHtml, noHtml)
- ResTyGADT resTy -> case con_details con of
+ ResTyGADT resTy -> case con_details con of
-- prefix & infix could use hsConDeclArgTys if it seemed to
-- simplify the code.
PrefixCon args -> (doGADTCon args resTy, noHtml, noHtml)
@@ -491,7 +491,7 @@ ppShortConstrParts summary con unicode = case con_res con of
doRecordFields fields,
char '}' <+> arrow unicode <+> ppLType unicode resTy)
InfixCon arg1 arg2 -> (doGADTCon [arg1, arg2] resTy, noHtml, noHtml)
-
+
where
doRecordFields fields = shortSubDecls (map (ppShortField summary unicode) fields)
doGADTCon args resTy = ppBinder summary occ <+> dcolon unicode <+> hsep [
@@ -501,7 +501,7 @@ ppShortConstrParts summary con unicode = case con_res con of
header_ = ppConstrHdr forall tyVars context
occ = docNameOcc . unLoc . con_name $ con
ltvs = con_qvars con
- tyVars = tyvarNames ltvs
+ tyVars = tyvarNames ltvs
lcontext = con_cxt con
context = unLoc (con_cxt con)
forall = con_explicit con
@@ -518,26 +518,26 @@ ppConstrHdr forall tvs ctxt unicode
+++
(if null ctxt then noHtml else ppContextNoArrow ctxt unicode <+> darrow unicode +++ toHtml " ")
where
- ppForall = case forall of
+ ppForall = case forall of
Explicit -> forallSymbol unicode <+> hsep (map ppName tvs) <+> toHtml ". "
Implicit -> noHtml
ppSideBySideConstr :: [(DocName, DocForDecl DocName)] -> Bool -> LConDecl DocName -> SubDecl
ppSideBySideConstr subdocs unicode (L _ con) = (decl, mbDoc, fieldPart)
- where
- decl = case con_res con of
- ResTyH98 -> case con_details con of
- PrefixCon args ->
+ where
+ decl = case con_res con of
+ ResTyH98 -> case con_details con of
+ PrefixCon args ->
hsep ((header_ unicode +++ ppBinder False occ)
: map (ppLParendType unicode) args)
-
+
RecCon _ -> header_ unicode +++ ppBinder False occ
-
- InfixCon arg1 arg2 ->
+
+ InfixCon arg1 arg2 ->
hsep [header_ unicode+++ppLParendType unicode arg1,
ppBinder False occ,
ppLParendType unicode arg2]
-
+
ResTyGADT resTy -> case con_details con of
-- prefix & infix could also use hsConDeclArgTys if it seemed to
-- simplify the code.
@@ -545,11 +545,11 @@ ppSideBySideConstr subdocs unicode (L _ con) = (decl, mbDoc, fieldPart)
cd@(RecCon _) -> doGADTCon (hsConDeclArgTys cd) resTy
InfixCon arg1 arg2 -> doGADTCon [arg1, arg2] resTy
- fieldPart = case con_details con of
+ fieldPart = case con_details con of
RecCon fields -> [doRecordFields fields]
_ -> []
- doRecordFields fields = subFields
+ doRecordFields fields = subFields
(map (ppSideBySideField subdocs unicode) fields)
doGADTCon :: [LHsType DocName] -> Located (HsType DocName) -> Html
doGADTCon args resTy =
@@ -590,9 +590,9 @@ ppShortField summary unicode (ConDeclField (L _ name) ltype _)
ppDataHeader :: Bool -> TyClDecl DocName -> Bool -> Html
ppDataHeader summary decl unicode
| not (isDataDecl decl) = error "ppDataHeader: illegal argument"
- | otherwise =
+ | otherwise =
-- newtype or data
- (if tcdND decl == NewType then keyword "newtype" else keyword "data") <+>
+ (if tcdND decl == NewType then keyword "newtype" else keyword "data") <+>
-- context
ppLContext (tcdCtxt decl) unicode <+>
-- T a b c ..., or a :+: b
@@ -608,18 +608,18 @@ ppKind k = toHtml $ showSDoc (ppr k)
ppBang :: HsBang -> Html
-ppBang HsNoBang = noHtml
+ppBang HsNoBang = noHtml
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 Unboxed = ubxParenList
--------------------------------------------------------------------------------
--- Rendering of HsType
+-- Rendering of HsType
--------------------------------------------------------------------------------
@@ -642,13 +642,13 @@ maybeParen ctxt_prec op_prec p | ctxt_prec >= op_prec = parens p
ppLType, ppLParendType, ppLFunLhType :: Bool -> Located (HsType DocName) -> Html
ppLType unicode y = ppType unicode (unLoc y)
-ppLParendType unicode y = ppParendType unicode (unLoc y)
+ppLParendType unicode y = ppParendType unicode (unLoc y)
ppLFunLhType unicode y = ppFunLhType unicode (unLoc y)
ppType, ppParendType, ppFunLhType :: Bool -> HsType DocName -> Html
-ppType unicode ty = ppr_mono_ty pREC_TOP ty unicode
-ppParendType unicode ty = ppr_mono_ty pREC_CON ty unicode
+ppType unicode ty = ppr_mono_ty pREC_TOP ty unicode
+ppParendType unicode ty = ppr_mono_ty pREC_CON ty unicode
ppFunLhType unicode ty = ppr_mono_ty pREC_FUN ty unicode
@@ -667,15 +667,15 @@ ppForAll expl tvs cxt unicode
where
show_forall = not (null tvs) && is_explicit
is_explicit = case expl of {Explicit -> True; Implicit -> False}
- forall_part = hsep (forallSymbol unicode : ppTyVars tvs) +++ dot
+ forall_part = hsep (forallSymbol unicode : ppTyVars tvs) +++ dot
ppr_mono_lty :: Int -> LHsType DocName -> Bool -> Html
-ppr_mono_lty ctxt_prec ty unicode = ppr_mono_ty ctxt_prec (unLoc ty) unicode
+ppr_mono_lty ctxt_prec ty unicode = ppr_mono_ty ctxt_prec (unLoc ty) unicode
ppr_mono_ty :: Int -> HsType DocName -> Bool -> Html
-ppr_mono_ty ctxt_prec (HsForAllTy expl tvs ctxt ty) unicode
+ppr_mono_ty ctxt_prec (HsForAllTy expl tvs ctxt ty) unicode
= maybeParen ctxt_prec pREC_FUN $
hsep [ppForAll expl tvs ctxt unicode, ppr_mono_lty pREC_TOP ty unicode]
@@ -696,26 +696,26 @@ ppr_mono_ty _ (HsQuasiQuoteTy {}) _ = error "ppr_mono_ty HsQuasiQuoteTy"
#endif
ppr_mono_ty _ (HsRecTy {}) _ = error "ppr_mono_ty HsRecTy"
-ppr_mono_ty ctxt_prec (HsAppTy fun_ty arg_ty) unicode
+ppr_mono_ty ctxt_prec (HsAppTy fun_ty arg_ty) unicode
= maybeParen ctxt_prec pREC_CON $
hsep [ppr_mono_lty pREC_FUN fun_ty unicode, ppr_mono_lty pREC_CON arg_ty unicode]
-ppr_mono_ty ctxt_prec (HsOpTy ty1 op ty2) unicode
+ppr_mono_ty ctxt_prec (HsOpTy ty1 op ty2) unicode
= maybeParen ctxt_prec pREC_FUN $
ppr_mono_lty pREC_OP ty1 unicode <+> ppr_op <+> ppr_mono_lty pREC_OP ty2 unicode
where
ppr_op = if not (isSymOcc occName) then quote (ppLDocName op) else ppLDocName op
occName = docNameOcc . unLoc $ op
-ppr_mono_ty ctxt_prec (HsParTy ty) unicode
+ppr_mono_ty ctxt_prec (HsParTy ty) unicode
-- = parens (ppr_mono_lty pREC_TOP ty)
= ppr_mono_lty ctxt_prec ty unicode
-ppr_mono_ty ctxt_prec (HsDocTy ty _) unicode
+ppr_mono_ty ctxt_prec (HsDocTy ty _) unicode
= ppr_mono_lty ctxt_prec ty unicode
-ppr_fun_ty :: Int -> LHsType DocName -> LHsType DocName -> Bool -> Html
+ppr_fun_ty :: Int -> LHsType DocName -> LHsType DocName -> Bool -> Html
ppr_fun_ty ctxt_prec ty1 ty2 unicode
= let p1 = ppr_mono_lty pREC_FUN ty1 unicode
p2 = ppr_mono_lty pREC_TOP ty2 unicode
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-28 22:08:23 +0000