From a6bd86a8550d5d7e8bdb12e1d09036b9f88eed73 Mon Sep 17 00:00:00 2001 From: Ɓukasz Hanuszczak Date: Mon, 22 Jun 2015 17:41:31 +0200 Subject: Add support for fancy highlighting upon hovering over identifier. --- .../src/Haddock/Backends/Hyperlinker/Renderer.hs | 23 ++++++++++++++-------- 1 file changed, 15 insertions(+), 8 deletions(-) (limited to 'haddock-api/src/Haddock/Backends/Hyperlinker') diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs index 70524759..6d6d2012 100644 --- a/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs +++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs @@ -16,21 +16,28 @@ import qualified Text.XHtml as Html type StyleClass = String -render :: Maybe FilePath -> [RichToken] -> Html -render css tokens = header css <> body tokens +render :: Maybe FilePath -> Maybe FilePath -> [RichToken] -> Html +render mcss mjs tokens = header mcss mjs <> body tokens body :: [RichToken] -> Html body = Html.body . Html.pre . mconcat . map richToken -header :: Maybe FilePath -> Html -header Nothing = Html.noHtml -header (Just css) = - Html.header $ Html.thelink Html.noHtml ! attrs +header :: Maybe FilePath -> Maybe FilePath -> Html +header mcss mjs + | isNothing mcss && isNothing mjs = Html.noHtml +header mcss mjs = + Html.header $ css mcss <> js mjs where - attrs = + css Nothing = Html.noHtml + css (Just cssFile) = Html.thelink Html.noHtml ! [ Html.rel "stylesheet" - , Html.href css , Html.thetype "text/css" + , Html.href cssFile + ] + js Nothing = Html.noHtml + js (Just jsFile) = Html.script Html.noHtml ! + [ Html.thetype "text/javascript" + , Html.src jsFile ] richToken :: RichToken -> Html -- cgit v1.2.3