diff options
Diffstat (limited to 'src/Haddock/Backends/Xhtml')
| -rw-r--r-- | src/Haddock/Backends/Xhtml/DocMarkup.hs | 53 | ||||
| -rw-r--r-- | src/Haddock/Backends/Xhtml/Names.hs | 14 |
2 files changed, 40 insertions, 27 deletions
diff --git a/src/Haddock/Backends/Xhtml/DocMarkup.hs b/src/Haddock/Backends/Xhtml/DocMarkup.hs index 05ce7dbb..87d67b76 100644 --- a/src/Haddock/Backends/Xhtml/DocMarkup.hs +++ b/src/Haddock/Backends/Xhtml/DocMarkup.hs @@ -30,25 +30,26 @@ import Text.XHtml hiding ( name, title, p, quote ) import GHC -parHtmlMarkup :: (a -> Html) -> DocMarkup a Html -parHtmlMarkup ppId = Markup { - markupEmpty = noHtml, - markupString = toHtml, - markupParagraph = paragraph, - markupAppend = (+++), - markupIdentifier = thecode . ppId, - markupModule = \m -> let (mdl,ref) = break (=='#') m - in ppModuleRef (mkModuleNoPackage mdl) ref, - markupEmphasis = emphasize, - markupMonospaced = thecode, - markupUnorderedList = unordList, - markupOrderedList = ordList, - markupDefList = defList, - markupCodeBlock = pre, - markupURL = \url -> anchor ! [href url] << url, - markupAName = \aname -> namedAnchor aname << "", - markupPic = \path -> image ! [src path], - markupExample = examplesToHtml +parHtmlMarkup :: Qualification -> (a -> Html) -> DocMarkup a Html +parHtmlMarkup qual ppId = Markup { + markupEmpty = noHtml, + markupString = toHtml, + markupParagraph = paragraph, + markupAppend = (+++), + markupIdentifier = thecode . ppId, + markupIdentifierUnchecked = thecode . ppUncheckedLink qual, + markupModule = \m -> let (mdl,ref) = break (=='#') m + in ppModuleRef (mkModuleNoPackage mdl) ref, + markupEmphasis = emphasize, + markupMonospaced = thecode, + markupUnorderedList = unordList, + markupOrderedList = ordList, + markupDefList = defList, + markupCodeBlock = pre, + markupURL = \url -> anchor ! [href url] << url, + markupAName = \aname -> namedAnchor aname << "", + markupPic = \path -> image ! [src path], + markupExample = examplesToHtml } where examplesToHtml l = pre (concatHtml $ map exampleToHtml l) ! [theclass "screen"] @@ -64,17 +65,17 @@ parHtmlMarkup ppId = Markup { -- ugly extra whitespace with some browsers). FIXME: Does this still apply? docToHtml :: Qualification -> Doc DocName -> Html docToHtml qual = markup fmt . cleanup - where fmt = parHtmlMarkup (ppDocName qual) + where fmt = parHtmlMarkup qual (ppDocName qual) -origDocToHtml :: Doc Name -> Html -origDocToHtml = markup fmt . cleanup - where fmt = parHtmlMarkup ppName +origDocToHtml :: Qualification -> Doc Name -> Html +origDocToHtml qual = markup fmt . cleanup + where fmt = parHtmlMarkup qual ppName -rdrDocToHtml :: Doc RdrName -> Html -rdrDocToHtml = markup fmt . cleanup - where fmt = parHtmlMarkup ppRdrName +rdrDocToHtml :: Qualification -> Doc RdrName -> Html +rdrDocToHtml qual = markup fmt . cleanup + where fmt = parHtmlMarkup qual ppRdrName docElement :: (Html -> Html) -> Html -> Html diff --git a/src/Haddock/Backends/Xhtml/Names.hs b/src/Haddock/Backends/Xhtml/Names.hs index c5166d7f..19efea2e 100644 --- a/src/Haddock/Backends/Xhtml/Names.hs +++ b/src/Haddock/Backends/Xhtml/Names.hs @@ -11,7 +11,7 @@ -- Portability : portable ----------------------------------------------------------------------------- module Haddock.Backends.Xhtml.Names ( - ppName, ppDocName, ppLDocName, ppRdrName, + ppName, ppDocName, ppLDocName, ppRdrName, ppUncheckedLink, ppBinder, ppBinder', ppModule, ppModuleRef, linkId @@ -39,6 +39,10 @@ ppRdrName :: RdrName -> Html ppRdrName = ppOccName . rdrNameOcc +ppUncheckedLink :: Qualification -> (ModuleName, OccName) -> Html +ppUncheckedLink _ (mdl, occ) = linkIdOcc' mdl (Just occ) << ppOccName occ -- TODO: apply ppQualifyName + + ppLDocName :: Qualification -> Located DocName -> Html ppLDocName qual (L _ d) = ppDocName qual d @@ -110,6 +114,14 @@ linkIdOcc mdl mbName = anchor ! [href url] Just name -> moduleNameUrl mdl name +linkIdOcc' :: ModuleName -> Maybe OccName -> Html -> Html +linkIdOcc' mdl mbName = anchor ! [href url] + where + url = case mbName of + Nothing -> moduleHtmlFile' mdl + Just name -> moduleNameUrl' mdl name + + ppModule :: Module -> Html ppModule mdl = anchor ! [href (moduleUrl mdl)] << toHtml (moduleString mdl) |