aboutsummaryrefslogtreecommitdiff
path: root/haddock-api
diff options
context:
space:
mode:
authorBen Gamari <ben@smart-cactus.org>2017-03-23 09:25:33 -0400
committerBen Gamari <ben@smart-cactus.org>2017-03-23 09:25:33 -0400
commit606da884355527051afe0058c2f8b0ac2005e01b (patch)
tree9388f16cb30761dd3f37c0bd3b6e251f9ebc2f87 /haddock-api
parent4eb765ca4205c79539d60b7afa9b7e261a4a49fe (diff)
parent240bc38b94ed2d0af27333b23392d03eeb615e82 (diff)
Merge commit '240bc38b94ed2d0af27333b23392d03eeb615e82' into HEAD
Diffstat (limited to 'haddock-api')
-rw-r--r--haddock-api/haddock-api.cabal3
-rw-r--r--haddock-api/resources/html/Ocean.std-theme/ocean.css2
-rw-r--r--haddock-api/resources/html/frames.html30
-rw-r--r--haddock-api/resources/html/haddock-util.js28
-rw-r--r--haddock-api/src/Haddock.hs2
-rw-r--r--haddock-api/src/Haddock/Backends/Xhtml.hs59
-rw-r--r--haddock-api/src/Haddock/Convert.hs1
-rw-r--r--haddock-api/src/Haddock/Interface/Create.hs16
-rw-r--r--haddock-api/src/Haddock/Interface/ParseModuleHeader.hs2
-rw-r--r--haddock-api/src/Haddock/Types.hs4
-rw-r--r--haddock-api/src/Haddock/Utils.hs12
11 files changed, 38 insertions, 121 deletions
diff --git a/haddock-api/haddock-api.cabal b/haddock-api/haddock-api.cabal
index 2ddd97cb..620fd981 100644
--- a/haddock-api/haddock-api.cabal
+++ b/haddock-api/haddock-api.cabal
@@ -1,5 +1,5 @@
name: haddock-api
-version: 2.17.2
+version: 2.17.3
synopsis: A documentation-generation tool for Haskell libraries
description: Haddock is a documentation-generation tool for Haskell
libraries
@@ -19,7 +19,6 @@ data-dir:
resources
data-files:
html/solarized.css
- html/frames.html
html/haddock-util.js
html/highlight.js
html/Classic.theme/haskell_icon.gif
diff --git a/haddock-api/resources/html/Ocean.std-theme/ocean.css b/haddock-api/resources/html/Ocean.std-theme/ocean.css
index f816aeca..29af691b 100644
--- a/haddock-api/resources/html/Ocean.std-theme/ocean.css
+++ b/haddock-api/resources/html/Ocean.std-theme/ocean.css
@@ -338,6 +338,8 @@ div#style-menu-holder {
top: 10%;
padding: 0;
max-width: 75%;
+ /* Ensure that synopsis covers everything (including MathJAX markup) */
+ z-index: 1;
}
#synopsis .caption {
diff --git a/haddock-api/resources/html/frames.html b/haddock-api/resources/html/frames.html
deleted file mode 100644
index e86edb66..00000000
--- a/haddock-api/resources/html/frames.html
+++ /dev/null
@@ -1,30 +0,0 @@
-<!DOCTYPE html
- PUBLIC "-//W3C//DTD XHTML 1.0 Frameset//EN"
- "http://www.w3.org/TR/xhtml1/DTD/xhtml1-frameset.dtd">
-<html xmlns="http://www.w3.org/1999/xhtml">
-<head>
-<title></title>
-<script src="haddock-util.js" type="text/javascript"></script>
-<script type="text/javascript"><!--
-/*
-
- The synopsis frame needs to be updated using javascript, so we hide
- it by default and only show it if javascript is enabled.
-
- TODO: provide some means to disable it.
-*/
-function load() {
- var d = document.getElementById("inner-fs");
- d.rows = "50%,50%";
- postReframe();
-}
---></script>
-</head>
-<frameset id="outer-fs" cols="25%,75%" onload="load()">
- <frameset id="inner-fs" rows="100%,0%">
- <frame src="index-frames.html" name="modules" />
- <frame src="" name="synopsis" />
- </frameset>
- <frame src="index.html" name="main" />
-</frameset>
-</html>
diff --git a/haddock-api/resources/html/haddock-util.js b/haddock-api/resources/html/haddock-util.js
index fc7743fe..92d07d2a 100644
--- a/haddock-api/resources/html/haddock-util.js
+++ b/haddock-api/resources/html/haddock-util.js
@@ -248,33 +248,6 @@ function addMenuItem(html) {
}
}
-function adjustForFrames() {
- var bodyCls;
-
- if (parent.location.href == window.location.href) {
- // not in frames, so add Frames button
- addMenuItem("<a href='#' onclick='reframe();return true;'>Frames</a>");
- bodyCls = "no-frame";
- }
- else {
- bodyCls = "in-frame";
- }
- addClass(document.body, bodyCls);
-}
-
-function reframe() {
- setCookie("haddock-reframe", document.URL);
- window.location = "frames.html";
-}
-
-function postReframe() {
- var s = getCookie("haddock-reframe");
- if (s) {
- parent.window.main.location = s;
- clearCookie("haddock-reframe");
- }
-}
-
function styles() {
var i, a, es = document.getElementsByTagName("link"), rs = [];
for (i = 0; a = es[i]; i++) {
@@ -337,7 +310,6 @@ function styleMenu(show) {
function pageLoad() {
addStyleMenu();
- adjustForFrames();
resetStyle();
restoreCollapsed();
}
diff --git a/haddock-api/src/Haddock.hs b/haddock-api/src/Haddock.hs
index 83136df6..bbaea359 100644
--- a/haddock-api/src/Haddock.hs
+++ b/haddock-api/src/Haddock.hs
@@ -335,7 +335,7 @@ render dflags flags qual ifaces installedIfaces extSrcMap = do
ppLaTeX title pkgStr visibleIfaces odir (fmap _doc prologue) opt_latex_style
libDir
- when (Flag_HyperlinkedSource `elem` flags) $ do
+ when (Flag_HyperlinkedSource `elem` flags && not (null ifaces)) $ do
ppHyperlinkedSource odir libDir opt_source_css pretty srcMap ifaces
-- | From GHC 7.10, this function has a potential to crash with a
diff --git a/haddock-api/src/Haddock/Backends/Xhtml.hs b/haddock-api/src/Haddock/Backends/Xhtml.hs
index 10b69a68..7b5f9017 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml.hs
@@ -35,8 +35,8 @@ import Text.XHtml hiding ( name, title, p, quote )
import Haddock.GhcUtils
import Control.Monad ( when, unless )
-import Data.Char ( toUpper )
-import Data.List ( sortBy, groupBy, intercalate, isPrefixOf )
+import Data.Char ( toUpper, isSpace )
+import Data.List ( sortBy, intercalate, isPrefixOf, intersperse )
import Data.Maybe
import System.FilePath hiding ( (</>) )
import System.Directory
@@ -105,7 +105,8 @@ copyHtmlBits odir libdir themes = do
copyCssFile f = copyFile f (combine odir (takeFileName f))
copyLibFile f = copyFile (joinPath [libhtmldir, f]) (joinPath [odir, f])
mapM_ copyCssFile (cssFiles themes)
- mapM_ copyLibFile [ jsFile, framesFile ]
+ copyLibFile jsFile
+ return ()
headHtml :: String -> Maybe String -> Themes -> Maybe String -> Html
@@ -201,8 +202,7 @@ moduleInfo iface =
field info >>= \a -> return (th << fieldName <-> td << a)
entries :: [HtmlTable]
- entries = mapMaybe doOneEntry [
- ("Copyright",hmi_copyright),
+ entries = maybeToList copyrightsTable ++ mapMaybe doOneEntry [
("License",hmi_license),
("Maintainer",hmi_maintainer),
("Stability",hmi_stability),
@@ -216,6 +216,14 @@ moduleInfo iface =
Just Haskell98 -> Just "Haskell98"
Just Haskell2010 -> Just "Haskell2010"
+ multilineRow :: String -> [String] -> HtmlTable
+ multilineRow title xs = (th ! [valign "top"]) << title <-> td << (toLines xs)
+ where toLines = mconcat . intersperse br . map toHtml
+
+ copyrightsTable :: Maybe HtmlTable
+ copyrightsTable = fmap (multilineRow "Copyright" . split) (hmi_copyright info)
+ where split = map (trim . filter (/= ',')) . lines
+
extsForm
| OptShowExtensions `elem` ifaceOptions iface =
let fs = map (dropOpt . show) (hmi_extensions info)
@@ -275,9 +283,6 @@ ppHtmlContents dflags odir doctitle _maybe_package
createDirectoryIfMissing True odir
writeFile (joinPath [odir, contentsHtmlFile]) (renderToString debug html)
- -- XXX: think of a better place for this?
- ppHtmlContentsFrame odir doctitle themes mathjax_url ifaces debug
-
ppPrologue :: Qualification -> String -> Maybe (MDoc GHC.RdrName) -> Html
ppPrologue _ _ Nothing = noHtml
@@ -334,41 +339,6 @@ mkNode qual ss p (Node s leaf pkg srcPkg short ts) =
subtree = mkNodeList qual (s:ss) p ts ! collapseSection p True ""
--- | Turn a module tree into a flat list of full module names. E.g.,
--- @
--- A
--- +-B
--- +-C
--- @
--- becomes
--- @["A", "A.B", "A.B.C"]@
-flatModuleTree :: [InstalledInterface] -> [Html]
-flatModuleTree ifaces =
- map (uncurry ppModule' . head)
- . groupBy ((==) `on` fst)
- . sortBy (comparing fst)
- $ mods
- where
- mods = [ (moduleString mdl, mdl) | mdl <- map instMod ifaces ]
- ppModule' txt mdl =
- anchor ! [href (moduleHtmlFile mdl), target mainFrameName]
- << toHtml txt
-
-
-ppHtmlContentsFrame :: FilePath -> String -> Themes -> Maybe String
- -> [InstalledInterface] -> Bool -> IO ()
-ppHtmlContentsFrame odir doctitle themes maybe_mathjax_url ifaces debug = do
- -- TODO: Arguably should split up signatures and modules here too...
- -- but who uses frames? Fix this if someone complains. -- ezyang
- let mods = flatModuleTree ifaces
- html =
- headHtml doctitle Nothing themes maybe_mathjax_url +++
- miniBody << divModuleList <<
- (sectionName << "Modules" +++
- ulist << [ li ! [theclass "module"] << m | m <- mods ])
- createDirectoryIfMissing True odir
- writeFile (joinPath [odir, frameIndexHtmlFile]) (renderToString debug html)
-
--------------------------------------------------------------------------------
-- * Generate the index
@@ -709,6 +679,9 @@ processDecl :: Bool -> Html -> Maybe Html
processDecl True = Just
processDecl False = Just . divTopDecl
+trim :: String -> String
+trim = f . f
+ where f = reverse . dropWhile isSpace
processDeclOneLiner :: Bool -> Html -> Maybe Html
processDeclOneLiner True = Just
diff --git a/haddock-api/src/Haddock/Convert.hs b/haddock-api/src/Haddock/Convert.hs
index 577b1a3c..01261477 100644
--- a/haddock-api/src/Haddock/Convert.hs
+++ b/haddock-api/src/Haddock/Convert.hs
@@ -1,3 +1,4 @@
+
{-# LANGUAGE CPP, PatternGuards #-}
-----------------------------------------------------------------------------
-- |
diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs
index cd46831e..e594feae 100644
--- a/haddock-api/src/Haddock/Interface/Create.hs
+++ b/haddock-api/src/Haddock/Interface/Create.hs
@@ -877,13 +877,21 @@ extractDecl name decl
| otherwise =
case unLoc decl of
TyClD d@ClassDecl {} ->
- let matches = [ sig | sig <- tcdSigs d, name `elem` sigName sig,
- isTypeLSig sig ] -- TODO: document fixity
+ let matches = [ lsig
+ | lsig <- tcdSigs d
+ , ClassOpSig False _ _ <- pure $ unLoc lsig
+ -- Note: exclude `default` declarations (see #505)
+ , name `elem` sigName lsig
+ ]
+ -- TODO: document fixity
in case matches of
[s0] -> let (n, tyvar_names) = (tcdName d, tyClDeclTyVars d)
L pos sig = addClassContext n tyvar_names s0
in L pos (SigD sig)
- _ -> error "internal: extractDecl (ClassDecl)"
+ _ -> O.pprPanic "extractDecl" (O.text "Ambiguous decl for" O.<+> O.ppr name O.<+> O.text "in class:"
+ O.$$ O.nest 4 (O.ppr d)
+ O.$$ O.text "Matches:"
+ O.$$ O.nest 4 (O.ppr matches))
TyClD d@DataDecl {} ->
let (n, tyvar_tys) = (tcdName d, lHsQTyVarsToTypes (tyClDeclTyVars d))
in SigD <$> extractRecSel name n tyvar_tys (dd_cons (tcdDataDefn d))
@@ -918,7 +926,7 @@ extractRecSel nm t tvs (L _ con : rest) =
matching_fields flds = [ (l,f) | f@(L _ (ConDeclField ns _ _)) <- flds
, L l n <- ns, selectorFieldOcc n == nm ]
data_ty
- -- | ResTyGADT _ ty <- con_res con = ty
+ -- ResTyGADT _ ty <- con_res con = ty
| ConDeclGADT{} <- con = hsib_body $ con_type con
| otherwise = foldl' (\x y -> noLoc (HsAppTy x y)) (noLoc (HsTyVar NotPromoted (noLoc t))) tvs
diff --git a/haddock-api/src/Haddock/Interface/ParseModuleHeader.hs b/haddock-api/src/Haddock/Interface/ParseModuleHeader.hs
index e7d2a085..768a31ce 100644
--- a/haddock-api/src/Haddock/Interface/ParseModuleHeader.hs
+++ b/haddock-api/src/Haddock/Interface/ParseModuleHeader.hs
@@ -76,7 +76,7 @@ parseKey :: String -> String -> Maybe (String,String)
parseKey key toParse0 =
do
let
- (spaces0,toParse1) = extractLeadingSpaces toParse0
+ (spaces0,toParse1) = extractLeadingSpaces (dropWhile (`elem` ['\r', '\n']) toParse0)
indentation = spaces0
afterKey0 <- extractPrefix key toParse1
diff --git a/haddock-api/src/Haddock/Types.hs b/haddock-api/src/Haddock/Types.hs
index e48acabe..e2bbe6f8 100644
--- a/haddock-api/src/Haddock/Types.hs
+++ b/haddock-api/src/Haddock/Types.hs
@@ -458,8 +458,8 @@ instance (NFData a, NFData mod)
DocExamples a -> a `deepseq` ()
DocHeader a -> a `deepseq` ()
-#if __GLASGOW_HASKELL__ < 801
--- These were added to GHC itself in 8.2.1
+#if !MIN_VERSION_GLASGOW_HASKELL(8,0,1,1)
+-- These were added to GHC itself in 8.0.2
instance NFData Name where rnf x = seq x ()
instance NFData OccName where rnf x = seq x ()
instance NFData ModuleName where rnf x = seq x ()
diff --git a/haddock-api/src/Haddock/Utils.hs b/haddock-api/src/Haddock/Utils.hs
index ba382600..404cfcf6 100644
--- a/haddock-api/src/Haddock/Utils.hs
+++ b/haddock-api/src/Haddock/Utils.hs
@@ -21,10 +21,9 @@ module Haddock.Utils (
-- * Filename utilities
moduleHtmlFile, moduleHtmlFile',
contentsHtmlFile, indexHtmlFile,
- frameIndexHtmlFile,
moduleIndexFrameName, mainFrameName, synopsisFrameName,
subIndexHtmlFile,
- jsFile, framesFile,
+ jsFile,
-- * Anchor and URL utilities
moduleNameUrl, moduleNameUrl', moduleUrl,
@@ -262,12 +261,6 @@ contentsHtmlFile = "index.html"
indexHtmlFile = "doc-index.html"
--- | The name of the module index file to be displayed inside a frame.
--- Modules are display in full, but without indentation. Clicking opens in
--- the main window.
-frameIndexHtmlFile :: String
-frameIndexHtmlFile = "index-frames.html"
-
moduleIndexFrameName, mainFrameName, synopsisFrameName :: String
moduleIndexFrameName = "modules"
@@ -333,9 +326,8 @@ makeAnchorId (f:r) = escape isAlpha f ++ concatMap (escape isLegal) r
-------------------------------------------------------------------------------
-jsFile, framesFile :: String
+jsFile :: String
jsFile = "haddock-util.js"
-framesFile = "frames.html"
-------------------------------------------------------------------------------
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-15 02:48:35 +0000