Merge remote-tracking branch 'idontgetoutmuch/ghc-head' into ghc-head

4 files changed, 25 insertions, 10 deletions

diff --git a/haddock-api/src/Haddock/Backends/Hoogle.hs b/haddock-api/src/Haddock/Backends/Hoogle.hs
index f3749a85..9a15c7b3 100644
--- a/haddock-api/src/Haddock/Backends/Hoogle.hs
+++ b/haddock-api/src/Haddock/Backends/Hoogle.hs
@@ -311,6 +311,8 @@ markupTag dflags = Markup {
   markupBold                 = box (TagInline "b"),
   markupMonospaced           = box (TagInline "tt"),
   markupPic                  = const $ str " ",
+  markupMathInline           = const $ str "<math>",
+  markupMathDisplay          = const $ str "<math>",
   markupUnorderedList        = box (TagL 'u'),
   markupOrderedList          = box (TagL 'o'),
   markupDefList              = box (TagL 'u') . map (\(a,b) -> TagInline "i" a : Str " " : b),
diff --git a/haddock-api/src/Haddock/Backends/LaTeX.hs b/haddock-api/src/Haddock/Backends/LaTeX.hs
index e3246d7b..b7be7ffb 100644
--- a/haddock-api/src/Haddock/Backends/LaTeX.hs
+++ b/haddock-api/src/Haddock/Backends/LaTeX.hs
@@ -1105,6 +1105,8 @@ parLatexMarkup ppId = Markup {
   markupMonospaced           = \p _ -> tt (p Mono),
   markupUnorderedList        = \p v -> itemizedList (map ($v) p) $$ text "",
   markupPic                  = \p _ -> markupPic p,
+  markupMathInline           = \p _ -> markupMathInline p,
+  markupMathDisplay          = \p _ -> markupMathDisplay p,
   markupOrderedList          = \p v -> enumeratedList (map ($v) p) $$ text "",
   markupDefList              = \l v -> descriptionList (map (\(a,b) -> (a v, b v)) l),
   markupCodeBlock            = \p _ -> quote (verb (p Verb)) $$ text "",
@@ -1137,6 +1139,10 @@ parLatexMarkup ppId = Markup {
 
         beg = text "image: " <> text uri
 
+    markupMathInline mathjax = text "\\(" <> text mathjax <> text "\\)"
+
+    markupMathDisplay mathjax = text "\\[" <> text mathjax <> text "\\]"
+
     markupId ppId_ id v =
       case v of
         Verb  -> theid
diff --git a/haddock-api/src/Haddock/Backends/Xhtml.hs b/haddock-api/src/Haddock/Backends/Xhtml.hs
index 660bbe90..ebd53370 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml.hs
@@ -63,6 +63,7 @@ ppHtml :: DynFlags
        -> FilePath                     -- ^ Destination directory
        -> Maybe (MDoc GHC.RdrName)     -- ^ Prologue text, maybe
        -> Themes                       -- ^ Themes
+       -> Maybe String                 -- ^ The mathjax URL (--mathjax)
        -> SourceURLs                   -- ^ The source URL (--source)
        -> WikiURLs                     -- ^ The wiki URL (--wiki)
        -> Maybe String                 -- ^ The contents URL (--use-contents)
@@ -73,7 +74,7 @@ ppHtml :: DynFlags
        -> IO ()
 
 ppHtml dflags doctitle maybe_package ifaces odir prologue
-        themes maybe_source_url maybe_wiki_url
+        themes maybe_mathjax_url maybe_source_url maybe_wiki_url
         maybe_contents_url maybe_index_url unicode
         qual debug =  do
   let
@@ -82,7 +83,7 @@ ppHtml dflags doctitle maybe_package ifaces odir prologue
 
   when (isNothing maybe_contents_url) $
     ppHtmlContents dflags odir doctitle maybe_package
-        themes maybe_index_url maybe_source_url maybe_wiki_url
+        themes maybe_mathjax_url maybe_index_url maybe_source_url maybe_wiki_url
         (map toInstalledIface visible_ifaces)
         False -- we don't want to display the packages in a single-package contents
         prologue debug (makeContentsQual qual)
@@ -107,13 +108,14 @@ copyHtmlBits odir libdir themes = do
   mapM_ copyLibFile [ jsFile, framesFile ]
 
 
-headHtml :: String -> Maybe String -> Themes -> Html
-headHtml docTitle miniPage themes =
+headHtml :: String -> Maybe String -> Themes -> Maybe String -> Html
+headHtml docTitle miniPage themes mathjax_url =
   header << [
     meta ! [httpequiv "Content-Type", content "text/html; charset=UTF-8"],
     thetitle << docTitle,
     styleSheet themes,
     script ! [src jsFile, thetype "text/javascript"] << noHtml,
+    script ! [src mjUrl, thetype "text/javascript"] << noHtml,
     script ! [thetype "text/javascript"]
         -- NB: Within XHTML, the content of script tags needs to be
         -- a <![CDATA[ section. Will break if the miniPage name could
@@ -124,6 +126,7 @@ headHtml docTitle miniPage themes =
     ]
   where
     setSynopsis = maybe "" (\p -> "setSynopsis(\"" ++ p ++ "\");") miniPage
+    mjUrl = maybe "https://cdn.mathjax.org/mathjax/latest/MathJax.js?config=TeX-AMS-MML_HTMLorMML" id mathjax_url
 
 
 srcButton :: SourceURLs -> Maybe Interface -> Maybe Html
@@ -242,6 +245,7 @@ ppHtmlContents
    -> Maybe String
    -> Themes
    -> Maybe String
+   -> Maybe String
    -> SourceURLs
    -> WikiURLs
    -> [InstalledInterface] -> Bool -> Maybe (MDoc GHC.RdrName)
@@ -249,12 +253,12 @@ ppHtmlContents
    -> Qualification  -- ^ How to qualify names
    -> IO ()
 ppHtmlContents dflags odir doctitle _maybe_package
-  themes maybe_index_url
+  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]
       html =
-        headHtml doctitle Nothing themes +++
+        headHtml doctitle Nothing themes mathjax_url +++
         bodyHtml doctitle Nothing
           maybe_source_url maybe_wiki_url
           Nothing maybe_index_url << [
@@ -343,7 +347,7 @@ ppHtmlContentsFrame :: FilePath -> String -> Themes
 ppHtmlContentsFrame odir doctitle themes ifaces debug = do
   let mods = flatModuleTree ifaces
       html =
-        headHtml doctitle Nothing themes +++
+        headHtml doctitle Nothing themes Nothing +++
         miniBody << divModuleList <<
           (sectionName << "Modules" +++
            ulist << [ li ! [theclass "module"] << m | m <- mods ])
@@ -383,7 +387,7 @@ ppHtmlIndex odir doctitle _maybe_package themes
 
   where
     indexPage showLetters ch items =
-      headHtml (doctitle ++ " (" ++ indexName ch ++ ")") Nothing themes +++
+      headHtml (doctitle ++ " (" ++ indexName ch ++ ")") Nothing themes Nothing +++
       bodyHtml doctitle Nothing
         maybe_source_url maybe_wiki_url
         maybe_contents_url Nothing << [
@@ -495,7 +499,7 @@ ppHtmlModule odir doctitle themes
       mdl_str = moduleString mdl
       real_qual = makeModuleQual qual aliases mdl
       html =
-        headHtml mdl_str (Just $ "mini_" ++ moduleHtmlFile mdl) themes +++
+        headHtml mdl_str (Just $ "mini_" ++ moduleHtmlFile mdl) themes Nothing +++
         bodyHtml doctitle (Just iface)
           maybe_source_url maybe_wiki_url
           maybe_contents_url maybe_index_url << [
@@ -512,7 +516,7 @@ ppHtmlModuleMiniSynopsis :: FilePath -> String -> Themes
 ppHtmlModuleMiniSynopsis odir _doctitle themes iface unicode qual debug = do
   let mdl = ifaceMod iface
       html =
-        headHtml (moduleString mdl) Nothing themes +++
+        headHtml (moduleString mdl) Nothing themes Nothing +++
         miniBody <<
           (divModuleHeader << sectionName << moduleString mdl +++
            miniSynopsis mdl iface unicode qual)
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs b/haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs
index 3fe74a82..e36f9528 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs
@@ -33,6 +33,7 @@ import Data.Maybe (fromMaybe)
 import GHC
 import Name
 
+
 parHtmlMarkup :: Qualification -> Bool
               -> (Bool -> a -> Html) -> DocMarkup a Html
 parHtmlMarkup qual insertAnchors ppId = Markup {
@@ -67,6 +68,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 ++ "\\]"),
   markupProperty             = pre . toHtml,
   markupExample              = examplesToHtml,
   markupHeader               = \(Header l t) -> makeHeader l t