diff options
Diffstat (limited to 'src/Haddock/Backends/Xhtml')
| -rw-r--r-- | src/Haddock/Backends/Xhtml/Decl.hs | 278 | ||||
| -rw-r--r-- | src/Haddock/Backends/Xhtml/DocMarkup.hs | 8 | ||||
| -rw-r--r-- | src/Haddock/Backends/Xhtml/Layout.hs | 18 | ||||
| -rw-r--r-- | src/Haddock/Backends/Xhtml/Names.hs | 26 |
4 files changed, 165 insertions, 165 deletions
diff --git a/src/Haddock/Backends/Xhtml/Decl.hs b/src/Haddock/Backends/Xhtml/Decl.hs index 747e8f38..e45783bf 100644 --- a/src/Haddock/Backends/Xhtml/Decl.hs +++ b/src/Haddock/Backends/Xhtml/Decl.hs @@ -41,38 +41,38 @@ import Outputable ( ppr, showSDoc, Outputable ) ppDecl :: Bool -> LinksInfo -> LHsDecl DocName -> DocForDecl DocName -> [DocInstance DocName] -> [(DocName, DocForDecl DocName)] -> Bool -> Qualification -> Html -ppDecl summ links (L loc decl) (mbDoc, fnArgsDoc) instances subdocs unicode quali = case decl of - TyClD d@(TyFamily {}) -> ppTyFam summ False links loc mbDoc d unicode quali +ppDecl summ links (L loc decl) (mbDoc, fnArgsDoc) instances subdocs unicode qual = case decl of + TyClD d@(TyFamily {}) -> ppTyFam summ False links loc mbDoc d unicode qual TyClD d@(TyData {}) - | Nothing <- tcdTyPats d -> ppDataDecl summ links instances subdocs loc mbDoc d unicode quali + | Nothing <- tcdTyPats d -> ppDataDecl summ links instances subdocs loc mbDoc d unicode qual | Just _ <- tcdTyPats d -> ppDataInst summ links loc mbDoc d TyClD d@(TySynonym {}) - | Nothing <- tcdTyPats d -> ppTySyn summ links loc (mbDoc, fnArgsDoc) d unicode quali - | Just _ <- tcdTyPats d -> ppTyInst summ False links loc mbDoc d unicode quali - TyClD d@(ClassDecl {}) -> ppClassDecl summ links instances loc mbDoc subdocs d unicode quali - SigD (TypeSig (L _ n) (L _ t)) -> ppFunSig summ links loc (mbDoc, fnArgsDoc) n t unicode quali - ForD d -> ppFor summ links loc (mbDoc, fnArgsDoc) d unicode quali + | Nothing <- tcdTyPats d -> ppTySyn summ links loc (mbDoc, fnArgsDoc) d unicode qual + | Just _ <- tcdTyPats d -> ppTyInst summ False links loc mbDoc d unicode qual + TyClD d@(ClassDecl {}) -> ppClassDecl summ links instances loc mbDoc subdocs d unicode qual + SigD (TypeSig (L _ n) (L _ t)) -> ppFunSig summ links loc (mbDoc, fnArgsDoc) n t unicode qual + ForD d -> ppFor summ links loc (mbDoc, fnArgsDoc) d unicode qual InstD _ -> noHtml _ -> error "declaration not supported by ppDecl" ppFunSig :: Bool -> LinksInfo -> SrcSpan -> DocForDecl DocName -> DocName -> HsType DocName -> Bool -> Qualification -> Html -ppFunSig summary links loc doc docname typ unicode quali = +ppFunSig summary links loc doc docname typ unicode qual = ppTypeOrFunSig summary links loc docname typ doc - (ppTypeSig summary occname typ unicode quali, ppBinder False occname, dcolon unicode) - unicode quali + (ppTypeSig summary occname typ unicode qual, ppBinder False occname, dcolon unicode) + unicode qual where occname = docNameOcc docname ppTypeOrFunSig :: Bool -> LinksInfo -> SrcSpan -> DocName -> HsType DocName -> DocForDecl DocName -> (Html, Html, Html) -> Bool -> Qualification-> Html -ppTypeOrFunSig summary links loc docname typ (doc, argDocs) (pref1, pref2, sep) unicode quali +ppTypeOrFunSig summary links loc docname typ (doc, argDocs) (pref1, pref2, sep) unicode qual | summary = pref1 - | Map.null argDocs = topDeclElem links loc docname pref1 +++ maybeDocSection quali doc + | Map.null argDocs = topDeclElem links loc docname pref1 +++ maybeDocSection qual doc | otherwise = topDeclElem links loc docname pref2 +++ - subArguments quali (do_args 0 sep typ) +++ maybeDocSection quali doc + subArguments qual (do_args 0 sep typ) +++ maybeDocSection qual doc where argDoc n = Map.lookup n argDocs @@ -81,12 +81,12 @@ ppTypeOrFunSig summary links loc docname typ (doc, argDocs) (pref1, pref2, sep) do_args n leader (HsForAllTy Explicit tvs lctxt ltype) = (leader <+> hsep (forallSymbol unicode : ppTyVars tvs ++ [dot]) <+> - ppLContextNoArrow lctxt unicode quali, + ppLContextNoArrow lctxt unicode qual, Nothing, []) : do_largs n (darrow unicode) ltype do_args n leader (HsForAllTy Implicit _ lctxt ltype) | not (null (unLoc lctxt)) - = (leader <+> ppLContextNoArrow lctxt unicode quali, + = (leader <+> ppLContextNoArrow lctxt unicode qual, Nothing, []) : do_largs n (darrow unicode) ltype -- if we're not showing any 'forall' or class constraints or @@ -94,10 +94,10 @@ ppTypeOrFunSig summary links loc docname typ (doc, argDocs) (pref1, pref2, sep) | otherwise = do_largs n leader ltype do_args n leader (HsFunTy lt r) - = (leader <+> ppLFunLhType unicode quali lt, argDoc n, []) + = (leader <+> ppLFunLhType unicode qual lt, argDoc n, []) : do_largs (n+1) (arrow unicode) r do_args n leader t - = (leader <+> ppType unicode quali t, argDoc n, []) : [] + = (leader <+> ppType unicode qual t, argDoc n, []) : [] ppTyVars :: [LHsTyVarBndr DocName] -> [Html] @@ -110,27 +110,27 @@ 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 quali - = ppFunSig summary links loc doc name typ unicode quali +ppFor summary links loc doc (ForeignImport (L _ name) (L _ typ) _) unicode qual + = ppFunSig summary links loc doc name typ unicode qual ppFor _ _ _ _ _ _ _ = error "ppFor" -- we skip type patterns for now ppTySyn :: Bool -> LinksInfo -> SrcSpan -> DocForDecl DocName -> TyClDecl DocName -> Bool -> Qualification -> Html -ppTySyn summary links loc doc (TySynonym (L _ name) ltyvars _ ltype) unicode quali +ppTySyn summary links loc doc (TySynonym (L _ name) ltyvars _ ltype) unicode qual = ppTypeOrFunSig summary links loc name (unLoc ltype) doc - (full, hdr, spaceHtml +++ equals) unicode quali + (full, hdr, spaceHtml +++ equals) unicode qual where hdr = hsep ([keyword "type", ppBinder summary occ] ++ ppTyVars ltyvars) - full = hdr <+> equals <+> ppLType unicode quali ltype + full = hdr <+> equals <+> ppLType unicode qual ltype occ = docNameOcc name ppTySyn _ _ _ _ _ _ _ = error "declaration not supported by ppTySyn" ppTypeSig :: Bool -> OccName -> HsType DocName -> Bool -> Qualification -> Html -ppTypeSig summary nm ty unicode quali = - ppBinder summary nm <+> dcolon unicode <+> ppType unicode quali ty +ppTypeSig summary nm ty unicode qual = + ppBinder summary nm <+> dcolon unicode <+> ppType unicode qual ty ppTyName :: Name -> Html @@ -165,17 +165,17 @@ ppTyFamHeader summary associated decl unicode = ppTyFam :: Bool -> Bool -> LinksInfo -> SrcSpan -> Maybe (Doc DocName) -> TyClDecl DocName -> Bool -> Qualification -> Html -ppTyFam summary associated links loc mbDoc decl unicode quali +ppTyFam summary associated links loc mbDoc decl unicode qual | summary = ppTyFamHeader True associated decl unicode - | otherwise = header_ +++ maybeDocSection quali mbDoc +++ instancesBit + | otherwise = header_ +++ maybeDocSection qual mbDoc +++ instancesBit where docname = tcdName decl header_ = topDeclElem links loc docname (ppTyFamHeader summary associated decl unicode) - instancesBit = ppInstances instances docname unicode quali + instancesBit = ppInstances instances docname unicode qual -- TODO: get the instances instances = [] @@ -205,22 +205,22 @@ ppDataInst = undefined ppTyInst :: Bool -> Bool -> LinksInfo -> SrcSpan -> Maybe (Doc DocName) -> TyClDecl DocName -> Bool -> Qualification -> Html -ppTyInst summary associated links loc mbDoc decl unicode quali +ppTyInst summary associated links loc mbDoc decl unicode qual - | summary = ppTyInstHeader True associated decl unicode quali - | otherwise = header_ +++ maybeDocSection quali mbDoc + | summary = ppTyInstHeader True associated decl unicode qual + | otherwise = header_ +++ maybeDocSection qual mbDoc where docname = tcdName decl header_ = topDeclElem links loc docname - (ppTyInstHeader summary associated decl unicode quali) + (ppTyInstHeader summary associated decl unicode qual) ppTyInstHeader :: Bool -> Bool -> TyClDecl DocName -> Bool -> Qualification -> Html -ppTyInstHeader _ _ decl unicode quali = +ppTyInstHeader _ _ decl unicode qual = keyword "type instance" <+> - ppAppNameTypes (tcdName decl) typeArgs unicode quali + ppAppNameTypes (tcdName decl) typeArgs unicode qual where typeArgs = map unLoc . fromJust . tcdTyPats $ decl @@ -232,10 +232,10 @@ ppTyInstHeader _ _ decl unicode quali = ppAssocType :: Bool -> LinksInfo -> DocForDecl DocName -> LTyClDecl DocName -> Bool -> Qualification -> Html -ppAssocType summ links doc (L loc decl) unicode quali = +ppAssocType summ links doc (L loc decl) unicode qual = case decl of - TyFamily {} -> ppTyFam summ True links loc (fst doc) decl unicode quali - TySynonym {} -> ppTySyn summ links loc doc decl unicode quali + TyFamily {} -> ppTyFam summ True links loc (fst doc) decl unicode qual + TySynonym {} -> ppTySyn summ links loc doc decl unicode qual _ -> error "declaration type not supported by ppAssocType" @@ -257,8 +257,8 @@ ppTyClBinderWithVars summ decl = -- | Print an application of a DocName and a list of HsTypes ppAppNameTypes :: DocName -> [HsType DocName] -> Bool -> Qualification -> Html -ppAppNameTypes n ts unicode quali = - ppTypeApp n ts (ppDocName quali) (ppParendType unicode quali) +ppAppNameTypes n ts unicode qual = + ppTypeApp n ts (ppDocName qual) (ppParendType unicode qual) -- | Print an application of a DocName and a list of Names @@ -292,31 +292,31 @@ ppLContextNoArrow = ppContextNoArrow . unLoc ppContextNoArrow :: HsContext DocName -> Bool -> Qualification -> Html ppContextNoArrow [] _ _ = noHtml -ppContextNoArrow cxt unicode quali = pp_hs_context (map unLoc cxt) unicode quali +ppContextNoArrow cxt unicode qual = pp_hs_context (map unLoc cxt) unicode qual ppContextNoLocs :: [HsPred DocName] -> Bool -> Qualification -> Html ppContextNoLocs [] _ _ = noHtml -ppContextNoLocs cxt unicode quali = pp_hs_context cxt unicode quali +ppContextNoLocs cxt unicode qual = pp_hs_context cxt unicode qual <+> darrow unicode ppContext :: HsContext DocName -> Bool -> Qualification -> Html -ppContext cxt unicode quali = ppContextNoLocs (map unLoc cxt) unicode quali +ppContext cxt unicode qual = ppContextNoLocs (map unLoc cxt) unicode qual pp_hs_context :: [HsPred DocName] -> Bool -> Qualification-> Html pp_hs_context [] _ _ = noHtml -pp_hs_context [p] unicode quali = ppPred unicode quali p -pp_hs_context cxt unicode quali = parenList (map (ppPred unicode quali) cxt) +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 quali (HsClassP n ts) = ppAppNameTypes n (map unLoc ts) unicode quali -ppPred unicode quali (HsEqualP t1 t2) = ppLType unicode quali t1 <+> toHtml "~" - <+> ppLType unicode quali t2 -ppPred unicode quali (HsIParam (IPName n) t) - = toHtml "?" +++ ppDocName quali n <+> dcolon unicode <+> ppLType unicode quali t +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 ------------------------------------------------------------------------------- @@ -327,41 +327,41 @@ ppPred unicode quali (HsIParam (IPName n) t) ppClassHdr :: Bool -> Located [LHsPred DocName] -> DocName -> [Located (HsTyVarBndr DocName)] -> [Located ([DocName], [DocName])] -> Bool -> Qualification -> Html -ppClassHdr summ lctxt n tvs fds unicode quali = +ppClassHdr summ lctxt n tvs fds unicode qual = keyword "class" - <+> (if not . null . unLoc $ lctxt then ppLContext lctxt unicode quali else noHtml) + <+> (if not . null . unLoc $ lctxt then ppLContext lctxt unicode qual else noHtml) <+> ppAppDocNameNames summ n (tyvarNames $ tvs) - <+> ppFds fds unicode quali + <+> ppFds fds unicode qual ppFds :: [Located ([DocName], [DocName])] -> Bool -> Qualification -> Html -ppFds fds unicode quali = +ppFds fds unicode qual = if null fds then noHtml else char '|' <+> hsep (punctuate comma (map (fundep . unLoc) fds)) where - fundep (vars1,vars2) = hsep (map (ppDocName quali) vars1) <+> arrow unicode <+> - hsep (map (ppDocName quali) vars2) + fundep (vars1,vars2) = hsep (map (ppDocName qual) vars1) <+> arrow unicode <+> + hsep (map (ppDocName qual) vars2) ppShortClassDecl :: Bool -> LinksInfo -> TyClDecl DocName -> SrcSpan -> [(DocName, DocForDecl DocName)] -> Bool -> Qualification -> Html ppShortClassDecl summary links (ClassDecl lctxt lname tvs fds sigs _ ats _) loc - subdocs unicode quali = + subdocs unicode qual = if null sigs && null ats then (if summary then id else topDeclElem links loc nm) hdr else (if summary then id else topDeclElem links loc nm) (hdr <+> keyword "where") +++ shortSubDecls ( - [ ppAssocType summary links doc at unicode quali | at <- ats + [ ppAssocType summary links doc at unicode qual | at <- ats , let doc = lookupAnySubdoc (tcdName $ unL at) subdocs ] ++ - [ ppFunSig summary links loc doc n typ unicode quali + [ ppFunSig summary links loc doc n typ unicode qual | L _ (TypeSig (L _ n) (L _ typ)) <- sigs , let doc = lookupAnySubdoc n subdocs ] ) where - hdr = ppClassHdr summary lctxt (unLoc lname) tvs fds unicode quali + hdr = ppClassHdr summary lctxt (unLoc lname) tvs fds unicode qual nm = unLoc lname ppShortClassDecl _ _ _ _ _ _ _ = error "declaration type not supported by ppShortClassDecl" @@ -371,42 +371,42 @@ 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 quali - | summary = ppShortClassDecl summary links decl loc subdocs unicode quali - | otherwise = classheader +++ maybeDocSection quali mbDoc + 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 where classheader - | null lsigs = topDeclElem links loc nm (hdr unicode quali) - | otherwise = topDeclElem links loc nm (hdr unicode quali <+> keyword "where") + | null lsigs = topDeclElem links loc nm (hdr unicode qual) + | otherwise = topDeclElem links loc nm (hdr unicode qual <+> keyword "where") nm = unLoc $ tcdLName decl hdr = ppClassHdr summary lctxt (unLoc lname) ltyvars lfds - atBit = subAssociatedTypes [ ppAssocType summary links doc at unicode quali + atBit = subAssociatedTypes [ ppAssocType summary links doc at unicode qual | at <- ats , let doc = lookupAnySubdoc (tcdName $ unL at) subdocs ] - methodBit = subMethods [ ppFunSig summary links loc doc n typ unicode quali + methodBit = subMethods [ ppFunSig summary links loc doc n typ unicode qual | L _ (TypeSig (L _ n) (L _ typ)) <- lsigs , let doc = lookupAnySubdoc n subdocs ] - instancesBit = ppInstances instances nm unicode quali + instancesBit = ppInstances instances nm unicode qual ppClassDecl _ _ _ _ _ _ _ _ _ = error "declaration type not supported by ppShortClassDecl" ppInstances :: [DocInstance DocName] -> DocName -> Bool -> Qualification -> Html -ppInstances instances baseName unicode quali - = subInstances quali instName (map instDecl instances) +ppInstances instances baseName unicode qual + = subInstances qual instName (map instDecl instances) where instName = getOccString $ getName baseName instDecl :: DocInstance DocName -> SubDecl instDecl (inst, maybeDoc) = (instHead inst, maybeDoc, []) - instHead ([], n, ts) = ppAppNameTypes n ts unicode quali - instHead (ctxt, n, ts) = ppContextNoLocs ctxt unicode quali - <+> ppAppNameTypes n ts unicode quali + instHead ([], n, ts) = ppAppNameTypes n ts unicode qual + instHead (ctxt, n, ts) = ppContextNoLocs ctxt unicode qual + <+> ppAppNameTypes n ts unicode qual lookupAnySubdoc :: (Eq name1) => @@ -424,12 +424,12 @@ lookupAnySubdoc n subdocs = case lookup n subdocs of -- TODO: print contexts ppShortDataDecl :: Bool -> LinksInfo -> SrcSpan -> TyClDecl DocName -> Bool -> Qualification -> Html -ppShortDataDecl summary _links _loc dataDecl unicode quali +ppShortDataDecl summary _links _loc dataDecl unicode qual | [] <- cons = dataHeader | [lcon] <- cons, ResTyH98 <- resTy, - (cHead,cBody,cFoot) <- ppShortConstrParts summary (unLoc lcon) unicode quali + (cHead,cBody,cFoot) <- ppShortConstrParts summary (unLoc lcon) unicode qual = (dataHeader <+> equals <+> cHead) +++ cBody +++ cFoot | ResTyH98 <- resTy = dataHeader @@ -439,9 +439,9 @@ ppShortDataDecl summary _links _loc dataDecl unicode quali +++ shortSubDecls (map doGADTConstr cons) where - dataHeader = ppDataHeader summary dataDecl unicode quali - doConstr c con = toHtml [c] <+> ppShortConstr summary (unLoc con) unicode quali - doGADTConstr con = ppShortConstr summary (unLoc con) unicode quali + dataHeader = ppDataHeader summary dataDecl unicode qual + doConstr c con = toHtml [c] <+> ppShortConstr summary (unLoc con) unicode qual + doGADTConstr con = ppShortConstr summary (unLoc con) unicode qual cons = tcdCons dataDecl resTy = (con_res . unLoc . head) cons @@ -451,17 +451,17 @@ ppDataDecl :: Bool -> LinksInfo -> [DocInstance DocName] -> [(DocName, DocForDecl DocName)] -> SrcSpan -> Maybe (Doc DocName) -> TyClDecl DocName -> Bool -> Qualification -> Html -ppDataDecl summary links instances subdocs loc mbDoc dataDecl unicode quali +ppDataDecl summary links instances subdocs loc mbDoc dataDecl unicode qual - | summary = ppShortDataDecl summary links loc dataDecl unicode quali - | otherwise = header_ +++ maybeDocSection quali mbDoc +++ constrBit +++ instancesBit + | summary = ppShortDataDecl summary links loc dataDecl unicode qual + | otherwise = header_ +++ maybeDocSection qual mbDoc +++ constrBit +++ instancesBit where docname = unLoc . tcdLName $ dataDecl cons = tcdCons dataDecl resTy = (con_res . unLoc . head) cons - header_ = topDeclElem links loc docname (ppDataHeader summary dataDecl unicode quali + header_ = topDeclElem links loc docname (ppDataHeader summary dataDecl unicode qual <+> whereBit) whereBit @@ -470,34 +470,34 @@ ppDataDecl summary links instances subdocs loc mbDoc dataDecl unicode quali ResTyGADT _ -> keyword "where" _ -> noHtml - constrBit = subConstructors quali - (map (ppSideBySideConstr subdocs unicode quali) cons) + constrBit = subConstructors qual + (map (ppSideBySideConstr subdocs unicode qual) cons) - instancesBit = ppInstances instances docname unicode quali + instancesBit = ppInstances instances docname unicode qual ppShortConstr :: Bool -> ConDecl DocName -> Bool -> Qualification -> Html -ppShortConstr summary con unicode quali = cHead <+> cBody <+> cFoot +ppShortConstr summary con unicode qual = cHead <+> cBody <+> cFoot where - (cHead,cBody,cFoot) = ppShortConstrParts summary con unicode quali + (cHead,cBody,cFoot) = ppShortConstrParts summary con unicode qual -- returns three pieces: header, body, footer so that header & footer can be -- incorporated into the declaration ppShortConstrParts :: Bool -> ConDecl DocName -> Bool -> Qualification -> (Html, Html, Html) -ppShortConstrParts summary con unicode quali = case con_res con of +ppShortConstrParts summary con unicode qual = case con_res con of ResTyH98 -> case con_details con of PrefixCon args -> - (header_ unicode quali +++ hsep (ppBinder summary occ - : map (ppLParendType unicode quali) args), noHtml, noHtml) + (header_ unicode qual +++ hsep (ppBinder summary occ + : map (ppLParendType unicode qual) args), noHtml, noHtml) RecCon fields -> - (header_ unicode quali +++ ppBinder summary occ <+> char '{', + (header_ unicode qual +++ ppBinder summary occ <+> char '{', doRecordFields fields, char '}') InfixCon arg1 arg2 -> - (header_ unicode quali +++ hsep [ppLParendType unicode quali arg1, - ppBinder summary occ, ppLParendType unicode quali arg2], + (header_ unicode qual +++ hsep [ppLParendType unicode qual arg1, + ppBinder summary occ, ppLParendType unicode qual arg2], noHtml, noHtml) ResTyGADT resTy -> case con_details con of @@ -509,16 +509,16 @@ ppShortConstrParts summary con unicode quali = case con_res con of -- (except each field gets its own line in docs, to match -- non-GADT records) RecCon fields -> (ppBinder summary occ <+> dcolon unicode <+> - ppForAll forall ltvs lcontext unicode quali <+> char '{', + ppForAll forall ltvs lcontext unicode qual <+> char '{', doRecordFields fields, - char '}' <+> arrow unicode <+> ppLType unicode quali resTy) + char '}' <+> arrow unicode <+> ppLType unicode qual resTy) InfixCon arg1 arg2 -> (doGADTCon [arg1, arg2] resTy, noHtml, noHtml) where - doRecordFields fields = shortSubDecls (map (ppShortField summary unicode quali) fields) + doRecordFields fields = shortSubDecls (map (ppShortField summary unicode qual) fields) doGADTCon args resTy = ppBinder summary occ <+> dcolon unicode <+> hsep [ - ppForAll forall ltvs lcontext unicode quali, - ppLType unicode quali (foldr mkFunTy resTy args) ] + ppForAll forall ltvs lcontext unicode qual, + ppLType unicode qual (foldr mkFunTy resTy args) ] header_ = ppConstrHdr forall tyVars context occ = docNameOcc . unLoc . con_name $ con @@ -538,10 +538,10 @@ ppConstrHdr :: HsExplicitForAll -> [Name] -> HsContext DocName -> Bool ppConstrHdr :: HsExplicitFlag -> [Name] -> HsContext DocName -> Bool -> Qualification -> Html #endif -ppConstrHdr forall tvs ctxt unicode quali +ppConstrHdr forall tvs ctxt unicode qual = (if null tvs then noHtml else ppForall) +++ - (if null ctxt then noHtml else ppContextNoArrow ctxt unicode quali + (if null ctxt then noHtml else ppContextNoArrow ctxt unicode qual <+> darrow unicode +++ toHtml " ") where ppForall = case forall of @@ -551,20 +551,20 @@ ppConstrHdr forall tvs ctxt unicode quali ppSideBySideConstr :: [(DocName, DocForDecl DocName)] -> Bool -> Qualification -> LConDecl DocName -> SubDecl -ppSideBySideConstr subdocs unicode quali (L _ con) = (decl, mbDoc, fieldPart) +ppSideBySideConstr subdocs unicode qual (L _ con) = (decl, mbDoc, fieldPart) where decl = case con_res con of ResTyH98 -> case con_details con of PrefixCon args -> - hsep ((header_ unicode quali +++ ppBinder False occ) - : map (ppLParendType unicode quali) args) + hsep ((header_ unicode qual +++ ppBinder False occ) + : map (ppLParendType unicode qual) args) - RecCon _ -> header_ unicode quali +++ ppBinder False occ + RecCon _ -> header_ unicode qual +++ ppBinder False occ InfixCon arg1 arg2 -> - hsep [header_ unicode quali +++ ppLParendType unicode quali arg1, + hsep [header_ unicode qual +++ ppLParendType unicode qual arg1, ppBinder False occ, - ppLParendType unicode quali arg2] + ppLParendType unicode qual arg2] ResTyGADT resTy -> case con_details con of -- prefix & infix could also use hsConDeclArgTys if it seemed to @@ -577,13 +577,13 @@ ppSideBySideConstr subdocs unicode quali (L _ con) = (decl, mbDoc, fieldPart) RecCon fields -> [doRecordFields fields] _ -> [] - doRecordFields fields = subFields quali - (map (ppSideBySideField subdocs unicode quali) fields) + doRecordFields fields = subFields qual + (map (ppSideBySideField subdocs unicode qual) fields) doGADTCon :: [LHsType DocName] -> Located (HsType DocName) -> Html doGADTCon args resTy = ppBinder False occ <+> dcolon unicode - <+> hsep [ppForAll forall ltvs (con_cxt con) unicode quali, - ppLType unicode quali (foldr mkFunTy resTy args) ] + <+> hsep [ppForAll forall ltvs (con_cxt con) unicode qual, + ppLType unicode qual (foldr mkFunTy resTy args) ] header_ = ppConstrHdr forall tyVars context occ = docNameOcc . unLoc . con_name $ con @@ -600,8 +600,8 @@ ppSideBySideConstr subdocs unicode quali (L _ con) = (decl, mbDoc, fieldPart) ppSideBySideField :: [(DocName, DocForDecl DocName)] -> Bool -> Qualification -> ConDeclField DocName -> SubDecl -ppSideBySideField subdocs unicode quali (ConDeclField (L _ name) ltype _) = - (ppBinder False (docNameOcc name) <+> dcolon unicode <+> ppLType unicode quali ltype, +ppSideBySideField subdocs unicode qual (ConDeclField (L _ name) ltype _) = + (ppBinder False (docNameOcc name) <+> dcolon unicode <+> ppLType unicode qual ltype, mbDoc, []) where @@ -610,21 +610,21 @@ ppSideBySideField subdocs unicode quali (ConDeclField (L _ name) ltype _) = ppShortField :: Bool -> Bool -> Qualification -> ConDeclField DocName -> Html -ppShortField summary unicode quali (ConDeclField (L _ name) ltype _) +ppShortField summary unicode qual (ConDeclField (L _ name) ltype _) = ppBinder summary (docNameOcc name) - <+> dcolon unicode <+> ppLType unicode quali ltype + <+> dcolon unicode <+> ppLType unicode qual ltype -- | Print the LHS of a data\/newtype declaration. -- Currently doesn't handle 'data instance' decls or kind signatures ppDataHeader :: Bool -> TyClDecl DocName -> Bool -> Qualification -> Html -ppDataHeader summary decl unicode quali +ppDataHeader summary decl unicode qual | not (isDataDecl decl) = error "ppDataHeader: illegal argument" | otherwise = -- newtype or data (if tcdND decl == NewType then keyword "newtype" else keyword "data") <+> -- context - ppLContext (tcdCtxt decl) unicode quali <+> + ppLContext (tcdCtxt decl) unicode qual <+> -- T a b c ..., or a :+: b ppTyClBinderWithVars summary decl @@ -673,15 +673,15 @@ maybeParen ctxt_prec op_prec p | ctxt_prec >= op_prec = parens p ppLType, ppLParendType, ppLFunLhType :: Bool -> Qualification -> Located (HsType DocName) -> Html -ppLType unicode quali y = ppType unicode quali (unLoc y) -ppLParendType unicode quali y = ppParendType unicode quali (unLoc y) -ppLFunLhType unicode quali y = ppFunLhType unicode quali (unLoc y) +ppLType unicode qual y = ppType unicode qual (unLoc y) +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 unicode quali ty = ppr_mono_ty pREC_TOP ty unicode quali -ppParendType unicode quali ty = ppr_mono_ty pREC_CON ty unicode quali -ppFunLhType unicode quali ty = ppr_mono_ty pREC_FUN ty unicode quali +ppType unicode qual ty = ppr_mono_ty pREC_TOP 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 -- Drop top-level for-all type variables in user style @@ -693,9 +693,9 @@ ppForAll :: HsExplicitForAll -> [Located (HsTyVarBndr DocName)] ppForAll :: HsExplicitFlag -> [Located (HsTyVarBndr DocName)] #endif -> Located (HsContext DocName) -> Bool -> Qualification -> Html -ppForAll expl tvs cxt unicode quali - | show_forall = forall_part <+> ppLContext cxt unicode quali - | otherwise = ppLContext cxt unicode quali +ppForAll expl tvs cxt unicode qual + | show_forall = forall_part <+> ppLContext cxt unicode qual + | otherwise = ppLContext cxt unicode qual where show_forall = not (null tvs) && is_explicit is_explicit = case expl of {Explicit -> True; Implicit -> False} @@ -703,13 +703,13 @@ ppForAll expl tvs cxt unicode quali ppr_mono_lty :: Int -> LHsType DocName -> Bool -> Qualification -> Html -ppr_mono_lty ctxt_prec ty unicode quali = ppr_mono_ty ctxt_prec (unLoc ty) unicode quali +ppr_mono_lty ctxt_prec ty unicode qual = ppr_mono_ty ctxt_prec (unLoc ty) unicode qual ppr_mono_ty :: Int -> HsType DocName -> Bool -> Qualification -> Html -ppr_mono_ty ctxt_prec (HsForAllTy expl tvs ctxt ty) unicode quali +ppr_mono_ty ctxt_prec (HsForAllTy expl tvs ctxt ty) unicode qual = maybeParen ctxt_prec pREC_FUN $ - hsep [ppForAll expl tvs ctxt unicode quali, ppr_mono_lty pREC_TOP ty unicode quali] + hsep [ppForAll expl tvs ctxt unicode qual, ppr_mono_lty pREC_TOP ty unicode qual] ppr_mono_ty _ (HsBangTy b ty) u q = ppBang b +++ ppLParendType u q ty ppr_mono_ty _ (HsTyVar name) _ q = ppDocName q name @@ -729,29 +729,29 @@ ppr_mono_ty _ (HsQuasiQuoteTy {}) _ _ = error "ppr_mono_ty HsQuasiQuoteT #endif ppr_mono_ty _ (HsRecTy {}) _ _ = error "ppr_mono_ty HsRecTy" -ppr_mono_ty ctxt_prec (HsAppTy fun_ty arg_ty) unicode quali +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 quali, ppr_mono_lty pREC_CON arg_ty unicode quali] + hsep [ppr_mono_lty pREC_FUN fun_ty unicode qual, ppr_mono_lty pREC_CON arg_ty unicode qual] -ppr_mono_ty ctxt_prec (HsOpTy ty1 op ty2) unicode quali +ppr_mono_ty ctxt_prec (HsOpTy ty1 op ty2) unicode qual = maybeParen ctxt_prec pREC_FUN $ - ppr_mono_lty pREC_OP ty1 unicode quali <+> ppr_op <+> ppr_mono_lty pREC_OP ty2 unicode quali + ppr_mono_lty pREC_OP ty1 unicode qual <+> ppr_op <+> ppr_mono_lty pREC_OP ty2 unicode qual where - ppr_op = if not (isSymOcc occName) then quote (ppLDocName quali op) else ppLDocName quali op + ppr_op = if not (isSymOcc occName) then quote (ppLDocName qual op) else ppLDocName qual op occName = docNameOcc . unLoc $ op -ppr_mono_ty ctxt_prec (HsParTy ty) unicode quali +ppr_mono_ty ctxt_prec (HsParTy ty) unicode qual -- = parens (ppr_mono_lty pREC_TOP ty) - = ppr_mono_lty ctxt_prec ty unicode quali + = ppr_mono_lty ctxt_prec ty unicode qual -ppr_mono_ty ctxt_prec (HsDocTy ty _) unicode quali - = ppr_mono_lty ctxt_prec ty unicode quali +ppr_mono_ty ctxt_prec (HsDocTy ty _) unicode qual + = ppr_mono_lty ctxt_prec ty unicode qual ppr_fun_ty :: Int -> LHsType DocName -> LHsType DocName -> Bool -> Qualification -> Html -ppr_fun_ty ctxt_prec ty1 ty2 unicode quali - = let p1 = ppr_mono_lty pREC_FUN ty1 unicode quali - p2 = ppr_mono_lty pREC_TOP ty2 unicode quali +ppr_fun_ty ctxt_prec ty1 ty2 unicode qual + = let p1 = ppr_mono_lty pREC_FUN ty1 unicode qual + p2 = ppr_mono_lty pREC_TOP ty2 unicode qual in maybeParen ctxt_prec pREC_FUN $ hsep [p1, arrow unicode <+> p2] diff --git a/src/Haddock/Backends/Xhtml/DocMarkup.hs b/src/Haddock/Backends/Xhtml/DocMarkup.hs index fb03b123..1e43891d 100644 --- a/src/Haddock/Backends/Xhtml/DocMarkup.hs +++ b/src/Haddock/Backends/Xhtml/DocMarkup.hs @@ -76,8 +76,8 @@ parHtmlMarkup ppId isTyCon = Markup { -- If the doc is a single paragraph, don't surround it with <P> (this causes -- ugly extra whitespace with some browsers). FIXME: Does this still apply? docToHtml :: Qualification -> Doc DocName -> Html -docToHtml quali = markup fmt . cleanup - where fmt = parHtmlMarkup (ppDocName quali) (isTyConName . getName) +docToHtml qual = markup fmt . cleanup + where fmt = parHtmlMarkup (ppDocName qual) (isTyConName . getName) origDocToHtml :: Doc Name -> Html @@ -98,11 +98,11 @@ docElement el content_ = docSection :: Qualification -> Doc DocName -> Html -docSection quali = (docElement thediv <<) . (docToHtml quali) +docSection qual = (docElement thediv <<) . (docToHtml qual) maybeDocSection :: Qualification -> Maybe (Doc DocName) -> Html -maybeDocSection quali = maybe noHtml (docSection quali) +maybeDocSection qual = maybe noHtml (docSection qual) cleanup :: Doc a -> Doc a diff --git a/src/Haddock/Backends/Xhtml/Layout.hs b/src/Haddock/Backends/Xhtml/Layout.hs index 9ccdd699..a6518938 100644 --- a/src/Haddock/Backends/Xhtml/Layout.hs +++ b/src/Haddock/Backends/Xhtml/Layout.hs @@ -114,24 +114,24 @@ divSubDecls cssClass captionName = maybe noHtml wrap subDlist :: Qualification -> [SubDecl] -> Maybe Html subDlist _ [] = Nothing -subDlist quali decls = Just $ dlist << map subEntry decls +++ clearDiv +subDlist qual decls = Just $ dlist << map subEntry decls +++ clearDiv where subEntry (decl, mdoc, subs) = dterm ! [theclass "src"] << decl +++ - docElement ddef << (fmap (docToHtml quali) mdoc +++ subs) + docElement ddef << (fmap (docToHtml qual) mdoc +++ subs) clearDiv = thediv ! [ theclass "clear" ] << noHtml subTable :: Qualification -> [SubDecl] -> Maybe Html subTable _ [] = Nothing -subTable quali decls = Just $ table << aboves (concatMap subRow decls) +subTable qual decls = Just $ table << aboves (concatMap subRow decls) where subRow (decl, mdoc, subs) = (td ! [theclass "src"] << decl <-> - docElement td << fmap (docToHtml quali) mdoc) + docElement td << fmap (docToHtml qual) mdoc) : map (cell . (td <<)) subs @@ -141,7 +141,7 @@ subBlock hs = Just $ toHtml hs subArguments :: Qualification -> [SubDecl] -> Html -subArguments quali = divSubDecls "arguments" "Arguments" . (subTable quali) +subArguments qual = divSubDecls "arguments" "Arguments" . (subTable qual) subAssociatedTypes :: [Html] -> Html @@ -149,18 +149,18 @@ subAssociatedTypes = divSubDecls "associated-types" "Associated Types" . subBloc subConstructors :: Qualification -> [SubDecl] -> Html -subConstructors quali = divSubDecls "constructors" "Constructors" . (subTable quali) +subConstructors qual = divSubDecls "constructors" "Constructors" . (subTable qual) subFields :: Qualification -> [SubDecl] -> Html -subFields quali = divSubDecls "fields" "Fields" . (subDlist quali) +subFields qual = divSubDecls "fields" "Fields" . (subDlist qual) subInstances :: Qualification -> String -> [SubDecl] -> Html -subInstances quali nm = maybe noHtml wrap . instTable +subInstances qual nm = maybe noHtml wrap . instTable where wrap = (subSection <<) . (subCaption +++) - instTable = fmap (thediv ! collapseSection id_ True [] <<) . (subTable quali) + instTable = fmap (thediv ! collapseSection id_ True [] <<) . (subTable qual) subSection = thediv ! [theclass $ "subs instances"] subCaption = paragraph ! collapseControl id_ True "caption" << "Instances" id_ = makeAnchorId $ "i:" ++ nm diff --git a/src/Haddock/Backends/Xhtml/Names.hs b/src/Haddock/Backends/Xhtml/Names.hs index 016aac14..d1423fc7 100644 --- a/src/Haddock/Backends/Xhtml/Names.hs +++ b/src/Haddock/Backends/Xhtml/Names.hs @@ -40,38 +40,38 @@ ppRdrName = ppOccName . rdrNameOcc ppLDocName :: Qualification -> Located DocName -> Html -ppLDocName quali (L _ d) = ppDocName quali d +ppLDocName qual (L _ d) = ppDocName qual d -- | Render a name depending on the selected qualification mode qualifyName :: Qualification -> DocName -> Html -qualifyName quali docName@(Documented name mdl) = case quali of - NoQuali -> ppName name - FullQuali -> ppFullQualName mdl name +qualifyName qual docName@(Documented name mdl) = case qual of + NoQual -> ppName name + FullQual -> ppFullQualName mdl name -- this is just in case, it should never happen - LocalQuali Nothing -> qualifyName FullQuali docName - LocalQuali (Just localmdl) -> + LocalQual Nothing -> qualifyName FullQual docName + LocalQual (Just localmdl) -> if (moduleString mdl == moduleString localmdl) then ppName name else ppFullQualName mdl name -- again, this never happens - RelativeQuali Nothing -> qualifyName FullQuali docName - RelativeQuali (Just localmdl) -> + RelativeQual Nothing -> qualifyName FullQual docName + RelativeQual (Just localmdl) -> case List.stripPrefix (moduleString localmdl) (moduleString mdl) of -- local, A.x -> x - Just [] -> qualifyName NoQuali docName + Just [] -> qualifyName NoQual docName -- sub-module, A.B.x -> B.x Just ('.':m) -> toHtml $ m ++ '.' : getOccString name -- some module with same prefix, ABC.x -> ABC.x - Just _ -> qualifyName FullQuali docName + Just _ -> qualifyName FullQual docName -- some other module, D.x -> D.x - Nothing -> qualifyName FullQuali docName + Nothing -> qualifyName FullQual docName -- this is just for exhaustiveness, but already handled by ppDocName qualifyName _ (Undocumented name) = ppName name ppDocName :: Qualification -> DocName -> Html -ppDocName quali docName@(Documented name mdl) = - linkIdOcc mdl (Just occName) << qualifyName quali docName +ppDocName qual docName@(Documented name mdl) = + linkIdOcc mdl (Just occName) << qualifyName qual docName where occName = nameOccName name ppDocName _ (Undocumented name) = ppName name |