Skip to content
Snippets Groups Projects
Commit e44f4637 authored by Alec Theriault's avatar Alec Theriault
Browse files

Merge branch 'ghc-8.6' into wip/new-ocean

parents 63abb6c1 8a491e43
No related branches found
No related tags found
No related merge requests found
Showing
with 87 additions and 43 deletions
......@@ -83,6 +83,9 @@ script:
# cabal check
- cabal check
# Build documentation
- cabal new-haddock -w ${HC} all
# Build without installed constraints for packages in global-db
- if $UNCONSTRAINED; then rm -f cabal.project.local; echo cabal new-build -w ${HC} --disable-tests --disable-benchmarks all; else echo "Not building without installed constraints"; fi
......
......@@ -268,9 +268,9 @@ render dflags flags sinceQual qual ifaces installedIfaces extSrcMap = do
allIfaces = map toInstalledIface ifaces ++ installedIfaces
allVisibleIfaces = [ i | i <- allIfaces, OptHide `notElem` instOptions i ]
pkgMod = ifaceMod (head ifaces)
pkgKey = moduleUnitId pkgMod
pkgStr = Just (unitIdString pkgKey)
pkgMod = fmap ifaceMod (listToMaybe ifaces)
pkgKey = fmap moduleUnitId pkgMod
pkgStr = fmap unitIdString pkgKey
pkgNameVer = modulePackageInfo dflags flags pkgMod
pkgName = fmap (unpackFS . (\(PackageName n) -> n)) (fst pkgNameVer)
sincePkg = case sinceQual of
......@@ -289,16 +289,22 @@ render dflags flags sinceQual qual ifaces installedIfaces extSrcMap = do
pkgSrcMap = Map.mapKeys moduleUnitId extSrcMap
pkgSrcMap'
| Flag_HyperlinkedSource `elem` flags =
Map.insert pkgKey hypSrcModuleNameUrlFormat pkgSrcMap
| Just srcNameUrl <- srcEntity = Map.insert pkgKey srcNameUrl pkgSrcMap
| Flag_HyperlinkedSource `elem` flags
, Just k <- pkgKey
= Map.insert k hypSrcModuleNameUrlFormat pkgSrcMap
| Just srcNameUrl <- srcEntity
, Just k <- pkgKey
= Map.insert k srcNameUrl pkgSrcMap
| otherwise = pkgSrcMap
-- TODO: Get these from the interface files as with srcMap
pkgSrcLMap'
| Flag_HyperlinkedSource `elem` flags =
Map.singleton pkgKey hypSrcModuleLineUrlFormat
| Just path <- srcLEntity = Map.singleton pkgKey path
| Flag_HyperlinkedSource `elem` flags
, Just k <- pkgKey
= Map.singleton k hypSrcModuleLineUrlFormat
| Just path <- srcLEntity
, Just k <- pkgKey
= Map.singleton k path
| otherwise = Map.empty
sourceUrls' = (srcBase, srcModule', pkgSrcMap', pkgSrcLMap')
......@@ -375,7 +381,8 @@ render dflags flags sinceQual qual ifaces installedIfaces extSrcMap = do
visibleIfaces odir
_ -> putStrLn . unlines $
[ "haddock: Unable to find a package providing module "
++ moduleNameString (moduleName pkgMod) ++ ", skipping Hoogle."
++ maybe "<no-mod>" (moduleNameString . moduleName) pkgMod
++ ", skipping Hoogle."
, ""
, " Perhaps try specifying the desired package explicitly"
++ " using the --package-name"
......
......@@ -243,8 +243,8 @@ ppDocGroup lev doc = sec lev <> braces doc
-- | Given a declaration, extract out the names being declared
declNames :: LHsDecl DocNameI
-> ( LaTeX -- ^ to print before each name in an export list
, [DocName] -- ^ names being declared
-> ( LaTeX -- to print before each name in an export list
, [DocName] -- names being declared
)
declNames (L _ decl) = case decl of
TyClD _ d -> (empty, [tcdName d])
......@@ -444,9 +444,9 @@ ppLPatSig doc docnames ty unicode
-- arguments as needed.
ppTypeOrFunSig :: HsType DocNameI
-> DocForDecl DocName -- ^ documentation
-> ( LaTeX -- ^ first-line (no-argument docs only)
, LaTeX -- ^ first-line (argument docs only)
, LaTeX -- ^ type prefix (argument docs only)
-> ( LaTeX -- first-line (no-argument docs only)
, LaTeX -- first-line (argument docs only)
, LaTeX -- type prefix (argument docs only)
)
-> Bool -- ^ unicode
-> LaTeX
......
......@@ -121,19 +121,26 @@ copyHtmlBits odir libdir themes withQuickjump = do
headHtml :: String -> Themes -> Maybe String -> Html
headHtml docTitle themes mathjax_url =
header << [
meta ! [ httpequiv "Content-Type", content "text/html; charset=UTF-8"],
meta ! [ XHtml.name "viewport", content "width=device-width, initial-scale=1"],
thetitle << docTitle,
styleSheet themes,
thelink ! [ rel "stylesheet", thetype "text/css", href quickJumpCssFile] << noHtml,
thelink ! [ rel "stylesheet", thetype "text/css", href fontUrl] << noHtml,
script ! [src haddockJsFile, emptyAttr "async", thetype "text/javascript"] << noHtml,
script ! [src mjUrl, thetype "text/javascript"] << noHtml
header <<
[ meta ! [ httpequiv "Content-Type", content "text/html; charset=UTF-8"]
, meta ! [ XHtml.name "viewport", content "width=device-width, initial-scale=1"]
, thetitle << docTitle
, styleSheet themes
, thelink ! [ rel "stylesheet", thetype "text/css", href quickJumpCssFile] << noHtml
, thelink ! [ rel "stylesheet", thetype "text/css", href fontUrl] << noHtml
, script ! [src haddockJsFile, emptyAttr "async", thetype "text/javascript"] << noHtml
, script ! [thetype "text/x-mathjax-config"] << primHtml mjConf
, script ! [src mjUrl, thetype "text/javascript"] << noHtml
]
where
fontUrl = "https://fonts.googleapis.com/css?family=PT+Sans:400,400i,700"
mjUrl = fromMaybe "https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.0/MathJax.js?config=TeX-AMS-MML_HTMLorMML" mathjax_url
mjUrl = fromMaybe "https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.5/MathJax.js?config=TeX-AMS-MML_HTMLorMML" mathjax_url
mjConf = unwords [ "MathJax.Hub.Config({"
, "tex2jax: {"
, "processClass: \"mathjax\","
, "ignoreClass: \".*\""
, "}"
, "});" ]
srcButton :: SourceURLs -> Maybe Interface -> Maybe Html
srcButton (Just src_base_url, _, _, _) Nothing =
......
......@@ -69,8 +69,8 @@ parHtmlMarkup qual insertAnchors ppId = Markup {
then namedAnchor aname << ""
else noHtml,
markupPic = \(Picture uri t) -> image ! ([src uri] ++ fromMaybe [] (return . title <$> t)),
markupMathInline = \mathjax -> toHtml ("\\(" ++ mathjax ++ "\\)"),
markupMathDisplay = \mathjax -> toHtml ("\\[" ++ mathjax ++ "\\]"),
markupMathInline = \mathjax -> thespan ! [theclass "mathjax"] << toHtml ("\\(" ++ mathjax ++ "\\)"),
markupMathDisplay = \mathjax -> thespan ! [theclass "mathjax"] << toHtml ("\\[" ++ mathjax ++ "\\]"),
markupProperty = pre . toHtml,
markupExample = examplesToHtml,
markupHeader = \(Header l t) -> makeHeader l t,
......
......@@ -85,7 +85,7 @@ createInterface tm flags modMap instIfaceMap = do
!instances = modInfoInstances mi
!fam_instances = md_fam_insts md
!exportedNames = modInfoExportsWithSelectors mi
(pkgNameFS, _) = modulePackageInfo dflags flags mdl
(pkgNameFS, _) = modulePackageInfo dflags flags (Just mdl)
pkgName = fmap (unpackFS . (\(PackageName n) -> n)) pkgNameFS
(TcGblEnv { tcg_rdr_env = gre
......
......@@ -371,9 +371,10 @@ modulePackageInfo :: DynFlags
-> [Flag] -- ^ Haddock flags are checked as they may contain
-- the package name or version provided by the user
-- which we prioritise
-> Module
-> Maybe Module
-> (Maybe PackageName, Maybe Data.Version.Version)
modulePackageInfo dflags flags modu =
modulePackageInfo _dflags _flags Nothing = (Nothing, Nothing)
modulePackageInfo dflags flags (Just modu) =
( optPackageName flags <|> fmap packageName pkgDb
, optPackageVersion flags <|> fmap packageVersion pkgDb
)
......
......@@ -9,7 +9,9 @@
/><link rel="stylesheet" type="text/css" href="#"
/><script src="haddock-bundle.min.js" async="async" type="text/javascript"
></script
><script src="https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.0/MathJax.js?config=TeX-AMS-MML_HTMLorMML" type="text/javascript"
><script type="text/x-mathjax-config"
>MathJax.Hub.Config({ tex2jax: { processClass: &quot;mathjax&quot;, ignoreClass: &quot;.*&quot; } });</script
><script src="https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.5/MathJax.js?config=TeX-AMS-MML_HTMLorMML" type="text/javascript"
></script
></head
><body
......
......@@ -9,7 +9,9 @@
/><link rel="stylesheet" type="text/css" href="#"
/><script src="haddock-bundle.min.js" async="async" type="text/javascript"
></script
><script src="https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.0/MathJax.js?config=TeX-AMS-MML_HTMLorMML" type="text/javascript"
><script type="text/x-mathjax-config"
>MathJax.Hub.Config({ tex2jax: { processClass: &quot;mathjax&quot;, ignoreClass: &quot;.*&quot; } });</script
><script src="https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.5/MathJax.js?config=TeX-AMS-MML_HTMLorMML" type="text/javascript"
></script
></head
><body
......
......@@ -9,7 +9,9 @@
/><link rel="stylesheet" type="text/css" href="#"
/><script src="haddock-bundle.min.js" async="async" type="text/javascript"
></script
><script src="https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.0/MathJax.js?config=TeX-AMS-MML_HTMLorMML" type="text/javascript"
><script type="text/x-mathjax-config"
>MathJax.Hub.Config({ tex2jax: { processClass: &quot;mathjax&quot;, ignoreClass: &quot;.*&quot; } });</script
><script src="https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.5/MathJax.js?config=TeX-AMS-MML_HTMLorMML" type="text/javascript"
></script
></head
><body
......
......@@ -9,7 +9,9 @@
/><link rel="stylesheet" type="text/css" href="#"
/><script src="haddock-bundle.min.js" async="async" type="text/javascript"
></script
><script src="https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.0/MathJax.js?config=TeX-AMS-MML_HTMLorMML" type="text/javascript"
><script type="text/x-mathjax-config"
>MathJax.Hub.Config({ tex2jax: { processClass: &quot;mathjax&quot;, ignoreClass: &quot;.*&quot; } });</script
><script src="https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.5/MathJax.js?config=TeX-AMS-MML_HTMLorMML" type="text/javascript"
></script
></head
><body
......
......@@ -9,7 +9,9 @@
/><link rel="stylesheet" type="text/css" href="#"
/><script src="haddock-bundle.min.js" async="async" type="text/javascript"
></script
><script src="https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.0/MathJax.js?config=TeX-AMS-MML_HTMLorMML" type="text/javascript"
><script type="text/x-mathjax-config"
>MathJax.Hub.Config({ tex2jax: { processClass: &quot;mathjax&quot;, ignoreClass: &quot;.*&quot; } });</script
><script src="https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.5/MathJax.js?config=TeX-AMS-MML_HTMLorMML" type="text/javascript"
></script
></head
><body
......
......@@ -9,7 +9,9 @@
/><link rel="stylesheet" type="text/css" href="#"
/><script src="haddock-bundle.min.js" async="async" type="text/javascript"
></script
><script src="https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.0/MathJax.js?config=TeX-AMS-MML_HTMLorMML" type="text/javascript"
><script type="text/x-mathjax-config"
>MathJax.Hub.Config({ tex2jax: { processClass: &quot;mathjax&quot;, ignoreClass: &quot;.*&quot; } });</script
><script src="https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.5/MathJax.js?config=TeX-AMS-MML_HTMLorMML" type="text/javascript"
></script
></head
><body
......
......@@ -9,7 +9,9 @@
/><link rel="stylesheet" type="text/css" href="#"
/><script src="haddock-bundle.min.js" async="async" type="text/javascript"
></script
><script src="https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.0/MathJax.js?config=TeX-AMS-MML_HTMLorMML" type="text/javascript"
><script type="text/x-mathjax-config"
>MathJax.Hub.Config({ tex2jax: { processClass: &quot;mathjax&quot;, ignoreClass: &quot;.*&quot; } });</script
><script src="https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.5/MathJax.js?config=TeX-AMS-MML_HTMLorMML" type="text/javascript"
></script
></head
><body
......
......@@ -9,7 +9,9 @@
/><link rel="stylesheet" type="text/css" href="#"
/><script src="haddock-bundle.min.js" async="async" type="text/javascript"
></script
><script src="https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.0/MathJax.js?config=TeX-AMS-MML_HTMLorMML" type="text/javascript"
><script type="text/x-mathjax-config"
>MathJax.Hub.Config({ tex2jax: { processClass: &quot;mathjax&quot;, ignoreClass: &quot;.*&quot; } });</script
><script src="https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.5/MathJax.js?config=TeX-AMS-MML_HTMLorMML" type="text/javascript"
></script
></head
><body
......
......@@ -9,7 +9,9 @@
/><link rel="stylesheet" type="text/css" href="#"
/><script src="haddock-bundle.min.js" async="async" type="text/javascript"
></script
><script src="https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.0/MathJax.js?config=TeX-AMS-MML_HTMLorMML" type="text/javascript"
><script type="text/x-mathjax-config"
>MathJax.Hub.Config({ tex2jax: { processClass: &quot;mathjax&quot;, ignoreClass: &quot;.*&quot; } });</script
><script src="https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.5/MathJax.js?config=TeX-AMS-MML_HTMLorMML" type="text/javascript"
></script
></head
><body
......
......@@ -9,7 +9,9 @@
/><link rel="stylesheet" type="text/css" href="#"
/><script src="haddock-bundle.min.js" async="async" type="text/javascript"
></script
><script src="https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.0/MathJax.js?config=TeX-AMS-MML_HTMLorMML" type="text/javascript"
><script type="text/x-mathjax-config"
>MathJax.Hub.Config({ tex2jax: { processClass: &quot;mathjax&quot;, ignoreClass: &quot;.*&quot; } });</script
><script src="https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.5/MathJax.js?config=TeX-AMS-MML_HTMLorMML" type="text/javascript"
></script
></head
><body
......
......@@ -9,7 +9,9 @@
/><link rel="stylesheet" type="text/css" href="#"
/><script src="haddock-bundle.min.js" async="async" type="text/javascript"
></script
><script src="https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.0/MathJax.js?config=TeX-AMS-MML_HTMLorMML" type="text/javascript"
><script type="text/x-mathjax-config"
>MathJax.Hub.Config({ tex2jax: { processClass: &quot;mathjax&quot;, ignoreClass: &quot;.*&quot; } });</script
><script src="https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.5/MathJax.js?config=TeX-AMS-MML_HTMLorMML" type="text/javascript"
></script
></head
><body
......
......@@ -9,7 +9,9 @@
/><link rel="stylesheet" type="text/css" href="#"
/><script src="haddock-bundle.min.js" async="async" type="text/javascript"
></script
><script src="https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.0/MathJax.js?config=TeX-AMS-MML_HTMLorMML" type="text/javascript"
><script type="text/x-mathjax-config"
>MathJax.Hub.Config({ tex2jax: { processClass: &quot;mathjax&quot;, ignoreClass: &quot;.*&quot; } });</script
><script src="https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.5/MathJax.js?config=TeX-AMS-MML_HTMLorMML" type="text/javascript"
></script
></head
><body
......
......@@ -9,7 +9,9 @@
/><link rel="stylesheet" type="text/css" href="#"
/><script src="haddock-bundle.min.js" async="async" type="text/javascript"
></script
><script src="https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.0/MathJax.js?config=TeX-AMS-MML_HTMLorMML" type="text/javascript"
><script type="text/x-mathjax-config"
>MathJax.Hub.Config({ tex2jax: { processClass: &quot;mathjax&quot;, ignoreClass: &quot;.*&quot; } });</script
><script src="https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.5/MathJax.js?config=TeX-AMS-MML_HTMLorMML" type="text/javascript"
></script
></head
><body
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment