From 2b94a90a23f03a749e3703af330d9585a5de0bae Mon Sep 17 00:00:00 2001
From: Alec Theriault
Date: Fri, 26 Oct 2018 14:22:23 -0700
Subject: Avoid some partiality
AFAICT this wasn't causing any crashes, but that's mostly because
we happen not to be forcing `pkgStr` when it would diverge. We come
dangerously close to doing that in `ppHtmlIndex`.
Fixes #569.
---
haddock-api/src/Haddock.hs | 27 +++++++++++++++++----------
haddock-api/src/Haddock/Interface/Create.hs | 2 +-
haddock-api/src/Haddock/Options.hs | 5 +++--
3 files changed, 21 insertions(+), 13 deletions(-)
diff --git a/haddock-api/src/Haddock.hs b/haddock-api/src/Haddock.hs
index dbfba0f4..7a2df3a2 100644
--- a/haddock-api/src/Haddock.hs
+++ b/haddock-api/src/Haddock.hs
@@ -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 "" (moduleNameString . moduleName) pkgMod
+ ++ ", skipping Hoogle."
, ""
, " Perhaps try specifying the desired package explicitly"
++ " using the --package-name"
diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs
index c4df2090..a4408434 100644
--- a/haddock-api/src/Haddock/Interface/Create.hs
+++ b/haddock-api/src/Haddock/Interface/Create.hs
@@ -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
diff --git a/haddock-api/src/Haddock/Options.hs b/haddock-api/src/Haddock/Options.hs
index b5e987d8..bdc98406 100644
--- a/haddock-api/src/Haddock/Options.hs
+++ b/haddock-api/src/Haddock/Options.hs
@@ -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
)
--
cgit v1.2.3
From 0d9a81e20238a6b72f9f5c005f1f7e9cf05f6fb9 Mon Sep 17 00:00:00 2001
From: Alec Theriault
Date: Sat, 27 Oct 2018 10:05:04 -0700
Subject: Fix documentation in `haddock-api` (#957)
* Fix misplaced Haddocks in Haddock itself
Haddock should be able to generate documentation for 'haddock-api'
again.
* Make CI check that documentation can be built.
* Add back a doc that is OK
---
.travis.yml | 3 +++
haddock-api/src/Haddock/Backends/LaTeX.hs | 10 +++++-----
2 files changed, 8 insertions(+), 5 deletions(-)
diff --git a/.travis.yml b/.travis.yml
index 681399b9..35ee528d 100644
--- a/.travis.yml
+++ b/.travis.yml
@@ -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
diff --git a/haddock-api/src/Haddock/Backends/LaTeX.hs b/haddock-api/src/Haddock/Backends/LaTeX.hs
index 4e0e6eba..613c6deb 100644
--- a/haddock-api/src/Haddock/Backends/LaTeX.hs
+++ b/haddock-api/src/Haddock/Backends/LaTeX.hs
@@ -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
--
cgit v1.2.3
From 8a491e437f1c8379b66a420f8584c1761b45aa7e Mon Sep 17 00:00:00 2001
From: Alec Theriault
Date: Mon, 5 Nov 2018 13:58:11 -0800
Subject: Only run MathJax on entities with "mathjax" class (#960)
Correspondingly, we wrap all inline/diplay math in
... the math ....
This fixes #959.
---
haddock-api/src/Haddock/Backends/Xhtml.hs | 24 ++++++++++++++--------
.../src/Haddock/Backends/Xhtml/DocMarkup.hs | 4 ++--
html-test/ref/A.html | 4 +++-
html-test/ref/Bold.html | 4 +++-
html-test/ref/Bug1.html | 4 +++-
html-test/ref/Bug195.html | 4 +++-
html-test/ref/Bug2.html | 4 +++-
html-test/ref/Bug201.html | 4 +++-
html-test/ref/Bug253.html | 4 +++-
html-test/ref/Bug26.html | 4 +++-
html-test/ref/Bug280.html | 4 +++-
html-test/ref/Bug294.html | 4 +++-
html-test/ref/Bug298.html | 4 +++-
html-test/ref/Bug3.html | 4 +++-
html-test/ref/Bug308.html | 4 +++-
html-test/ref/Bug308CrossModule.html | 4 +++-
html-test/ref/Bug310.html | 4 +++-
html-test/ref/Bug313.html | 4 +++-
html-test/ref/Bug335.html | 4 +++-
html-test/ref/Bug387.html | 4 +++-
html-test/ref/Bug4.html | 4 +++-
html-test/ref/Bug458.html | 4 +++-
html-test/ref/Bug546.html | 4 +++-
html-test/ref/Bug548.html | 4 +++-
html-test/ref/Bug574.html | 4 +++-
html-test/ref/Bug6.html | 4 +++-
html-test/ref/Bug613.html | 4 +++-
html-test/ref/Bug647.html | 4 +++-
html-test/ref/Bug679.html | 4 +++-
html-test/ref/Bug7.html | 4 +++-
html-test/ref/Bug8.html | 4 +++-
html-test/ref/Bug85.html | 4 +++-
html-test/ref/Bug953.html | 4 +++-
html-test/ref/BugDeprecated.html | 4 +++-
html-test/ref/BugExportHeadings.html | 4 +++-
html-test/ref/Bugs.html | 4 +++-
html-test/ref/BundledPatterns.html | 4 +++-
html-test/ref/BundledPatterns2.html | 4 +++-
html-test/ref/ConstructorArgs.html | 4 +++-
html-test/ref/ConstructorPatternExport.html | 4 +++-
html-test/ref/DeprecatedClass.html | 4 +++-
html-test/ref/DeprecatedData.html | 4 +++-
html-test/ref/DeprecatedFunction.html | 4 +++-
html-test/ref/DeprecatedFunction2.html | 4 +++-
html-test/ref/DeprecatedFunction3.html | 4 +++-
html-test/ref/DeprecatedModule.html | 4 +++-
html-test/ref/DeprecatedModule2.html | 4 +++-
html-test/ref/DeprecatedNewtype.html | 4 +++-
html-test/ref/DeprecatedReExport.html | 4 +++-
html-test/ref/DeprecatedRecord.html | 4 +++-
html-test/ref/DeprecatedTypeFamily.html | 4 +++-
html-test/ref/DeprecatedTypeSynonym.html | 4 +++-
html-test/ref/DuplicateRecordFields.html | 4 +++-
html-test/ref/Examples.html | 4 +++-
html-test/ref/Extensions.html | 4 +++-
html-test/ref/FunArgs.html | 4 +++-
html-test/ref/GADTRecords.html | 4 +++-
html-test/ref/GadtConstructorArgs.html | 4 +++-
html-test/ref/Hash.html | 4 +++-
html-test/ref/HiddenInstances.html | 4 +++-
html-test/ref/HiddenInstancesB.html | 4 +++-
html-test/ref/Hyperlinks.html | 4 +++-
html-test/ref/ImplicitParams.html | 4 +++-
html-test/ref/Instances.html | 4 +++-
html-test/ref/Math.html | 22 ++++++++++++++------
html-test/ref/Minimal.html | 4 +++-
html-test/ref/ModuleWithWarning.html | 4 +++-
html-test/ref/NamedDoc.html | 4 +++-
html-test/ref/Nesting.html | 4 +++-
html-test/ref/NoLayout.html | 4 +++-
html-test/ref/NonGreedy.html | 4 +++-
html-test/ref/Operators.html | 4 +++-
html-test/ref/OrphanInstances.html | 4 +++-
html-test/ref/OrphanInstancesClass.html | 4 +++-
html-test/ref/OrphanInstancesType.html | 4 +++-
html-test/ref/PR643.html | 4 +++-
html-test/ref/PR643_1.html | 4 +++-
html-test/ref/PatternSyns.html | 4 +++-
html-test/ref/PromotedTypes.html | 4 +++-
html-test/ref/Properties.html | 4 +++-
html-test/ref/PruneWithWarning.html | 4 +++-
html-test/ref/QuantifiedConstraints.html | 4 +++-
html-test/ref/QuasiExpr.html | 4 +++-
html-test/ref/QuasiQuote.html | 4 +++-
html-test/ref/SpuriousSuperclassConstraints.html | 4 +++-
html-test/ref/TH.html | 4 +++-
html-test/ref/TH2.html | 4 +++-
html-test/ref/Table.html | 10 ++++++---
html-test/ref/Test.html | 4 +++-
html-test/ref/Threaded.html | 4 +++-
html-test/ref/Threaded_TH.html | 4 +++-
html-test/ref/Ticket112.html | 4 +++-
html-test/ref/Ticket61.html | 4 +++-
html-test/ref/Ticket75.html | 4 +++-
html-test/ref/TitledPicture.html | 4 +++-
html-test/ref/TypeFamilies.html | 4 +++-
html-test/ref/TypeFamilies2.html | 4 +++-
html-test/ref/TypeFamilies3.html | 4 +++-
html-test/ref/TypeOperators.html | 4 +++-
html-test/ref/Unicode.html | 4 +++-
html-test/ref/Unicode2.html | 4 +++-
html-test/ref/Visible.html | 4 +++-
102 files changed, 334 insertions(+), 118 deletions(-)
diff --git a/haddock-api/src/Haddock/Backends/Xhtml.hs b/haddock-api/src/Haddock/Backends/Xhtml.hs
index 6da6a2e8..0a11ca08 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml.hs
@@ -120,17 +120,23 @@ 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"],
- thetitle << docTitle,
- styleSheet themes,
- thelink ! [ rel "stylesheet", thetype "text/css", href quickJumpCssFile] << 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"]
+ , thetitle << docTitle
+ , styleSheet themes
+ , thelink ! [ rel "stylesheet", thetype "text/css", href quickJumpCssFile] << 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
- mjUrl = maybe "https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.0/MathJax.js?config=TeX-AMS-MML_HTMLorMML" id mathjax_url
-
+ mjUrl = maybe "https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.5/MathJax.js?config=TeX-AMS-MML_HTMLorMML" id mathjax_url
+ mjConf = unwords [ "MathJax.Hub.Config({"
+ , "tex2jax: {"
+ , "processClass: \"mathjax\","
+ , "ignoreClass: \".*\""
+ , "}"
+ , "});" ]
srcButton :: SourceURLs -> Maybe Interface -> Maybe Html
srcButton (Just src_base_url, _, _, _) Nothing =
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs b/haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs
index ed323a90..38aa7b7e 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs
@@ -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,
diff --git a/html-test/ref/A.html b/html-test/ref/A.html
index e4802966..75fbb9ed 100644
--- a/html-test/ref/A.html
+++ b/html-test/ref/A.html
@@ -7,7 +7,9 @@
/>
normalDensity\[
+ >\[
\int_{-\infty}^{\infty} e^{-x^2/2} = \sqrt{2\pi}
- \]
\(\int_{-\infty}^{\infty} e^{-x^2/2} = \sqrt{2\pi}\)
\(\int_{-\infty}^{\infty} e^{-x^2/2} = \sqrt{2\pi}\)Math (inline) for normalDensity
- \(\int_{-\infty}^{\infty} e^{-x^2/2} = \sqrt{2\pi}\)
- \[\int_{-\infty}^{\infty} e^{-x^2/2} = \sqrt{2\pi}\]\(\int_{-\infty}^{\infty} e^{-x^2/2} = \sqrt{2\pi}\)
+ \[\int_{-\infty}^{\infty} e^{-x^2/2} = \sqrt{2\pi}\]
\[
+ > \[
f(n) = \sum_{i=1}
- \] | |