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} - \]