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. --- haddock-api/src/Haddock/Backends/Hyperlinker.hs | 10 ++++++++-- .../src/Haddock/Backends/Hyperlinker/Renderer.hs | 23 ++++++++++++++-------- 2 files changed, 23 insertions(+), 10 deletions(-) (limited to 'haddock-api/src') diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker.hs b/haddock-api/src/Haddock/Backends/Hyperlinker.hs index 66392a67..9337307c 100644 --- a/haddock-api/src/Haddock/Backends/Hyperlinker.hs +++ b/haddock-api/src/Haddock/Backends/Hyperlinker.hs @@ -16,14 +16,17 @@ ppHyperlinkedSource outdir libdir mstyle ifaces = do createDirectoryIfMissing True $ srcPath outdir let cssFile = fromMaybe (defaultCssFile libdir) mstyle copyFile cssFile $ srcPath outdir srcCssFile + copyFile (libdir "html" highlightScript) $ + srcPath outdir highlightScript mapM_ (ppHyperlinkedModuleSource outdir) ifaces ppHyperlinkedModuleSource :: FilePath -> Interface -> IO () ppHyperlinkedModuleSource outdir iface = case ifaceTokenizedSrc iface of - Just tokens -> writeFile path $ showHtml . render mSrcCssFile $ tokens + Just tokens -> writeFile path $ showHtml . render mCssFile mJsFile $ tokens Nothing -> return () where - mSrcCssFile = Just $ srcCssFile + mCssFile = Just $ srcCssFile + mJsFile = Just $ highlightScript path = srcPath outdir moduleSourceFile (ifaceMod iface) moduleSourceFile :: Module -> FilePath @@ -35,5 +38,8 @@ srcPath outdir = outdir "src" srcCssFile :: FilePath srcCssFile = "style.css" +highlightScript :: FilePath +highlightScript = "highlight.js" + defaultCssFile :: FilePath -> FilePath defaultCssFile libdir = libdir "html" "solarized.css" 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