diff options
30 files changed, 348 insertions, 271 deletions
@@ -1,3 +1,7 @@ +Changes in version 2.17.3 + + * Remove framed view of the HTML documentation + Changes in version 2.17.2 * Fix portability of documentation building within GHC diff --git a/doc/invoking.rst b/doc/invoking.rst index 13cb9f1e..83087bac 100644 --- a/doc/invoking.rst +++ b/doc/invoking.rst @@ -100,7 +100,7 @@ The following options are available: ``module.html``; ``mini_module.html`` An HTML page for each module, and a "mini" page for each used - when viewing in frames. + when viewing their synopsis. ``index.html`` The top level page of the documentation: lists the modules @@ -111,17 +111,13 @@ The following options are available: The alphabetic index, possibly split into multiple pages if big enough. - ``frames.html`` - The top level document when viewing in frames. - ``some.css``; ``etc...`` Files needed for the themes used. Specify your themes using the :option:`--theme` option. ``haddock-util.js`` Some JavaScript utilities used to implement some of the dynamic - features like collapsible sections, and switching to frames - view. + features like collapsible sections. .. option:: --latex diff --git a/doc/markup.rst b/doc/markup.rst index a2274ad6..b0ebc738 100644 --- a/doc/markup.rst +++ b/doc/markup.rst @@ -501,7 +501,7 @@ Special characters ~~~~~~~~~~~~~~~~~~ The following characters have special meanings in documentation -comments: ``\\``, ``/``, ``'``, ``\```, ``"``, ``@``, ``<``. To insert a +comments: ``\\``, ``/``, ``'``, ``\```, ``"``, ``@``, ``<``, ``$``. To insert a literal occurrence of one of these special characters, precede it with a backslash (``\\``). @@ -799,6 +799,21 @@ If the output format supports it, the image will be rendered inside the documentation. The image description is used as relpacement text and/or image title. +Mathematics / LaTeX +~~~~~~~~~~~~~~~~~~~ + +Haddock supports LaTeX syntax for rendering mathematical notation. The +delimiters are ``\[...\]`` for displayed mathematics and ``\(...\)`` +for in-line mathematics. An example looks like this: :: + + \[ + f(a) = \frac{1}{2\pi i}\oint_\gamma \frac{f(z)}{z-a}\,\mathrm{d}z + \] + +If the output format supports it, the mathematics will be rendered +inside the documentation. For example, the HTML backend will display +the mathematics via `MathJax <https://www.mathjax.org>`__. + Anchors ~~~~~~~ @@ -36,7 +36,6 @@ endif utils/haddock_dist_MODULES += Paths_haddock -utils/haddock_dist_DATA_FILES += html/frames.html utils/haddock_dist_DATA_FILES += html/haddock-util.js utils/haddock_dist_DATA_FILES += html/Classic.theme/haskell_icon.gif utils/haddock_dist_DATA_FILES += html/Classic.theme/minus.gif diff --git a/haddock-api/haddock-api.cabal b/haddock-api/haddock-api.cabal index 2ddd97cb..6a3ef944 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 @@ -49,7 +48,7 @@ library , xhtml >= 3000.2 && < 3000.3 , Cabal >= 1.10 , ghc-boot - , ghc >= 8.0 && < 8.2 + , ghc >= 8.3 && < 8.4 , ghc-paths , haddock-library == 1.4.* diff --git a/haddock-api/resources/html/Ocean.std-theme/ocean.css b/haddock-api/resources/html/Ocean.std-theme/ocean.css index 3ebb14de..29af691b 100644 --- a/haddock-api/resources/html/Ocean.std-theme/ocean.css +++ b/haddock-api/resources/html/Ocean.std-theme/ocean.css @@ -88,6 +88,11 @@ pre, code, kbd, samp, tt, .src { font-size: 182%; /* 24pt */ } +#module-header .caption sup { + font-size: 70%; + font-weight: normal; +} + .info { font-size: 85%; /* 11pt */ } @@ -333,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 547e22c2..6af0874a 100644 --- a/haddock-api/src/Haddock.hs +++ b/haddock-api/src/Haddock.hs @@ -68,7 +68,6 @@ import System.Directory (doesDirectoryExist) import GHC hiding (verbosity) import Config import DynFlags hiding (projectVersion, verbosity) -import StaticFlags (discardStaticFlags) import Packages import Panic (handleGhcException) import Module @@ -336,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 @@ -410,18 +409,9 @@ withGhc' libDir flags ghcActs = runGhc (Just libDir) $ do parseGhcFlags dynflags = do -- TODO: handle warnings? - -- NOTA BENE: We _MUST_ discard any static flags here, because we cannot - -- rely on Haddock to parse them, as it only parses the DynFlags. Yet if - -- we pass any, Haddock will fail. Since StaticFlags are global to the - -- GHC invocation, there's also no way to reparse/save them to set them - -- again properly. - -- - -- This is a bit of a hack until we get rid of the rest of the remaining - -- StaticFlags. See GHC issue #8276. - let flags' = discardStaticFlags flags - (dynflags', rest, _) <- parseDynamicFlags dynflags (map noLoc flags') + (dynflags', rest, _) <- parseDynamicFlags dynflags (map noLoc flags) if not (null rest) - then throwE ("Couldn't parse GHC options: " ++ unwords flags') + then throwE ("Couldn't parse GHC options: " ++ unwords flags) else return dynflags' ------------------------------------------------------------------------------- diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs index aff61cfc..b97f0ead 100644 --- a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs +++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs @@ -152,11 +152,11 @@ imports src@(_, imps, _, _) = everything (<|>) ie src ++ mapMaybe (imp . GHC.unLoc) imps where ie term = case cast term of - (Just (GHC.IEVar v)) -> pure $ var v - (Just (GHC.IEThingAbs t)) -> pure $ typ t - (Just (GHC.IEThingAll t)) -> pure $ typ t + (Just (GHC.IEVar v)) -> pure $ var $ GHC.ieLWrappedName v + (Just (GHC.IEThingAbs t)) -> pure $ typ $ GHC.ieLWrappedName t + (Just (GHC.IEThingAll t)) -> pure $ typ $ GHC.ieLWrappedName t (Just (GHC.IEThingWith t _ vs _fls)) -> - [typ t] ++ map var vs + [typ $ GHC.ieLWrappedName t] ++ map (var . GHC.ieLWrappedName) vs _ -> empty typ (GHC.L sspan name) = (sspan, RtkType name) var (GHC.L sspan name) = (sspan, RtkVar name) diff --git a/haddock-api/src/Haddock/Backends/Xhtml.hs b/haddock-api/src/Haddock/Backends/Xhtml.hs index 9fd55e49..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) @@ -256,21 +264,25 @@ ppHtmlContents dflags odir doctitle _maybe_package themes mathjax_url maybe_index_url maybe_source_url maybe_wiki_url ifaces showPkgs prologue debug qual = do let tree = mkModuleTree dflags showPkgs - [(instMod iface, toInstalledDescription iface) | iface <- ifaces] + [(instMod iface, toInstalledDescription iface) + | iface <- ifaces + , not (instIsSig iface)] + sig_tree = mkModuleTree dflags showPkgs + [(instMod iface, toInstalledDescription iface) + | iface <- ifaces + , instIsSig iface] html = headHtml doctitle Nothing themes mathjax_url +++ bodyHtml doctitle Nothing maybe_source_url maybe_wiki_url Nothing maybe_index_url << [ ppPrologue qual doctitle prologue, + ppSignatureTree qual sig_tree, ppModuleTree qual tree ] 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 @@ -278,7 +290,13 @@ ppPrologue qual title (Just doc) = divDescription << (h1 << title +++ docElement thediv (rdrDocToHtml qual doc)) +ppSignatureTree :: Qualification -> [ModuleTree] -> Html +ppSignatureTree qual ts = + divModuleList << (sectionName << "Signatures" +++ mkNodeList qual [] "n" ts) + + ppModuleTree :: Qualification -> [ModuleTree] -> Html +ppModuleTree _ [] = mempty ppModuleTree qual ts = divModuleList << (sectionName << "Modules" +++ mkNodeList qual [] "n" ts) @@ -321,39 +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 - 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 @@ -498,13 +483,20 @@ ppHtmlModule odir doctitle themes mdl = ifaceMod iface aliases = ifaceModuleAliases iface mdl_str = moduleString mdl + mdl_str_annot = mdl_str ++ if ifaceIsSig iface + then " (signature)" + else "" + mdl_str_linked = mdl_str +++ + " (signature" +++ + sup << ("[" +++ anchor ! [href signatureDocURL] << "?" +++ "]" ) +++ + ")" real_qual = makeModuleQual qual aliases mdl html = - headHtml mdl_str (Just $ "mini_" ++ moduleHtmlFile mdl) themes maybe_mathjax_url +++ + headHtml mdl_str_annot (Just $ "mini_" ++ moduleHtmlFile mdl) themes maybe_mathjax_url +++ bodyHtml doctitle (Just iface) maybe_source_url maybe_wiki_url maybe_contents_url maybe_index_url << [ - divModuleHeader << (moduleInfo iface +++ (sectionName << mdl_str)), + divModuleHeader << (moduleInfo iface +++ (sectionName << mdl_str_linked)), ifaceToHtml maybe_source_url maybe_wiki_url iface unicode real_qual ] @@ -512,6 +504,9 @@ ppHtmlModule odir doctitle themes writeFile (joinPath [odir, moduleHtmlFile mdl]) (renderToString debug html) ppHtmlModuleMiniSynopsis odir doctitle themes maybe_mathjax_url iface unicode real_qual debug +signatureDocURL :: String +signatureDocURL = "https://wiki.haskell.org/Module_signature" + ppHtmlModuleMiniSynopsis :: FilePath -> String -> Themes -> Maybe String -> Interface -> Bool -> Qualification -> Bool -> IO () ppHtmlModuleMiniSynopsis odir _doctitle themes maybe_mathjax_url iface unicode qual debug = do @@ -684,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 87a273b2..01261477 100644 --- a/haddock-api/src/Haddock/Convert.hs +++ b/haddock-api/src/Haddock/Convert.hs @@ -1,3 +1,4 @@ + {-# LANGUAGE CPP, PatternGuards #-} ----------------------------------------------------------------------------- -- | @@ -34,10 +35,10 @@ import TcType ( tcSplitSigmaTy ) import TyCon import Type import TyCoRep -import TysPrim ( alphaTyVars, unliftedTypeKindTyConName ) +import TysPrim ( alphaTyVars ) import TysWiredIn ( listTyConName, starKindTyConName, unitTy ) import PrelNames ( hasKey, eqTyConKey, ipClassKey - , tYPETyConKey, ptrRepLiftedDataConKey, ptrRepUnliftedDataConKey ) + , tYPETyConKey, liftedRepDataConKey ) import Unique ( getUnique ) import Util ( filterByList, filterOut ) import Var @@ -114,7 +115,8 @@ synifyAxBranch tc (CoAxBranch { cab_tvs = tkvs, cab_lhs = args, cab_rhs = rhs }) hs_rhs = synifyType WithinType rhs in TyFamEqn { tfe_tycon = name , tfe_pats = HsIB { hsib_body = typats - , hsib_vars = map tyVarName tkvs } + , hsib_vars = map tyVarName tkvs + , hsib_closed = True } , tfe_fixity = Prefix , tfe_rhs = hs_rhs } @@ -300,7 +302,7 @@ synifyDataCon use_gadt_syntax dc = (False,True) -> case linear_tys of [a,b] -> return $ InfixCon a b _ -> Left "synifyDataCon: infix with non-2 args?" - gadt_ty = HsIB [] (synifyType WithinType res_ty) + gadt_ty = HsIB [] (synifyType WithinType res_ty) False -- finally we get synifyDataCon's result! in hs_arg_tys >>= \hat -> @@ -378,12 +380,8 @@ synifyType _ (TyConApp tc tys) -- Use */# instead of TYPE 'Lifted/TYPE 'Unlifted (#473) | tc `hasKey` tYPETyConKey , [TyConApp lev []] <- tys - , lev `hasKey` ptrRepLiftedDataConKey + , lev `hasKey` liftedRepDataConKey = noLoc (HsTyVar NotPromoted (noLoc starKindTyConName)) - | tc `hasKey` tYPETyConKey - , [TyConApp lev []] <- tys - , lev `hasKey` ptrRepUnliftedDataConKey - = noLoc (HsTyVar NotPromoted (noLoc unliftedTypeKindTyConName)) -- Use non-prefix tuple syntax where possible, because it looks nicer. | Just sort <- tyConTuple_maybe tc , tyConArity tc == length tys diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs index 4e1a9b3a..e594feae 100644 --- a/haddock-api/src/Haddock/Interface/Create.hs +++ b/haddock-api/src/Haddock/Interface/Create.hs @@ -11,6 +11,10 @@ -- Maintainer : haddock@projects.haskell.org -- Stability : experimental -- Portability : portable +-- +-- This module provides a single function 'createInterface', +-- which creates a Haddock 'Interface' from the typechecking +-- results 'TypecheckedModule' from GHC. ----------------------------------------------------------------------------- module Haddock.Interface.Create (createInterface) where @@ -36,7 +40,6 @@ import Control.Arrow (second) import Control.DeepSeq import Control.Monad import Data.Function (on) -import qualified Data.Foldable as F import qualified Packages import qualified Module @@ -50,12 +53,16 @@ import TcRnTypes import FastString (concatFS) import BasicTypes ( StringLiteral(..), SourceText(..) ) import qualified Outputable as O -import HsDecls ( gadtDeclDetails,getConDetails ) +import HsDecls ( getConDetails ) -- | Use a 'TypecheckedModule' to produce an 'Interface'. -- To do this, we need access to already processed modules in the topological -- sort. That's what's in the 'IfaceMap'. -createInterface :: TypecheckedModule -> [Flag] -> IfaceMap -> InstIfaceMap -> ErrMsgGhc Interface +createInterface :: TypecheckedModule + -> [Flag] -- Boolean flags + -> IfaceMap -- Locally processed modules + -> InstIfaceMap -- External, already installed interfaces + -> ErrMsgGhc Interface createInterface tm flags modMap instIfaceMap = do let ms = pm_mod_summary . tm_parsed_module $ tm @@ -63,6 +70,8 @@ createInterface tm flags modMap instIfaceMap = do L _ hsm = parsedSource tm !safety = modInfoSafe mi mdl = ms_mod ms + sem_mdl = tcg_semantic_mod (fst (tm_internals_ tm)) + is_sig = ms_hsc_src ms == HsigFile dflags = ms_hspp_opts ms !instances = modInfoInstances mi !fam_instances = md_fam_insts md @@ -84,13 +93,15 @@ createInterface tm flags modMap instIfaceMap = do | Flag_IgnoreAllExports `elem` flags = OptIgnoreExports : opts0 | otherwise = opts0 + -- Process the top-level module header documentation. (!info, mbDoc) <- liftErrMsg $ processModuleHeader dflags gre safety mayDocHeader let declsWithDocs = topDecls group_ fixMap = mkFixMap group_ (decls, _) = unzip declsWithDocs - localInsts = filter (nameIsLocalOrFrom mdl) $ map getName instances - ++ map getName fam_instances + localInsts = filter (nameIsLocalOrFrom sem_mdl) + $ map getName instances + ++ map getName fam_instances -- Locations of all TH splices splices = [ l | L l (SpliceD _) <- hsmodDecls hsm ] @@ -105,7 +116,9 @@ createInterface tm flags modMap instIfaceMap = do let allWarnings = M.unions (warningMap : map ifaceWarningMap (M.elems modMap)) - exportItems <- mkExportItems modMap mdl allWarnings gre exportedNames decls + -- The MAIN functionality: compute the export items which will + -- each be the actual documentation of this module. + exportItems <- mkExportItems is_sig modMap mdl sem_mdl allWarnings gre exportedNames decls maps fixMap splices exports instIfaceMap dflags let !visibleNames = mkVisibleNames maps exportItems opts @@ -131,6 +144,7 @@ createInterface tm flags modMap instIfaceMap = do return $! Interface { ifaceMod = mdl + , ifaceIsSig = is_sig , ifaceOrigFilename = msHsFilePath ms , ifaceInfo = info , ifaceDoc = Documentation mbDoc modWarn @@ -157,6 +171,10 @@ createInterface tm flags modMap instIfaceMap = do , ifaceTokenizedSrc = tokenizedSrc } +-- | Given all of the @import M as N@ declarations in a package, +-- create a mapping from the module identity of M, to an alias N +-- (if there are multiple aliases, we pick the last one.) This +-- will go in 'ifaceModuleAliases'. mkAliasMap :: DynFlags -> Maybe RenamedSource -> M.Map Module ModuleName mkAliasMap dflags mRenamedSource = case mRenamedSource of @@ -167,13 +185,28 @@ mkAliasMap dflags mRenamedSource = SrcLoc.L _ alias <- ideclAs impDecl return $ (lookupModuleDyn dflags + -- TODO: This is supremely dodgy, because in general the + -- UnitId isn't going to look anything like the package + -- qualifier (even with old versions of GHC, the + -- IPID would be p-0.1, but a package qualifier never + -- has a version number it. (Is it possible that in + -- Haddock-land, the UnitIds never have version numbers? + -- I, ezyang, have not quite understand Haddock's package + -- identifier model.) + -- + -- Additionally, this is simulating some logic GHC already + -- has for deciding how to qualify names when it outputs + -- them to the user. We should reuse that information; + -- or at least reuse the renamed imports, which know what + -- they import! (fmap Module.fsToUnitId $ fmap sl_fs $ ideclPkgQual impDecl) (case ideclName impDecl of SrcLoc.L _ name -> name), alias)) impDecls --- similar to GHC.lookupModule +-- Similar to GHC.lookupModule +-- ezyang: Not really... lookupModuleDyn :: DynFlags -> Maybe UnitId -> ModuleName -> Module lookupModuleDyn _ (Just pkgId) mdlName = @@ -323,6 +356,8 @@ mkMaps dflags gre instances decls = -- | Get all subordinate declarations inside a declaration, and their docs. +-- A subordinate declaration is something like the associate type or data +-- family of a type class. subordinates :: InstMap -> HsDecl Name -> [(Name, [HsDocString], Map Int HsDocString)] subordinates instMap decl = case decl of InstD (ClsInstD d) -> do @@ -491,12 +526,14 @@ collectDocs = go Nothing [] -- We create the export items even if the module is hidden, since they -- might be useful when creating the export items for other modules. mkExportItems - :: IfaceMap + :: Bool -- is it a signature + -> IfaceMap -> Module -- this module + -> Module -- semantic module -> WarningMap -> GlobalRdrEnv -> [Name] -- exported names (orig) - -> [LHsDecl Name] + -> [LHsDecl Name] -- renamed source declarations -> Maps -> FixMap -> [SrcSpan] -- splice locations @@ -505,17 +542,22 @@ mkExportItems -> DynFlags -> ErrMsgGhc [ExportItem Name] mkExportItems - modMap thisMod warnings gre exportedNames decls + is_sig modMap thisMod semMod warnings gre exportedNames decls maps@(docMap, argMap, subMap, declMap, instMap) fixMap splices optExports instIfaceMap dflags = case optExports of Nothing -> fullModuleContents dflags warnings gre maps fixMap splices decls Just exports -> liftM concat $ mapM lookupExport exports where - lookupExport (IEVar (L _ x)) = declWith x - lookupExport (IEThingAbs (L _ t)) = declWith t - lookupExport (IEThingAll (L _ t)) = declWith t - lookupExport (IEThingWith (L _ t) _ _ _) = declWith t + lookupExport (IEVar (L _ x)) = declWith $ ieWrappedName x + lookupExport (IEThingAbs (L _ t)) = declWith $ ieWrappedName t + lookupExport (IEThingAll (L _ t)) = declWith $ ieWrappedName t + lookupExport (IEThingWith (L _ t) _ _ _) = declWith $ ieWrappedName t lookupExport (IEModuleContents (L _ m)) = + -- TODO: We could get more accurate reporting here if IEModuleContents + -- also recorded the actual names that are exported here. We CAN + -- compute this info using @gre@ but 'moduleExports does not seem to + -- do so. + -- NB: Pass in identity module, so we can look it up in index correctly moduleExports thisMod m dflags warnings gre exportedNames decls modMap instIfaceMap maps fixMap splices lookupExport (IEGroup lev docStr) = return $ return . ExportGroup lev "" $ processDocString dflags gre docStr @@ -529,8 +571,9 @@ mkExportItems Just doc -> return . ExportDoc $ processDocStringParas dflags gre doc declWith :: Name -> ErrMsgGhc [ ExportItem Name ] - declWith t = - case findDecl t of + declWith t = do + r <- findDecl t + case r of ([L l (ValD _)], (doc, _)) -> do -- Top-level binding without type signature export <- hiValExportItem dflags t l doc (l `elem` splices) $ M.lookup t fixMap @@ -583,6 +626,8 @@ mkExportItems Just decl -> -- We try to get the subs and docs -- from the installed .haddock file for that package. + -- TODO: This needs to be more sophisticated to deal + -- with signature inheritance case M.lookup (nameModule t) instIfaceMap of Nothing -> do liftErrMsg $ tell @@ -598,8 +643,7 @@ mkExportItems mkExportDecl :: Name -> LHsDecl Name -> (DocForDecl Name, [(Name, DocForDecl Name)]) -> ExportItem Name mkExportDecl name decl (doc, subs) = decl' where - decl' = ExportDecl (restrictTo sub_names (extractDecl name mdl decl)) doc subs' [] fixities False - mdl = nameModule name + decl' = ExportDecl (restrictTo sub_names (extractDecl name decl)) doc subs' [] fixities False subs' = filter (isExported . fst) subs sub_names = map fst subs' fixities = [ (n, f) | n <- name:sub_names, Just f <- [M.lookup n fixMap] ] @@ -608,16 +652,41 @@ mkExportItems isExported = (`elem` exportedNames) - findDecl :: Name -> ([LHsDecl Name], (DocForDecl Name, [(Name, DocForDecl Name)])) + findDecl :: Name -> ErrMsgGhc ([LHsDecl Name], (DocForDecl Name, [(Name, DocForDecl Name)])) findDecl n - | m == thisMod, Just ds <- M.lookup n declMap = - (ds, lookupDocs n warnings docMap argMap subMap) - | Just iface <- M.lookup m modMap, Just ds <- M.lookup n (ifaceDeclMap iface) = - (ds, lookupDocs n warnings (ifaceDocMap iface) (ifaceArgMap iface) (ifaceSubMap iface)) - | otherwise = ([], (noDocForDecl, [])) + | m == semMod = + case M.lookup n declMap of + Just ds -> return (ds, lookupDocs n warnings docMap argMap subMap) + Nothing + | is_sig -> do + -- OK, so it wasn't in the local declaration map. It could + -- have been inherited from a signature. Reconstitute it + -- from the type. + mb_r <- hiDecl dflags n + case mb_r of + Nothing -> return ([], (noDocForDecl, [])) + -- TODO: If we try harder, we might be able to find + -- a Haddock! Look in the Haddocks for each thing in + -- requirementContext (pkgState) + Just decl -> return ([decl], (noDocForDecl, [])) + | otherwise -> + return ([], (noDocForDecl, [])) + | Just iface <- M.lookup (semToIdMod (moduleUnitId thisMod) m) modMap + , Just ds <- M.lookup n (ifaceDeclMap iface) = + return (ds, lookupDocs n warnings + (ifaceDocMap iface) + (ifaceArgMap iface) + (ifaceSubMap iface)) + | otherwise = return ([], (noDocForDecl, [])) where m = nameModule n +-- | Given a 'Module' from a 'Name', convert it into a 'Module' that +-- we can actually find in the 'IfaceMap'. +semToIdMod :: UnitId -> Module -> Module +semToIdMod this_uid m + | Module.isHoleModule m = mkModule this_uid (moduleName m) + | otherwise = m hiDecl :: DynFlags -> Name -> ErrMsgGhc (Maybe (LHsDecl Name)) hiDecl dflags t = do @@ -680,13 +749,13 @@ lookupDocs n warnings docMap argMap subMap = -- only return those that are. -- 3) B is visible and all its exports are in scope, in which case we return -- a single 'ExportModule' item. -moduleExports :: Module -- ^ Module A +moduleExports :: Module -- ^ Module A (identity, NOT semantic) -> ModuleName -- ^ The real name of B, the exported module -> DynFlags -- ^ The flags used when typechecking A -> WarningMap -> GlobalRdrEnv -- ^ The renaming environment used for A -> [Name] -- ^ All the exports of A - -> [LHsDecl Name] -- ^ All the declarations in A + -> [LHsDecl Name] -- ^ All the renamed declarations in A -> IfaceMap -- ^ Already created interfaces -> InstIfaceMap -- ^ Interfaces in other packages -> Maps @@ -694,8 +763,11 @@ moduleExports :: Module -- ^ Module A -> [SrcSpan] -- ^ Locations of all TH splices -> ErrMsgGhc [ExportItem Name] -- ^ Resulting export items moduleExports thisMod expMod dflags warnings gre _exports decls ifaceMap instIfaceMap maps fixMap splices - | m == thisMod = fullModuleContents dflags warnings gre maps fixMap splices decls + | expMod == moduleName thisMod + = fullModuleContents dflags warnings gre maps fixMap splices decls | otherwise = + -- NB: we constructed the identity module when looking up in + -- the IfaceMap. case M.lookup m ifaceMap of Just iface | OptHide `elem` ifaceOptions iface -> return (ifaceExportItems iface) @@ -711,7 +783,7 @@ moduleExports thisMod expMod dflags warnings gre _exports decls ifaceMap instIfa "documentation for exported module: " ++ pretty dflags expMod] return [] where - m = mkModule unitId expMod + m = mkModule unitId expMod -- Identity module! unitId = moduleUnitId thisMod @@ -732,8 +804,17 @@ moduleExports thisMod expMod dflags warnings gre _exports decls ifaceMap instIfa -- (For more information, see Trac #69) -fullModuleContents :: DynFlags -> WarningMap -> GlobalRdrEnv -> Maps -> FixMap -> [SrcSpan] - -> [LHsDecl Name] -> ErrMsgGhc [ExportItem Name] +-- | Simplified variant of 'mkExportItems', where we can assume that +-- every locally defined declaration is exported; thus, we just +-- zip through the renamed declarations. +fullModuleContents :: DynFlags + -> WarningMap + -> GlobalRdrEnv -- ^ The renaming environment + -> Maps + -> FixMap + -> [SrcSpan] -- ^ Locations of all TH splices + -> [LHsDecl Name] -- ^ All the renamed declarations + -> ErrMsgGhc [ExportItem Name] fullModuleContents dflags warnings gre (docMap, argMap, subMap, declMap, instMap) fixMap splices decls = liftM catMaybes $ mapM mkExportItem (expandSig decls) where @@ -790,26 +871,34 @@ fullModuleContents dflags warnings gre (docMap, argMap, subMap, declMap, instMap -- it might be an individual record selector or a class method. In these -- cases we have to extract the required declaration (and somehow cobble -- together a type signature for it...). -extractDecl :: Name -> Module -> LHsDecl Name -> LHsDecl Name -extractDecl name mdl decl +extractDecl :: Name -> LHsDecl Name -> LHsDecl Name +extractDecl name decl | name `elem` getMainDeclBinder (unLoc decl) = 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 mdl n tyvar_tys (dd_cons (tcdDataDefn d)) + in SigD <$> extractRecSel name n tyvar_tys (dd_cons (tcdDataDefn d)) InstD (DataFamInstD DataFamInstDecl { dfid_tycon = L _ n , dfid_pats = HsIB { hsib_body = tys } , dfid_defn = defn }) -> - SigD <$> extractRecSel name mdl n tys (dd_cons defn) + SigD <$> extractRecSel name n tys (dd_cons defn) InstD (ClsInstD ClsInstDecl { cid_datafam_insts = insts }) -> let matches = [ d | L _ d <- insts -- , L _ ConDecl { con_details = RecCon rec } <- dd_cons (dfid_defn d) @@ -819,25 +908,25 @@ extractDecl name mdl decl , selectorFieldOcc n == name ] in case matches of - [d0] -> extractDecl name mdl (noLoc . InstD $ DataFamInstD d0) + [d0] -> extractDecl name (noLoc . InstD $ DataFamInstD d0) _ -> error "internal: extractDecl (ClsInstD)" _ -> error "internal: extractDecl" -extractRecSel :: Name -> Module -> Name -> [LHsType Name] -> [LConDecl Name] +extractRecSel :: Name -> Name -> [LHsType Name] -> [LConDecl Name] -> LSig Name -extractRecSel _ _ _ _ [] = error "extractRecSel: selector not found" +extractRecSel _ _ _ [] = error "extractRecSel: selector not found" -extractRecSel nm mdl t tvs (L _ con : rest) = +extractRecSel nm t tvs (L _ con : rest) = case getConDetails con of RecCon (L _ fields) | ((l,L _ (ConDeclField _nn ty _)) : _) <- matching_fields fields -> L l (TypeSig [noLoc nm] (mkEmptySigWcType (noLoc (HsFunTy data_ty (getBangType ty))))) - _ -> extractRecSel nm mdl t tvs rest + _ -> extractRecSel nm t tvs rest where matching_fields :: [LConDeclField Name] -> [(SrcSpan, LConDeclField Name)] 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/LexParseRn.hs b/haddock-api/src/Haddock/Interface/LexParseRn.hs index 4f6b2c09..608344ad 100644 --- a/haddock-api/src/Haddock/Interface/LexParseRn.hs +++ b/haddock-api/src/Haddock/Interface/LexParseRn.hs @@ -31,6 +31,7 @@ import Haddock.Types import Name import Outputable ( showPpr ) import RdrName +import EnumSet import RnEnv (dataTcOccs) processDocStrings :: DynFlags -> GlobalRdrEnv -> [HsDocString] @@ -67,7 +68,7 @@ processModuleHeader dflags gre safety mayStr = do let flags :: [LangExt.Extension] -- We remove the flags implied by the language setting and we display the language instead - flags = map toEnum (toList $ extensionFlags dflags) \\ languageExtensions (language dflags) + flags = EnumSet.toList (extensionFlags dflags) \\ languageExtensions (language dflags) return (hmi { hmi_safety = Just $ showPpr dflags safety , hmi_language = language dflags , hmi_extensions = flags 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/Interface/Rename.hs b/haddock-api/src/Haddock/Interface/Rename.hs index f88d9f4e..b43860fb 100644 --- a/haddock-api/src/Haddock/Interface/Rename.hs +++ b/haddock-api/src/Haddock/Interface/Rename.hs @@ -577,7 +577,8 @@ renameImplicit :: (in_thing -> RnM out_thing) renameImplicit rn_thing (HsIB { hsib_body = thing }) = do { thing' <- rn_thing thing ; return (HsIB { hsib_body = thing' - , hsib_vars = PlaceHolder }) } + , hsib_vars = PlaceHolder + , hsib_closed = PlaceHolder }) } renameWc :: (in_thing -> RnM out_thing) -> HsWildCardBndrs Name in_thing diff --git a/haddock-api/src/Haddock/InterfaceFile.hs b/haddock-api/src/Haddock/InterfaceFile.hs index 63419102..796a7ce6 100644 --- a/haddock-api/src/Haddock/InterfaceFile.hs +++ b/haddock-api/src/Haddock/InterfaceFile.hs @@ -82,8 +82,8 @@ binaryInterfaceMagic = 0xD0Cface -- (2) set `binaryInterfaceVersionCompatibility` to [binaryInterfaceVersion] -- binaryInterfaceVersion :: Word16 -#if (__GLASGOW_HASKELL__ >= 801) && (__GLASGOW_HASKELL__ < 803) -binaryInterfaceVersion = 28 +#if (__GLASGOW_HASKELL__ >= 803) && (__GLASGOW_HASKELL__ < 805) +binaryInterfaceVersion = 29 binaryInterfaceVersionCompatibility :: [Word16] binaryInterfaceVersionCompatibility = [binaryInterfaceVersion] @@ -372,9 +372,10 @@ instance Binary InterfaceFile where instance Binary InstalledInterface where - put_ bh (InstalledInterface modu info docMap argMap + put_ bh (InstalledInterface modu is_sig info docMap argMap exps visExps opts subMap fixMap) = do put_ bh modu + put_ bh is_sig put_ bh info put_ bh docMap put_ bh argMap @@ -386,6 +387,7 @@ instance Binary InstalledInterface where get bh = do modu <- get bh + is_sig <- get bh info <- get bh docMap <- get bh argMap <- get bh @@ -395,7 +397,7 @@ instance Binary InstalledInterface where subMap <- get bh fixMap <- get bh - return (InstalledInterface modu info docMap argMap + return (InstalledInterface modu is_sig info docMap argMap exps visExps opts subMap fixMap) diff --git a/haddock-api/src/Haddock/Types.hs b/haddock-api/src/Haddock/Types.hs index 1f446224..e2bbe6f8 100644 --- a/haddock-api/src/Haddock/Types.hs +++ b/haddock-api/src/Haddock/Types.hs @@ -78,6 +78,9 @@ data Interface = Interface -- | The module behind this interface. ifaceMod :: !Module + -- | Is this a signature? + , ifaceIsSig :: !Bool + -- | Original file name of the module. , ifaceOrigFilename :: !FilePath @@ -155,6 +158,9 @@ data InstalledInterface = InstalledInterface -- | The module represented by this interface. instMod :: Module + -- | Is this a signature? + , instIsSig :: Bool + -- | Textual information about the module. , instInfo :: HaddockModInfo Name @@ -184,6 +190,7 @@ data InstalledInterface = InstalledInterface toInstalledIface :: Interface -> InstalledInterface toInstalledIface interface = InstalledInterface { instMod = ifaceMod interface + , instIsSig = ifaceIsSig interface , instInfo = ifaceInfo interface , instDocMap = ifaceDocMap interface , instArgMap = ifaceArgMap interface @@ -451,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" ------------------------------------------------------------------------------- diff --git a/haddock-library/haddock-library.cabal b/haddock-library/haddock-library.cabal index 96992f04..cabfbc67 100644 --- a/haddock-library/haddock-library.cabal +++ b/haddock-library/haddock-library.cabal @@ -1,5 +1,5 @@ name: haddock-library -version: 1.4.1 +version: 1.4.2 synopsis: Library exposing some functionality of Haddock. description: Haddock is a documentation-generation tool for Haskell libraries. These modules expose some functionality of it diff --git a/haddock-library/src/Documentation/Haddock/Parser/Monad.hs b/haddock-library/src/Documentation/Haddock/Parser/Monad.hs index a421c58c..3f7d60f8 100644 --- a/haddock-library/src/Documentation/Haddock/Parser/Monad.hs +++ b/haddock-library/src/Documentation/Haddock/Parser/Monad.hs @@ -42,7 +42,7 @@ import Data.Tuple import Documentation.Haddock.Types (Version) -data ParserState = ParserState { +newtype ParserState = ParserState { parserStateSince :: Maybe Version } deriving (Eq, Show) diff --git a/haddock-test/Setup.lhs b/haddock-test/Setup.lhs new file mode 100755 index 00000000..5bde0de9 --- /dev/null +++ b/haddock-test/Setup.lhs @@ -0,0 +1,3 @@ +#!/usr/bin/env runhaskell +> import Distribution.Simple +> main = defaultMain diff --git a/haddock-test/haddock-test.cabal b/haddock-test/haddock-test.cabal index 2b75ea81..7cb15d7d 100644 --- a/haddock-test/haddock-test.cabal +++ b/haddock-test/haddock-test.cabal @@ -16,7 +16,7 @@ library default-language: Haskell2010 ghc-options: -Wall hs-source-dirs: src - build-depends: base, bytestring, directory, process, filepath, Cabal, xml, xhtml, syb + build-depends: base >= 4.3 && < 4.10, bytestring, directory, process, filepath, Cabal, xml, xhtml, syb exposed-modules: Test.Haddock diff --git a/haddock-test/src/Test/Haddock/Config.hs b/haddock-test/src/Test/Haddock/Config.hs index dea101d8..e1e920f2 100644 --- a/haddock-test/src/Test/Haddock/Config.hs +++ b/haddock-test/src/Test/Haddock/Config.hs @@ -237,7 +237,7 @@ baseDependencies ghcPath = do exitFailure (ifArg:_) -> pure ifArg ifaces pkgIndex name = do - pkg <- join $ snd <$> lookupPackageName pkgIndex (PackageName name) + pkg <- join $ snd <$> lookupPackageName pkgIndex (mkPackageName name) iface <$> haddockInterfaces pkg <*> haddockHTMLs pkg iface file html = "--read-interface=" ++ html ++ "," ++ file diff --git a/haddock.cabal b/haddock.cabal index 7103a459..fa07ec6b 100644 --- a/haddock.cabal +++ b/haddock.cabal @@ -1,5 +1,5 @@ name: haddock -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 @@ -55,8 +55,8 @@ executable haddock array, xhtml >= 3000.2 && < 3000.3, Cabal >= 1.10, - ghc-boot == 8.1, - ghc == 8.1, + ghc-boot == 8.3, + ghc == 8.3, bytestring, transformers @@ -133,14 +133,14 @@ test-suite html-test default-language: Haskell2010 main-is: Main.hs hs-source-dirs: html-test - build-depends: base, filepath, haddock-test + build-depends: base, filepath, haddock-test == 0.0.1 test-suite hypsrc-test type: exitcode-stdio-1.0 default-language: Haskell2010 main-is: Main.hs hs-source-dirs: hypsrc-test - build-depends: base, filepath, haddock-test + build-depends: base, filepath, haddock-test == 0.0.1 ghc-options: -Wall -fwarn-tabs test-suite latex-test @@ -148,14 +148,14 @@ test-suite latex-test default-language: Haskell2010 main-is: Main.hs hs-source-dirs: latex-test - build-depends: base, filepath, haddock-test + build-depends: base, filepath, haddock-test == 0.0.1 test-suite hoogle-test type: exitcode-stdio-1.0 default-language: Haskell2010 main-is: Main.hs hs-source-dirs: hoogle-test - build-depends: base, filepath, haddock-test + build-depends: base, filepath, haddock-test == 0.0.1 source-repository head type: git diff --git a/html-test/ref/Bug280.html b/html-test/ref/Bug280.html new file mode 100644 index 00000000..92eb61b0 --- /dev/null +++ b/html-test/ref/Bug280.html @@ -0,0 +1,81 @@ +<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"> +<html xmlns="http://www.w3.org/1999/xhtml" +><head + ><meta http-equiv="Content-Type" content="text/html; charset=UTF-8" + /><title + >Bug280</title + ><link href="#" rel="stylesheet" type="text/css" title="Ocean" + /><script src="haddock-util.js" type="text/javascript" + ></script + ><script src="https://cdn.mathjax.org/mathjax/latest/MathJax.js?config=TeX-AMS-MML_HTMLorMML" type="text/javascript" + ></script + ><script type="text/javascript" + >//<![CDATA[ +window.onload = function () {pageLoad();setSynopsis("mini_Bug280.html");}; +//]]> +</script + ></head + ><body + ><div id="package-header" + ><ul class="links" id="page-menu" + ><li + ><a href="#" + >Contents</a + ></li + ><li + ><a href="#" + >Index</a + ></li + ></ul + ><p class="caption empty" + > </p + ></div + ><div id="content" + ><div id="module-header" + ><table class="info" + ><tr + ><th valign="top" + >Copyright</th + ><td + >Foo<br + />Bar<br + />Baz</td + ></tr + ><tr + ><th + >Safe Haskell</th + ><td + >Safe</td + ></tr + ></table + ><p class="caption" + >Bug280</p + ></div + ><div id="description" + ><p class="caption" + >Description</p + ><div class="doc" + ><p + >The module description</p + ></div + ></div + ><div id="interface" + ><h1 + >Documentation</h1 + ><div class="top" + ><p class="src" + ><a id="v:x" class="def" + >x</a + > :: [<a href="#" + >Char</a + >] <a href="#" class="selflink" + >#</a + ></p + ></div + ></div + ></div + ><div id="footer" + ></div + ></body + ></html +> diff --git a/html-test/ref/Test.html b/html-test/ref/Test.html index e493af28..a98b2228 100644 --- a/html-test/ref/Test.html +++ b/html-test/ref/Test.html @@ -33,7 +33,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_Test.html"); ><div id="module-header" ><table class="info" ><tr - ><th + ><th valign="top" >Copyright</th ><td >(c) Simon Marlow 2002</td diff --git a/html-test/ref/frames.html b/html-test/ref/frames.html deleted file mode 100644 index e86edb66..00000000 --- a/html-test/ref/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/html-test/ref/haddock-util.js b/html-test/ref/haddock-util.js index fc7743fe..92d07d2a 100644 --- a/html-test/ref/haddock-util.js +++ b/html-test/ref/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/html-test/src/Bug280.hs b/html-test/src/Bug280.hs new file mode 100644 index 00000000..ac27e2e5 --- /dev/null +++ b/html-test/src/Bug280.hs @@ -0,0 +1,11 @@ +{-| +Copyright: Foo, + Bar, + Baz + +The module description +-} +-- The module header can start with newlines. They are not taken into account for the indentation level +module Bug280 where + +x = "" |