diff options
| author | Łukasz Hanuszczak <lukasz.hanuszczak@gmail.com> | 2015-06-17 21:49:46 +0200 |
|---|---|---|
| committer | Łukasz Hanuszczak <lukasz.hanuszczak@gmail.com> | 2015-06-30 22:37:49 +0200 |
| commit | 60db14903e01f4c26f179230c7b6190a7b99fb51 (patch) | |
| tree | bb27453e8cfe94d2be462b013f7bcf07e91fd16d /haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs | |
| parent | 1064953c6590c05303c6cbd2230b9e13d3ba1376 (diff) | |
Refactor the way AST names are handled within detailed tokens.
Diffstat (limited to 'haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs')
| -rw-r--r-- | haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs | 17 |
1 files changed, 10 insertions, 7 deletions
diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs index 99a0f337..e08d8974 100644 --- a/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs +++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs @@ -41,14 +41,14 @@ richToken (RichToken tok (Just det)) = externalAnchor det . internalAnchor det . hyperlink det $ content where content = tokenSpan tok ! [ multiclass style] - style = (tokenStyle . tkType) tok ++ (richTokenStyle . rtkType) det + style = (tokenStyle . tkType) tok ++ richTokenStyle det tokenSpan :: Token -> Html tokenSpan = Html.thespan . Html.toHtml . tkValue -richTokenStyle :: RichTokenType -> [StyleClass] -richTokenStyle RtkVar = ["hs-var"] -richTokenStyle RtkType = ["hs-type"] +richTokenStyle :: TokenDetails -> [StyleClass] +richTokenStyle (RtkVar _) = ["hs-var"] +richTokenStyle (RtkType _) = ["hs-type"] richTokenStyle _ = [] tokenStyle :: TokenType -> [StyleClass] @@ -70,12 +70,12 @@ multiclass :: [StyleClass] -> HtmlAttr multiclass = Html.theclass . intercalate " " externalAnchor :: TokenDetails -> Html -> Html -externalAnchor (TokenDetails RtkDecl name) content = +externalAnchor (RtkDecl name) content = Html.anchor content ! [ Html.name $ externalAnchorIdent name ] externalAnchor _ content = content internalAnchor :: TokenDetails -> Html -> Html -internalAnchor (TokenDetails RtkBind name) content = +internalAnchor (RtkBind name) content = Html.anchor content ! [ Html.name $ internalAnchorIdent name ] internalAnchor _ content = content @@ -86,9 +86,12 @@ internalAnchorIdent :: GHC.Name -> String internalAnchorIdent = ("local-" ++) . show . GHC.getKey . GHC.nameUnique hyperlink :: TokenDetails -> Html -> Html -hyperlink (TokenDetails _ name) = if GHC.isInternalName name +hyperlink details = + if GHC.isInternalName $ name then internalHyperlink name else externalHyperlink name + where + name = rtkName details internalHyperlink :: GHC.Name -> Html -> Html internalHyperlink name content = |