diff options
Diffstat (limited to 'haddock-api')
-rw-r--r-- | haddock-api/haddock-api.cabal | 3 | ||||
-rw-r--r-- | haddock-api/resources/html/Ocean.std-theme/ocean.css | 2 | ||||
-rw-r--r-- | haddock-api/resources/html/frames.html | 30 | ||||
-rw-r--r-- | haddock-api/resources/html/haddock-util.js | 28 | ||||
-rw-r--r-- | haddock-api/src/Haddock.hs | 2 | ||||
-rw-r--r-- | haddock-api/src/Haddock/Backends/Xhtml.hs | 59 | ||||
-rw-r--r-- | haddock-api/src/Haddock/Convert.hs | 1 | ||||
-rw-r--r-- | haddock-api/src/Haddock/Interface/Create.hs | 16 | ||||
-rw-r--r-- | haddock-api/src/Haddock/Interface/ParseModuleHeader.hs | 2 | ||||
-rw-r--r-- | haddock-api/src/Haddock/Types.hs | 4 | ||||
-rw-r--r-- | haddock-api/src/Haddock/Utils.hs | 12 |
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" ------------------------------------------------------------------------------- |