diff options
author | Łukasz Hanuszczak <lukasz.hanuszczak@gmail.com> | 2015-06-12 01:03:13 +0200 |
---|---|---|
committer | Łukasz Hanuszczak <lukasz.hanuszczak@gmail.com> | 2015-06-30 22:37:49 +0200 |
commit | 162b02ed6f50709ea203bf7706eee5804e455419 (patch) | |
tree | 81e703c37d31d2c254e51bae889cae7ca9fcc76d /haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs | |
parent | b31513dbacb48102b4c5d2fd6de1982161d81fae (diff) |
Add support for type declaration anchors.
Diffstat (limited to 'haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs')
-rw-r--r-- | haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs | 14 |
1 files changed, 11 insertions, 3 deletions
diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs index 995e24e6..b7cc5aeb 100644 --- a/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs +++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs @@ -38,7 +38,7 @@ richToken (RichToken tok Nothing) = where attrs = [ multiclass . tokenStyle . tkType $ tok ] richToken (RichToken tok (Just det)) = - internalAnchor det . hyperlink det $ content + externalAnchor det . internalAnchor det . hyperlink det $ content where content = tokenSpan tok ! [ multiclass style] style = (tokenStyle . tkType) tok ++ (richTokenStyle . rtkType) det @@ -49,7 +49,7 @@ tokenSpan = Html.thespan . Html.toHtml . tkValue richTokenStyle :: RichTokenType -> [StyleClass] richTokenStyle RtkVar = ["hs-var"] richTokenStyle RtkType = ["hs-type"] -richTokenStyle RtkBind = [] +richTokenStyle _ = [] tokenStyle :: TokenType -> [StyleClass] tokenStyle TkIdentifier = ["hs-identifier"] @@ -69,11 +69,19 @@ tokenStyle TkUnknown = [] multiclass :: [StyleClass] -> HtmlAttr multiclass = Html.theclass . intercalate " " +externalAnchor :: TokenDetails -> Html -> Html +externalAnchor (TokenDetails RtkDecl name) content = + Html.anchor content ! [ Html.name $ externalAnchorIdent name ] +externalAnchor _ content = content + internalAnchor :: TokenDetails -> Html -> Html internalAnchor (TokenDetails RtkBind name) content = Html.anchor content ! [ Html.name $ internalAnchorIdent name ] internalAnchor _ content = content +externalAnchorIdent :: GHC.Name -> String +externalAnchorIdent = GHC.occNameString . GHC.nameOccName + internalAnchorIdent :: GHC.Name -> String internalAnchorIdent = ("local-" ++) . show . GHC.getKey . GHC.nameUnique @@ -91,4 +99,4 @@ externalHyperlink name content = Html.anchor content ! [ Html.href $ maybe "" id mmod ++ "#" ++ ident ] where mmod = GHC.moduleNameString . GHC.moduleName <$> GHC.nameModule_maybe name - ident = GHC.occNameString . GHC.nameOccName $ name + ident = externalAnchorIdent name |