From 279a662adc83dba2e24bd0b99f7da9d63455f840 Mon Sep 17 00:00:00 2001 From: jpmoresmau Date: Tue, 20 Jan 2015 18:27:16 +0100 Subject: Links to source location of class instance definitions --- haddock-api/resources/html/Ocean.std-theme/ocean.css | 9 +++++++++ 1 file changed, 9 insertions(+) (limited to 'haddock-api/resources/html') diff --git a/haddock-api/resources/html/Ocean.std-theme/ocean.css b/haddock-api/resources/html/Ocean.std-theme/ocean.css index de436324..f762e832 100644 --- a/haddock-api/resources/html/Ocean.std-theme/ocean.css +++ b/haddock-api/resources/html/Ocean.std-theme/ocean.css @@ -378,6 +378,15 @@ div#style-menu-holder { margin: 0 -0.5em 0 0.5em; } +#interface td.src .link { + float: right; + color: #919191; + border-left: 1px solid #919191; + background: #f0f0f0; + padding: 0 0.5em 0.2em; + margin: 0 -0.5em 0 0.5em; +} + #interface span.fixity { color: #919191; border-left: 1px solid #919191; -- cgit v1.2.3 From 71170fc77962f10d7d001e3b8bc8b92bfeda99bc Mon Sep 17 00:00:00 2001 From: Phil Ruffwind Date: Mon, 16 Mar 2015 04:31:13 -0400 Subject: Prevent Synopsis from using up too much horizontal space When long type signatures occur in the Synopsis, the element is stretched beyond the width of the window. Scrollbars don't appear, so it's impossible to read anything when this happens. --- haddock-api/resources/html/Ocean.std-theme/ocean.css | 1 + 1 file changed, 1 insertion(+) (limited to 'haddock-api/resources/html') diff --git a/haddock-api/resources/html/Ocean.std-theme/ocean.css b/haddock-api/resources/html/Ocean.std-theme/ocean.css index f762e832..ef652a21 100644 --- a/haddock-api/resources/html/Ocean.std-theme/ocean.css +++ b/haddock-api/resources/html/Ocean.std-theme/ocean.css @@ -318,6 +318,7 @@ div#style-menu-holder { height: 80%; top: 10%; padding: 0; + max-width: 75%; } #synopsis .caption { -- cgit v1.2.3 From a476b251e363b3b0ed30c75cf72a19fc275d6440 Mon Sep 17 00:00:00 2001 From: Phil Ruffwind Date: Fri, 12 Jun 2015 12:59:24 -0400 Subject: Fix alignment of Source links in instance table in Firefox Due to a Firefox bug [1], a combination of 'whitespace: nowrap' on the parent element with 'float: right' on the inner element can cause the floated element to be displaced downwards for no apparent reason. To work around this, the left side is wrapped in its own and set to 'float: left'. As a precautionary measure to prevent the parent element from collapsing entirely, we also add the classic "clearfix" hack. The latter is not strictly needed but it helps prevent bugs if the layout is altered again in the future. Fixes #384. Remark: line 159 of src/Haddock/Backends/Xhtml/Layout.hs was indented to prevent confusion over the operator precedence of (<+>) vs (<<). [1]: https://bugzilla.mozilla.org/show_bug.cgi?id=488725 --- haddock-api/resources/html/Ocean.std-theme/ocean.css | 13 +++++++++++++ haddock-api/src/Haddock/Backends/Xhtml/Layout.hs | 5 +++-- 2 files changed, 16 insertions(+), 2 deletions(-) (limited to 'haddock-api/resources/html') diff --git a/haddock-api/resources/html/Ocean.std-theme/ocean.css b/haddock-api/resources/html/Ocean.std-theme/ocean.css index ef652a21..1110b407 100644 --- a/haddock-api/resources/html/Ocean.std-theme/ocean.css +++ b/haddock-api/resources/html/Ocean.std-theme/ocean.css @@ -416,6 +416,14 @@ div#style-menu-holder { margin-top: 0.8em; } +.clearfix:after { + clear: both; + content: " "; + display: block; + height: 0; + visibility: hidden; +} + .subs dl { margin: 0; } @@ -455,6 +463,11 @@ div#style-menu-holder { margin-left: 1em; } +/* Workaround for bug in Firefox (issue #384) */ +.inst-left { + float: left; +} + .top p.src { border-top: 1px solid #ccc; } diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs b/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs index e686d648..914a7a7e 100644 --- a/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs @@ -154,8 +154,9 @@ subTableSrc _ _ _ [] = Nothing subTableSrc qual lnks splice decls = Just $ table << aboves (concatMap subRow decls) where subRow ((decl, mdoc, subs),L loc dn) = - (td ! [theclass "src"] << decl - <+> linkHtml loc dn + (td ! [theclass "src clearfix"] << + (thespan ! [theclass "inst-left"] << decl) + <+> linkHtml loc dn <-> docElement td << fmap (docToHtml Nothing qual) mdoc ) -- cgit v1.2.3 From 6f16398a26a12d58b3ba7f1924e2b6b00e68f5f7 Mon Sep 17 00:00:00 2001 From: Łukasz Hanuszczak Date: Mon, 22 Jun 2015 17:20:37 +0200 Subject: Add support for providing custom CSS files for hyperlinked source. --- haddock-api/haddock-api.cabal | 1 + haddock-api/resources/html/solarized.css | 55 +++++++++++++++++++++++++ haddock-api/src/Haddock.hs | 3 +- haddock-api/src/Haddock/Backends/Hyperlinker.hs | 26 +++++++++--- haddock-api/src/Haddock/Options.hs | 6 +++ 5 files changed, 84 insertions(+), 7 deletions(-) create mode 100644 haddock-api/resources/html/solarized.css (limited to 'haddock-api/resources/html') diff --git a/haddock-api/haddock-api.cabal b/haddock-api/haddock-api.cabal index 6ffde976..14656994 100644 --- a/haddock-api/haddock-api.cabal +++ b/haddock-api/haddock-api.cabal @@ -18,6 +18,7 @@ stability: experimental data-dir: resources data-files: + html/solarized.css html/frames.html html/haddock-util.js html/Classic.theme/haskell_icon.gif diff --git a/haddock-api/resources/html/solarized.css b/haddock-api/resources/html/solarized.css new file mode 100644 index 00000000..e4bff385 --- /dev/null +++ b/haddock-api/resources/html/solarized.css @@ -0,0 +1,55 @@ +body { + background-color: #fdf6e3; +} + +.hs-identifier { + color: #073642; +} + +.hs-identifier.hs-var { +} + +.hs-identifier.hs-type { + color: #5f5faf; +} + +.hs-keyword { + color: #af005f; +} + +.hs-string, .hs-char { + color: #cb4b16; +} + +.hs-number { + color: #268bd2; +} + +.hs-operator { + color: #d33682; +} + +.hs-glyph, .hs-special { + color: #dc322f; +} + +.hs-comment { + color: #8a8a8a; +} + +.hs-pragma { + color: #2aa198; +} + +.hs-cpp { + color: #859900; +} + +a:link, a:visited { + text-decoration: none; + border-bottom: 1px solid #eee8d5; +} + +a:hover { + background-color: #eee8d5; +} diff --git a/haddock-api/src/Haddock.hs b/haddock-api/src/Haddock.hs index e45456ab..698122e3 100644 --- a/haddock-api/src/Haddock.hs +++ b/haddock-api/src/Haddock.hs @@ -244,6 +244,7 @@ render dflags flags qual ifaces installedIfaces srcMap = do opt_index_url = optIndexUrl flags odir = outputDir flags opt_latex_style = optLaTeXStyle flags + opt_source_css = optSourceCssFile flags visibleIfaces = [ i | i <- ifaces, OptHide `notElem` ifaceOptions i ] @@ -310,7 +311,7 @@ render dflags flags qual ifaces installedIfaces srcMap = do libDir when (Flag_HyperlinkedSource `elem` flags) $ do - ppHyperlinkedSource odir libDir Nothing visibleIfaces + ppHyperlinkedSource odir libDir opt_source_css visibleIfaces -- | From GHC 7.10, this function has a potential to crash with a -- nasty message such as @expectJust getPackageDetails@ because diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker.hs b/haddock-api/src/Haddock/Backends/Hyperlinker.hs index 88619474..66392a67 100644 --- a/haddock-api/src/Haddock/Backends/Hyperlinker.hs +++ b/haddock-api/src/Haddock/Backends/Hyperlinker.hs @@ -5,21 +5,35 @@ import Haddock.Backends.Hyperlinker.Renderer import GHC import Text.XHtml hiding (()) + +import Data.Maybe import System.Directory import System.FilePath ppHyperlinkedSource :: FilePath -> FilePath -> Maybe FilePath -> [Interface] -> IO () ppHyperlinkedSource outdir libdir mstyle ifaces = do - createDirectoryIfMissing True (outdir "src") - mapM_ (ppHyperlinkedModuleSource outdir mstyle) ifaces + createDirectoryIfMissing True $ srcPath outdir + let cssFile = fromMaybe (defaultCssFile libdir) mstyle + copyFile cssFile $ srcPath outdir srcCssFile + mapM_ (ppHyperlinkedModuleSource outdir) ifaces -ppHyperlinkedModuleSource :: FilePath -> Maybe FilePath -> Interface -> IO () -ppHyperlinkedModuleSource outdir mstyle iface = case ifaceTokenizedSrc iface of - Just tokens -> writeFile path $ showHtml . render mstyle $ tokens +ppHyperlinkedModuleSource :: FilePath -> Interface -> IO () +ppHyperlinkedModuleSource outdir iface = case ifaceTokenizedSrc iface of + Just tokens -> writeFile path $ showHtml . render mSrcCssFile $ tokens Nothing -> return () where - path = outdir "src" moduleSourceFile (ifaceMod iface) + mSrcCssFile = Just $ srcCssFile + path = srcPath outdir moduleSourceFile (ifaceMod iface) moduleSourceFile :: Module -> FilePath moduleSourceFile = (++ ".html") . moduleNameString . moduleName + +srcPath :: FilePath -> FilePath +srcPath outdir = outdir "src" + +srcCssFile :: FilePath +srcCssFile = "style.css" + +defaultCssFile :: FilePath -> FilePath +defaultCssFile libdir = libdir "html" "solarized.css" diff --git a/haddock-api/src/Haddock/Options.hs b/haddock-api/src/Haddock/Options.hs index c9d5688c..f84989ef 100644 --- a/haddock-api/src/Haddock/Options.hs +++ b/haddock-api/src/Haddock/Options.hs @@ -21,6 +21,7 @@ module Haddock.Options ( optContentsUrl, optIndexUrl, optCssFile, + optSourceCssFile, sourceUrls, wikiUrls, optDumpInterfaceFile, @@ -67,6 +68,7 @@ data Flag | Flag_LaTeX | Flag_LaTeXStyle String | Flag_HyperlinkedSource + | Flag_SourceCss String | Flag_Help | Flag_Verbosity String | Flag_Version @@ -119,6 +121,8 @@ options backwardsCompat = "output for Hoogle; you may want --package-name and --package-version too", Option [] ["hyperlinked-source"] (NoArg Flag_HyperlinkedSource) "generate highlighted and hyperlinked source code (for use with --html)", + Option [] ["source-css"] (ReqArg Flag_SourceCss "FILE") + "use custom CSS file instead of default one in hyperlinked source", Option [] ["source-base"] (ReqArg Flag_SourceBaseURL "URL") "URL for a source code link on the contents\nand index pages", Option ['s'] (if backwardsCompat then ["source", "source-module"] else ["source-module"]) @@ -242,6 +246,8 @@ optIndexUrl flags = optLast [ url | Flag_UseIndex url <- flags ] optCssFile :: [Flag] -> Maybe FilePath optCssFile flags = optLast [ str | Flag_CSS str <- flags ] +optSourceCssFile :: [Flag] -> Maybe FilePath +optSourceCssFile flags = optLast [ str | Flag_SourceCss str <- flags ] sourceUrls :: [Flag] -> (Maybe String, Maybe String, Maybe String, Maybe String) sourceUrls flags = -- cgit v1.2.3 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/haddock-api.cabal | 1 + haddock-api/resources/html/highlight.js | 46 ++++++++++++++++++++++ haddock-api/src/Haddock/Backends/Hyperlinker.hs | 10 ++++- .../src/Haddock/Backends/Hyperlinker/Renderer.hs | 23 +++++++---- 4 files changed, 70 insertions(+), 10 deletions(-) create mode 100644 haddock-api/resources/html/highlight.js (limited to 'haddock-api/resources/html') diff --git a/haddock-api/haddock-api.cabal b/haddock-api/haddock-api.cabal index 14656994..216627cc 100644 --- a/haddock-api/haddock-api.cabal +++ b/haddock-api/haddock-api.cabal @@ -21,6 +21,7 @@ data-files: html/solarized.css html/frames.html html/haddock-util.js + html/highlight.js html/Classic.theme/haskell_icon.gif html/Classic.theme/minus.gif html/Classic.theme/plus.gif diff --git a/haddock-api/resources/html/highlight.js b/haddock-api/resources/html/highlight.js new file mode 100644 index 00000000..639cf5d5 --- /dev/null +++ b/haddock-api/resources/html/highlight.js @@ -0,0 +1,46 @@ + +var styleForRule = function (rule) { + var sheets = document.styleSheets; + for (var s = 0; s < sheets.length; s++) { + var rules = sheets[s].cssRules; + for (var r = 0; r < rules.length; r++) { + if (rules[r].selectorText == rule) { + return rules[r].style; + } + } + } +}; + +var highlight = function () { + var color = styleForRule("a:hover")["background-color"]; + var links = document.getElementsByTagName('a'); + for (var i = 0; i < links.length; i++) { + var that = links[i]; + if (this.href == that.href) { + that.style["background-color"] = color; + } + } +}; + +/* + * I have no idea what is the proper antonym for "highlight" in this + * context. "Diminish"? "Unhighlight"? "Lowlight" sounds ridiculously + * so I like it. + */ +var lowlight = function () { + var links = document.getElementsByTagName('a'); + for (var i = 0; i < links.length; i++) { + var that = links[i]; + if (this.href == that.href) { + that.style["background-color"] = ""; + } + } +}; + +window.onload = function () { + var links = document.getElementsByTagName('a'); + for (var i = 0; i < links.length; i++) { + links[i].onmouseover = highlight; + links[i].onmouseout = lowlight; + } +}; 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 From 6cf5e45135ad48f140a76054b38e13eb83491d2a Mon Sep 17 00:00:00 2001 From: Łukasz Hanuszczak Date: Sun, 28 Jun 2015 23:13:05 +0200 Subject: Implement workaround for Chrome highlighting issues. --- haddock-api/resources/html/highlight.js | 12 +++++++++++- 1 file changed, 11 insertions(+), 1 deletion(-) (limited to 'haddock-api/resources/html') diff --git a/haddock-api/resources/html/highlight.js b/haddock-api/resources/html/highlight.js index 639cf5d5..a538feae 100644 --- a/haddock-api/resources/html/highlight.js +++ b/haddock-api/resources/html/highlight.js @@ -3,6 +3,10 @@ var styleForRule = function (rule) { var sheets = document.styleSheets; for (var s = 0; s < sheets.length; s++) { var rules = sheets[s].cssRules; + if (rules === null) { + return null; + } + for (var r = 0; r < rules.length; r++) { if (rules[r].selectorText == rule) { return rules[r].style; @@ -12,7 +16,13 @@ var styleForRule = function (rule) { }; var highlight = function () { - var color = styleForRule("a:hover")["background-color"]; + /* + * Chrome for security reasons disallows to read .cssRules property. + * So, we are forced to pick some color and set it as a highlight. + */ + var style = styleForRule("a:hover"); + var color = style !== null ? style["background-color"] : "#808080"; + var links = document.getElementsByTagName('a'); for (var i = 0; i < links.length; i++) { var that = links[i]; -- cgit v1.2.3 From 671e7dc60266d1e0fdabd34956719961c1333fb3 Mon Sep 17 00:00:00 2001 From: Łukasz Hanuszczak Date: Mon, 29 Jun 2015 20:33:18 +0200 Subject: Fix issue with hyperlink highlight styling in Chrome browser. --- haddock-api/resources/html/highlight.js | 57 ++++++++------------------------ haddock-api/resources/html/solarized.css | 2 +- 2 files changed, 15 insertions(+), 44 deletions(-) (limited to 'haddock-api/resources/html') diff --git a/haddock-api/resources/html/highlight.js b/haddock-api/resources/html/highlight.js index a538feae..1e903bd0 100644 --- a/haddock-api/resources/html/highlight.js +++ b/haddock-api/resources/html/highlight.js @@ -1,48 +1,19 @@ -var styleForRule = function (rule) { - var sheets = document.styleSheets; - for (var s = 0; s < sheets.length; s++) { - var rules = sheets[s].cssRules; - if (rules === null) { - return null; - } +var highlight = function (on) { + return function () { + var links = document.getElementsByTagName('a'); + for (var i = 0; i < links.length; i++) { + var that = links[i]; - for (var r = 0; r < rules.length; r++) { - if (rules[r].selectorText == rule) { - return rules[r].style; + if (this.href != that.href) { + continue; } - } - } -}; - -var highlight = function () { - /* - * Chrome for security reasons disallows to read .cssRules property. - * So, we are forced to pick some color and set it as a highlight. - */ - var style = styleForRule("a:hover"); - var color = style !== null ? style["background-color"] : "#808080"; - - var links = document.getElementsByTagName('a'); - for (var i = 0; i < links.length; i++) { - var that = links[i]; - if (this.href == that.href) { - that.style["background-color"] = color; - } - } -}; -/* - * I have no idea what is the proper antonym for "highlight" in this - * context. "Diminish"? "Unhighlight"? "Lowlight" sounds ridiculously - * so I like it. - */ -var lowlight = function () { - var links = document.getElementsByTagName('a'); - for (var i = 0; i < links.length; i++) { - var that = links[i]; - if (this.href == that.href) { - that.style["background-color"] = ""; + if (on) { + that.classList.add("hover-highlight"); + } else { + that.classList.remove("hover-highlight"); + } } } }; @@ -50,7 +21,7 @@ var lowlight = function () { window.onload = function () { var links = document.getElementsByTagName('a'); for (var i = 0; i < links.length; i++) { - links[i].onmouseover = highlight; - links[i].onmouseout = lowlight; + links[i].onmouseover = highlight(true); + links[i].onmouseout = highlight(false); } }; diff --git a/haddock-api/resources/html/solarized.css b/haddock-api/resources/html/solarized.css index e4bff385..e83dc5ec 100644 --- a/haddock-api/resources/html/solarized.css +++ b/haddock-api/resources/html/solarized.css @@ -50,6 +50,6 @@ a:link, a:visited { border-bottom: 1px solid #eee8d5; } -a:hover { +a:hover, a.hover-highlight { background-color: #eee8d5; } -- cgit v1.2.3 From 06e675167cc217d5346d706e0d52af0726710e3d Mon Sep 17 00:00:00 2001 From: Mateusz Kowalczyk Date: Tue, 7 Jul 2015 23:58:52 +0100 Subject: Delete trailing whitespace --- haddock-api/resources/html/frames.html | 2 +- haddock-api/resources/html/haddock-util.js | 22 +++++++++++----------- haddock-api/src/Haddock/Backends/HaddockDB.hs | 18 +++++++++--------- haddock-api/src/Haddock/Backends/Xhtml/Utils.hs | 2 +- haddock-api/src/Haddock/Version.hs | 2 +- haddock-library/LICENSE | 4 ++-- html-test/README.markdown | 2 +- html-test/ref/frames.html | 2 +- html-test/ref/haddock-util.js | 22 +++++++++++----------- html-test/src/Bugs.hs | 2 +- hypsrc-test/ref/src/Classes.html | 2 +- hypsrc-test/src/Classes.hs | 2 +- 12 files changed, 41 insertions(+), 41 deletions(-) (limited to 'haddock-api/resources/html') diff --git a/haddock-api/resources/html/frames.html b/haddock-api/resources/html/frames.html index 1b4e38d4..e86edb66 100644 --- a/haddock-api/resources/html/frames.html +++ b/haddock-api/resources/html/frames.html @@ -1,4 +1,4 @@ - diff --git a/haddock-api/resources/html/haddock-util.js b/haddock-api/resources/html/haddock-util.js index 9a6fccf7..ba574356 100644 --- a/haddock-api/resources/html/haddock-util.js +++ b/haddock-api/resources/html/haddock-util.js @@ -131,11 +131,11 @@ function perform_search(full) var text = document.getElementById("searchbox").value.toLowerCase(); if (text == last_search && !full) return; last_search = text; - + var table = document.getElementById("indexlist"); var status = document.getElementById("searchmsg"); var children = table.firstChild.childNodes; - + // first figure out the first node with the prefix var first = bisect(-1); var last = (first == -1 ? -1 : bisect(1)); @@ -166,7 +166,7 @@ function perform_search(full) status.innerHTML = ""; } - + function setclass(first, last, status) { for (var i = first; i <= last; i++) @@ -174,8 +174,8 @@ function perform_search(full) children[i].className = status; } } - - + + // do a binary search, treating 0 as ... // return either -1 (no 0's found) or location of most far match function bisect(dir) @@ -201,9 +201,9 @@ function perform_search(full) if (checkitem(i) == 0) return i; } return -1; - } - - + } + + // from an index, decide what the result is // 0 = match, -1 is lower, 1 is higher function checkitem(i) @@ -212,8 +212,8 @@ function perform_search(full) if (s == text) return 0; else return (s > text ? -1 : 1); } - - + + // from an index, get its string // this abstracts over alternates function getitem(i) @@ -250,7 +250,7 @@ function addMenuItem(html) { function adjustForFrames() { var bodyCls; - + if (parent.location.href == window.location.href) { // not in frames, so add Frames button addMenuItem("Frames"); diff --git a/haddock-api/src/Haddock/Backends/HaddockDB.hs b/haddock-api/src/Haddock/Backends/HaddockDB.hs index 1c248bfb..0bdc9057 100644 --- a/haddock-api/src/Haddock/Backends/HaddockDB.hs +++ b/haddock-api/src/Haddock/Backends/HaddockDB.hs @@ -40,7 +40,7 @@ ppIfaces mods where do_mod (Module mod, iface) = text " text mod <> text "\">" - $$ text "<literal>" + $$ text "<title><literal>" <> text mod <> text "</literal>" $$ text "" @@ -50,10 +50,10 @@ ppIfaces mods $$ vcat (map (do_export mod) (eltsFM (iface_decls iface))) $$ text "" $$ text "" - + do_export mod decl | (nm:_) <- declBinders decl = text "" + $$ text "" <> do_decl decl <> text "" $$ text "" @@ -63,11 +63,11 @@ ppIfaces mods $$ text "" do_export _ _ = empty - do_decl (HsTypeSig _ [nm] ty _) + do_decl (HsTypeSig _ [nm] ty _) = ppHsName nm <> text " :: " <> ppHsType ty do_decl (HsTypeDecl _ nm args ty _) = hsep ([text "type", ppHsName nm ] - ++ map ppHsName args + ++ map ppHsName args ++ [equals, ppHsType ty]) do_decl (HsNewTypeDecl loc ctx nm args con drv _) = hsep ([text "data", ppHsName nm] -- data, not newtype @@ -87,7 +87,7 @@ ppHsConstr :: HsConDecl -> Doc ppHsConstr (HsRecDecl pos name tvs ctxt fieldList maybe_doc) = ppHsName name <> (braces . hsep . punctuate comma . map ppField $ fieldList) -ppHsConstr (HsConDecl pos name tvs ctxt typeList maybe_doc) = +ppHsConstr (HsConDecl pos name tvs ctxt typeList maybe_doc) = hsep (ppHsName name : map ppHsBangType typeList) ppField (HsFieldDecl ns ty doc) @@ -100,7 +100,7 @@ ppHsBangType (HsUnBangedTy ty) = ppHsType ty ppHsContext :: HsContext -> Doc ppHsContext [] = empty -ppHsContext context = parenList (map (\ (a,b) -> ppHsQName a <+> +ppHsContext context = parenList (map (\ (a,b) -> ppHsQName a <+> hsep (map ppHsAType b)) context) ppHsType :: HsType -> Doc @@ -109,7 +109,7 @@ ppHsType (HsForAllType Nothing context htype) = ppHsType (HsForAllType (Just tvs) [] htype) = hsep (text "forall" : map ppHsName tvs ++ text "." : [ppHsType htype]) ppHsType (HsForAllType (Just tvs) context htype) = - hsep (text "forall" : map ppHsName tvs ++ text "." : + hsep (text "forall" : map ppHsName tvs ++ text "." : ppHsContext context : text "=>" : [ppHsType htype]) ppHsType (HsTyFun a b) = fsep [ppHsBType a, text "->", ppHsType b] ppHsType (HsTyIP n t) = fsep [(char '?' <> ppHsName n), text "::", ppHsType t] @@ -135,7 +135,7 @@ ppHsQName (UnQual str) = ppHsName str ppHsQName n@(Qual (Module mod) str) | n == unit_con_name = ppHsName str | isSpecial str = ppHsName str - | otherwise + | otherwise = text "" diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Utils.hs b/haddock-api/src/Haddock/Backends/Xhtml/Utils.hs index 5166549a..26bcbf6d 100644 --- a/haddock-api/src/Haddock/Backends/Xhtml/Utils.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml/Utils.hs @@ -215,7 +215,7 @@ collapseSection id_ state classes = [ identifier sid, theclass cs ] collapseToggle :: String -> [HtmlAttr] collapseToggle id_ = [ strAttr "onclick" js ] where js = "toggleSection('" ++ id_ ++ "')"; - + -- | Attributes for an area that toggles a collapsed area, -- and displays a control. collapseControl :: String -> Bool -> String -> [HtmlAttr] diff --git a/haddock-api/src/Haddock/Version.hs b/haddock-api/src/Haddock/Version.hs index 2ef3a257..4e9a581a 100644 --- a/haddock-api/src/Haddock/Version.hs +++ b/haddock-api/src/Haddock/Version.hs @@ -9,7 +9,7 @@ -- Stability : experimental -- Portability : portable ----------------------------------------------------------------------------- -module Haddock.Version ( +module Haddock.Version ( projectName, projectVersion, projectUrl ) where diff --git a/haddock-library/LICENSE b/haddock-library/LICENSE index 1636bfcd..460decfc 100644 --- a/haddock-library/LICENSE +++ b/haddock-library/LICENSE @@ -5,11 +5,11 @@ modification, are permitted provided that the following conditions are met: - Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. - + - Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. - + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR diff --git a/html-test/README.markdown b/html-test/README.markdown index 8d57acab..717bac5c 100644 --- a/html-test/README.markdown +++ b/html-test/README.markdown @@ -1,7 +1,7 @@ This is a testsuite for Haddock that uses the concept of "golden files". That is, it compares output files against a set of reference files. -To add a new test: +To add a new test: 1. Create a module in the `html-test/src` directory. diff --git a/html-test/ref/frames.html b/html-test/ref/frames.html index 1b4e38d4..e86edb66 100644 --- a/html-test/ref/frames.html +++ b/html-test/ref/frames.html @@ -1,4 +1,4 @@ - diff --git a/html-test/ref/haddock-util.js b/html-test/ref/haddock-util.js index 9a6fccf7..ba574356 100644 --- a/html-test/ref/haddock-util.js +++ b/html-test/ref/haddock-util.js @@ -131,11 +131,11 @@ function perform_search(full) var text = document.getElementById("searchbox").value.toLowerCase(); if (text == last_search && !full) return; last_search = text; - + var table = document.getElementById("indexlist"); var status = document.getElementById("searchmsg"); var children = table.firstChild.childNodes; - + // first figure out the first node with the prefix var first = bisect(-1); var last = (first == -1 ? -1 : bisect(1)); @@ -166,7 +166,7 @@ function perform_search(full) status.innerHTML = ""; } - + function setclass(first, last, status) { for (var i = first; i <= last; i++) @@ -174,8 +174,8 @@ function perform_search(full) children[i].className = status; } } - - + + // do a binary search, treating 0 as ... // return either -1 (no 0's found) or location of most far match function bisect(dir) @@ -201,9 +201,9 @@ function perform_search(full) if (checkitem(i) == 0) return i; } return -1; - } - - + } + + // from an index, decide what the result is // 0 = match, -1 is lower, 1 is higher function checkitem(i) @@ -212,8 +212,8 @@ function perform_search(full) if (s == text) return 0; else return (s > text ? -1 : 1); } - - + + // from an index, get its string // this abstracts over alternates function getitem(i) @@ -250,7 +250,7 @@ function addMenuItem(html) { function adjustForFrames() { var bodyCls; - + if (parent.location.href == window.location.href) { // not in frames, so add Frames button addMenuItem("Frames"); diff --git a/html-test/src/Bugs.hs b/html-test/src/Bugs.hs index 8e1f0079..e60bbe8f 100644 --- a/html-test/src/Bugs.hs +++ b/html-test/src/Bugs.hs @@ -1,3 +1,3 @@ module Bugs where -data A a = A a (a -> Int) +data A a = A a (a -> Int) diff --git a/hypsrc-test/ref/src/Classes.html b/hypsrc-test/ref/src/Classes.html index a5a3d243..13c8389a 100644 --- a/hypsrc-test/ref/src/Classes.html +++ b/hypsrc-test/ref/src/Classes.html @@ -408,7 +408,7 @@ >] + > Foo' a where quux :: (a, a) -> a - quux (x, y) = norf [x, y] + quux (x, y) = norf [x, y] norf :: [a] -> a norf = quux . baz . sum . map bar -- cgit v1.2.3 From 7656bf86a661c5c755dc9874f709df2fc4833257 Mon Sep 17 00:00:00 2001 From: Phil Ruffwind Date: Sun, 14 Jun 2015 23:12:09 -0400 Subject: Avoid JavaScript error during page load in non-frame mode In non-frame mode, parent.window.synopsis refers to the synopsis div rather than the nonexistent frame. Unfortunately, the script wrongly assumes that if it exists it must be a frame, leading to an error where it tries to access the nonexistent attribute 'replace' of an undefined value (synopsis.location). Closes #406 --- haddock-api/resources/html/haddock-util.js | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'haddock-api/resources/html') diff --git a/haddock-api/resources/html/haddock-util.js b/haddock-api/resources/html/haddock-util.js index ba574356..fc7743fe 100644 --- a/haddock-api/resources/html/haddock-util.js +++ b/haddock-api/resources/html/haddock-util.js @@ -229,7 +229,7 @@ function perform_search(full) } function setSynopsis(filename) { - if (parent.window.synopsis) { + if (parent.window.synopsis && parent.window.synopsis.location) { if (parent.window.synopsis.location.replace) { // In Firefox this avoids adding the change to the history. parent.window.synopsis.location.replace(filename); -- cgit v1.2.3 From ecabf4e16d72818d39d0a18c9a64cb1d464b87b5 Mon Sep 17 00:00:00 2001 From: Phil Ruffwind Date: Mon, 15 Jun 2015 00:06:08 -0400 Subject: Link to the definitions to themselves Currently, the definitions already have an anchor tag that allows URLs with fragment identifiers to locate them, but it is rather inconvenient to obtain such a URL (so-called "permalink") as it would require finding the a link to the corresponding item in the Synopsis or elsewhere. This commit adds hyperlinks to the definitions themselves, allowing users to obtain links to them easily. To preserve the original aesthetics of the definitions, we alter the color of the link so as to be identical to what it was, except it now has a hover effect indicating that it is clickable. Additionally, the anchor now uses the 'id' attribute instead of the (obsolete) 'name' attribute. Closes #407 --- .../resources/html/Ocean.std-theme/ocean.css | 3 +++ haddock-api/src/Haddock/Backends/Xhtml/Names.hs | 21 +++++++++++++-------- 2 files changed, 16 insertions(+), 8 deletions(-) (limited to 'haddock-api/resources/html') diff --git a/haddock-api/resources/html/Ocean.std-theme/ocean.css b/haddock-api/resources/html/Ocean.std-theme/ocean.css index 1110b407..1cc55cb6 100644 --- a/haddock-api/resources/html/Ocean.std-theme/ocean.css +++ b/haddock-api/resources/html/Ocean.std-theme/ocean.css @@ -41,6 +41,9 @@ a[href]:link { color: rgb(196,69,29); } a[href]:visited { color: rgb(171,105,84); } a[href]:hover { text-decoration:underline; } +a[href].def:link, a[href].def:visited { color: black; } +a[href].def:hover { color: rgb(78, 98, 114); } + /* @end */ /* @group Fonts & Sizes */ diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Names.hs b/haddock-api/src/Haddock/Backends/Xhtml/Names.hs index cf12da40..c69710d1 100644 --- a/haddock-api/src/Haddock/Backends/Xhtml/Names.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml/Names.hs @@ -110,16 +110,21 @@ ppName notation name = wrapInfix notation (getOccName name) $ toHtml (getOccStri ppBinder :: Bool -> OccName -> Html --- The Bool indicates whether we are generating the summary, in which case --- the binder will be a link to the full definition. -ppBinder True n = linkedAnchor (nameAnchorId n) << ppBinder' Prefix n -ppBinder False n = namedAnchor (nameAnchorId n) ! [theclass "def"] - << ppBinder' Prefix n +ppBinder = ppBinderWith Prefix ppBinderInfix :: Bool -> OccName -> Html -ppBinderInfix True n = linkedAnchor (nameAnchorId n) << ppBinder' Infix n -ppBinderInfix False n = namedAnchor (nameAnchorId n) ! [theclass "def"] - << ppBinder' Infix n +ppBinderInfix = ppBinderWith Infix + +ppBinderWith :: Notation -> Bool -> OccName -> Html +-- 'isRef' indicates whether this is merely a reference from another part of +-- the documentation or is the actual definition; in the latter case, we also +-- set the 'id' and 'class' attributes. +ppBinderWith notation isRef n = + linkedAnchor name ! attributes << ppBinder' notation n + where + name = nameAnchorId n + attributes | isRef = [] + | otherwise = [identifier name, theclass "def"] ppBinder' :: Notation -> OccName -> Html ppBinder' notation n = wrapInfix notation n $ ppOccName n -- cgit v1.2.3 From c274363d5d868c838c382a52428c667090514f86 Mon Sep 17 00:00:00 2001 From: Phil Ruffwind Date: Mon, 27 Jul 2015 05:58:58 -0400 Subject: Fix record field alignment when name is too long Change
to
    and use display:table rather than floats to layout the record fields. This avoids bug #301 that occurs whenever the field name gets too long. Slight aesthetic change: the entire cell of the field's source code is now shaded gray rather than just the area where text exists. Fixes #301. Closes #421 --- .../resources/html/Ocean.std-theme/ocean.css | 29 +++++++++++----------- haddock-api/src/Haddock/Backends/Xhtml/Layout.hs | 10 +++----- 2 files changed, 19 insertions(+), 20 deletions(-) (limited to 'haddock-api/resources/html') diff --git a/haddock-api/resources/html/Ocean.std-theme/ocean.css b/haddock-api/resources/html/Ocean.std-theme/ocean.css index 1cc55cb6..9ad9f9d2 100644 --- a/haddock-api/resources/html/Ocean.std-theme/ocean.css +++ b/haddock-api/resources/html/Ocean.std-theme/ocean.css @@ -427,30 +427,31 @@ div#style-menu-holder { visibility: hidden; } -.subs dl { +.subs ul { + list-style: none; + display: table; margin: 0; } -.subs dt { - float: left; - clear: left; - display: block; +.subs ul li { + display: table-row; +} + +.subs ul li dfn { + display: table-cell; + font-style: normal; + font-weight: bold; margin: 1px 0; + white-space: nowrap; } -.subs dd { - float: right; - width: 90%; - display: block; +.subs ul li > .doc { + display: table-cell; padding-left: 0.5em; margin-bottom: 0.5em; } -.subs dd.empty { - display: none; -} - -.subs dd p { +.subs ul li > .doc p { margin: 0; } diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs b/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs index e79c2c3d..4714c1b6 100644 --- a/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs @@ -127,14 +127,12 @@ divSubDecls cssClass captionName = maybe noHtml wrap subDlist :: Qualification -> [SubDecl] -> Maybe Html subDlist _ [] = Nothing -subDlist qual decls = Just $ dlist << map subEntry decls +++ clearDiv +subDlist qual decls = Just $ ulist << map subEntry decls where subEntry (decl, mdoc, subs) = - dterm ! [theclass "src"] << decl - +++ - docElement ddef << (fmap (docToHtml Nothing qual) mdoc +++ subs) - - clearDiv = thediv ! [ theclass "clear" ] << noHtml + li << + (define ! [theclass "src"] << decl +++ + docElement thediv << (fmap (docToHtml Nothing qual) mdoc +++ subs)) subTable :: Qualification -> [SubDecl] -> Maybe Html -- cgit v1.2.3 From f0edea1969cdc06d0299c606debf533d7ece77f0 Mon Sep 17 00:00:00 2001 From: Łukasz Hanuszczak Date: Tue, 21 Jul 2015 19:22:30 +0200 Subject: Improve placement of instance methods expander button. --- haddock-api/resources/html/Ocean.std-theme/ocean.css | 14 ++++++++++---- haddock-api/src/Haddock/Backends/Xhtml/Layout.hs | 6 +++--- 2 files changed, 13 insertions(+), 7 deletions(-) (limited to 'haddock-api/resources/html') diff --git a/haddock-api/resources/html/Ocean.std-theme/ocean.css b/haddock-api/resources/html/Ocean.std-theme/ocean.css index 9ad9f9d2..428040bc 100644 --- a/haddock-api/resources/html/Ocean.std-theme/ocean.css +++ b/haddock-api/resources/html/Ocean.std-theme/ocean.css @@ -146,15 +146,21 @@ ul.links li a { background-image: url(plus.gif); background-repeat: no-repeat; } -p.caption.collapser, -p.caption.expander { - background-position: 0 0.4em; -} .collapser, .expander { padding-left: 14px; margin-left: -14px; cursor: pointer; } +p.caption.collapser, +p.caption.expander { + background-position: 0 0.4em; +} + +.instance.collapser, .instance.expander { + margin-left: 0px; + background-position: left center; +} + pre { padding: 0.25em; diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs b/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs index d971b0e5..460cc6d7 100644 --- a/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs @@ -207,11 +207,11 @@ subClsInstance :: String -- ^ Section unique id -> [Html] -- ^ Method contents (pretty-printed signatures) -> Html subClsInstance sid hdr mets = - hdrDiv <+> methodDiv + (hdrDiv << hdr) <+> (methodDiv << subBlock mets) where anchorId = makeAnchorId $ "i:" ++ sid - hdrDiv = thediv ! collapseControl anchorId False "instance" << hdr - methodDiv = thediv ! collapseSection anchorId False [] << subBlock mets + hdrDiv = thediv ! collapseControl anchorId False "instance" + methodDiv = thediv ! collapseSection anchorId False "methods" subMethods :: [Html] -> Html -- cgit v1.2.3 From c537853ff7574a6bf3c3c94fa9db52aa23a5859f Mon Sep 17 00:00:00 2001 From: Łukasz Hanuszczak Date: Mon, 3 Aug 2015 15:29:35 +0200 Subject: Fix issue with instance expander hijacking type hyperlink click. --- haddock-api/resources/html/Ocean.std-theme/ocean.css | 2 ++ haddock-api/src/Haddock/Backends/Xhtml/Layout.hs | 4 ++-- 2 files changed, 4 insertions(+), 2 deletions(-) (limited to 'haddock-api/resources/html') diff --git a/haddock-api/resources/html/Ocean.std-theme/ocean.css b/haddock-api/resources/html/Ocean.std-theme/ocean.css index 428040bc..139335ac 100644 --- a/haddock-api/resources/html/Ocean.std-theme/ocean.css +++ b/haddock-api/resources/html/Ocean.std-theme/ocean.css @@ -159,6 +159,8 @@ p.caption.expander { .instance.collapser, .instance.expander { margin-left: 0px; background-position: left center; + min-width: 9px; + min-height: 9px; } diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs b/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs index 074b6801..d624a1d0 100644 --- a/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs @@ -205,9 +205,9 @@ subInstHead :: String -- ^ Instance unique id (for anchor generation) -> Html -- ^ Header content (instance name and type) -> Html subInstHead iid hdr = - expander << hdr + expander noHtml <+> hdr where - expander = thediv ! collapseControl (instAnchorId iid) False "instance" + expander = thespan ! collapseControl (instAnchorId iid) False "instance" subInstDetails :: String -- ^ Instance unique id (for anchor generation) -- cgit v1.2.3