aboutsummaryrefslogtreecommitdiff
path: root/haddock-api/src/Haddock/Backends
diff options
context:
space:
mode:
Diffstat (limited to 'haddock-api/src/Haddock/Backends')
-rw-r--r--haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs23
1 files changed, 20 insertions, 3 deletions
diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs
index 39d7d183..32d2c863 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs
@@ -1,16 +1,20 @@
module Haddock.Backends.Hyperlinker.Renderer where
import Haddock.Backends.Hyperlinker.Parser
+import Haddock.Backends.Hyperlinker.Ast
+
+import qualified GHC
+import qualified Name as GHC
import Data.Monoid
import Text.XHtml (Html, HtmlAttr, (!))
import qualified Text.XHtml as Html
-render :: Maybe FilePath -> [Token] -> Html
+render :: Maybe FilePath -> [RichToken] -> Html
render css tokens = header css <> body tokens
-body :: [Token] -> Html
-body = Html.body . Html.pre . mconcat . map token
+body :: [RichToken] -> Html
+body = Html.body . Html.pre . mconcat . map richToken
header :: Maybe FilePath -> Html
header Nothing = Html.noHtml
@@ -23,6 +27,10 @@ header (Just css) =
, Html.thetype "text/css"
]
+richToken :: RichToken -> Html
+richToken (RichToken t Nothing) = token t
+richToken (RichToken t (Just name)) = Html.anchor (token t) ! nameAttrs name
+
token :: Token -> Html
token (Token t v _) = Html.thespan (Html.toHtml v) ! tokenAttrs t
@@ -40,3 +48,12 @@ tokenAttrs TkComment = [Html.theclass "hs-comment"]
tokenAttrs TkCpp = [Html.theclass "hs-cpp"]
tokenAttrs TkPragma = [Html.theclass "hs-pragma"]
tokenAttrs TkUnknown = []
+
+nameAttrs :: GHC.Name -> [HtmlAttr]
+nameAttrs name =
+ [ Html.href (maybe "" id mmod ++ "#" ++ ident)
+ , Html.theclass "varid-reference"
+ ]
+ where
+ mmod = GHC.moduleNameString . GHC.moduleName <$> GHC.nameModule_maybe name
+ ident = GHC.occNameString . GHC.nameOccName $ name