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

10 files changed, 57 insertions, 14 deletions

diff --git a/haddock-api/src/Haddock.hs b/haddock-api/src/Haddock.hs
index 70cdf8a3..72a6cc92 100644
--- a/haddock-api/src/Haddock.hs
+++ b/haddock-api/src/Haddock.hs
@@ -247,6 +247,7 @@ render dflags flags qual ifaces installedIfaces extSrcMap = do
     odir                 = outputDir         flags
     opt_latex_style      = optLaTeXStyle     flags
     opt_source_css       = optSourceCssFile  flags
+    opt_mathjax          = optMathjax        flags
 
     visibleIfaces    = [ i | i <- ifaces, OptHide `notElem` ifaceOptions i ]
 
@@ -297,7 +298,7 @@ render dflags flags qual ifaces installedIfaces extSrcMap = do
 
   when (Flag_GenContents `elem` flags) $ do
     ppHtmlContents dflags odir title pkgStr
-                   themes opt_index_url sourceUrls' opt_wiki_urls
+                   themes opt_mathjax opt_index_url sourceUrls' opt_wiki_urls
                    allVisibleIfaces True prologue pretty
                    (makeContentsQual qual)
     copyHtmlBits odir libDir themes
@@ -305,7 +306,7 @@ render dflags flags qual ifaces installedIfaces extSrcMap = do
   when (Flag_Html `elem` flags) $ do
     ppHtml dflags title pkgStr visibleIfaces odir
                 prologue
-                themes sourceUrls' opt_wiki_urls
+                themes opt_mathjax sourceUrls' opt_wiki_urls
                 opt_contents_url opt_index_url unicode qual
                 pretty
     copyHtmlBits odir libDir themes
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
diff --git a/haddock-api/src/Haddock/Interface/LexParseRn.hs b/haddock-api/src/Haddock/Interface/LexParseRn.hs
index 3c14498c..4f6b2c09 100644
--- a/haddock-api/src/Haddock/Interface/LexParseRn.hs
+++ b/haddock-api/src/Haddock/Interface/LexParseRn.hs
@@ -132,6 +132,8 @@ rename dflags gre = rn
       DocModule str -> DocModule str
       DocHyperlink l -> DocHyperlink l
       DocPic str -> DocPic str
+      DocMathInline str -> DocMathInline str
+      DocMathDisplay str -> DocMathDisplay str
       DocAName str -> DocAName str
       DocProperty p -> DocProperty p
       DocExamples e -> DocExamples e
diff --git a/haddock-api/src/Haddock/InterfaceFile.hs b/haddock-api/src/Haddock/InterfaceFile.hs
index 423714b8..5d15fb33 100644
--- a/haddock-api/src/Haddock/InterfaceFile.hs
+++ b/haddock-api/src/Haddock/InterfaceFile.hs
@@ -473,7 +473,6 @@ instance (Binary mod, Binary id) => Binary (MetaDoc mod id) where
     d <- get bh
     return $ MetaDoc { _meta = m, _doc = d }
 
-{-* Generated by DrIFT : Look, but Don't Touch. *-}
 instance (Binary mod, Binary id) => Binary (DocH mod id) where
     put_ bh DocEmpty = do
             putByte bh 0
@@ -538,6 +537,12 @@ instance (Binary mod, Binary id) => Binary (DocH mod id) where
     put_ bh (DocHeader aa) = do
             putByte bh 20
             put_ bh aa
+    put_ bh (DocMathInline x) = do
+            putByte bh 21
+            put_ bh x
+    put_ bh (DocMathDisplay x) = do
+            putByte bh 22
+            put_ bh x
 
     get bh = do
             h <- getByte bh
@@ -605,6 +610,12 @@ instance (Binary mod, Binary id) => Binary (DocH mod id) where
               20 -> do
                     aa <- get bh
                     return (DocHeader aa)
+              21 -> do
+                    x <- get bh
+                    return (DocMathInline x)
+              22 -> do
+                    x <- get bh
+                    return (DocMathDisplay x)
               _ -> error "invalid binary data found in the interface file"
 
 
diff --git a/haddock-api/src/Haddock/Options.hs b/haddock-api/src/Haddock/Options.hs
index f84989ef..0449c829 100644
--- a/haddock-api/src/Haddock/Options.hs
+++ b/haddock-api/src/Haddock/Options.hs
@@ -26,6 +26,7 @@ module Haddock.Options (
   wikiUrls,
   optDumpInterfaceFile,
   optLaTeXStyle,
+  optMathjax,
   qualification,
   verbosity,
   ghcFlags,
@@ -69,6 +70,7 @@ data Flag
   | Flag_LaTeXStyle String
   | Flag_HyperlinkedSource
   | Flag_SourceCss String
+  | Flag_Mathjax String
   | Flag_Help
   | Flag_Verbosity String
   | Flag_Version
@@ -116,6 +118,7 @@ options backwardsCompat =
       "output in HTML (XHTML 1.0)",
     Option []  ["latex"]  (NoArg Flag_LaTeX) "use experimental LaTeX rendering",
     Option []  ["latex-style"]  (ReqArg Flag_LaTeXStyle "FILE") "provide your own LaTeX style in FILE",
+    Option []  ["mathjax"]  (ReqArg Flag_Mathjax "URL") "URL FOR mathjax",
     Option ['U'] ["use-unicode"] (NoArg Flag_UseUnicode) "use Unicode in HTML output",
     Option []  ["hoogle"]     (NoArg Flag_Hoogle)
       "output for Hoogle; you may want --package-name and --package-version too",
@@ -272,6 +275,10 @@ optLaTeXStyle :: [Flag] -> Maybe String
 optLaTeXStyle flags = optLast [ str | Flag_LaTeXStyle str <- flags ]
 
 
+optMathjax :: [Flag] -> Maybe String
+optMathjax flags = optLast [ str | Flag_Mathjax str <- flags ]
+
+
 qualification :: [Flag] -> Either String QualOption
 qualification flags =
   case map (map Char.toLower) [ str | Flag_Qualification str <- flags ] of
diff --git a/haddock-api/src/Haddock/Types.hs b/haddock-api/src/Haddock/Types.hs
index 34e99a8a..3a4df70c 100644
--- a/haddock-api/src/Haddock/Types.hs
+++ b/haddock-api/src/Haddock/Types.hs
@@ -445,6 +445,8 @@ instance (NFData a, NFData mod)
     DocCodeBlock a            -> a `deepseq` ()
     DocHyperlink a            -> a `deepseq` ()
     DocPic a                  -> a `deepseq` ()
+    DocMathInline a           -> a `deepseq` ()
+    DocMathDisplay a          -> a `deepseq` ()
     DocAName a                -> a `deepseq` ()
     DocProperty a             -> a `deepseq` ()
     DocExamples a             -> a `deepseq` ()
@@ -492,6 +494,8 @@ data DocMarkup id a = Markup
   , markupHyperlink            :: Hyperlink -> a
   , markupAName                :: String -> a
   , markupPic                  :: Picture -> a
+  , markupMathInline           :: String -> a
+  , markupMathDisplay          :: String -> a
   , markupProperty             :: String -> a
   , markupExample              :: [Example] -> a
   , markupHeader               :: Header a -> a
@@ -530,7 +534,6 @@ emptyHaddockModInfo = HaddockModInfo
 -----------------------------------------------------------------------------
 
 
-{-! for DocOption derive: Binary !-}
 -- | Source-level options for controlling the documentation.
 data DocOption
   = OptHide            -- ^ This module should not appear in the docs.
diff --git a/haddock-api/src/Haddock/Utils.hs b/haddock-api/src/Haddock/Utils.hs
index 3510d908..325dd710 100644
--- a/haddock-api/src/Haddock/Utils.hs
+++ b/haddock-api/src/Haddock/Utils.hs
@@ -478,6 +478,8 @@ markup m (DocCodeBlock d)            = markupCodeBlock m (markup m d)
 markup m (DocHyperlink l)            = markupHyperlink m l
 markup m (DocAName ref)              = markupAName m ref
 markup m (DocPic img)                = markupPic m img
+markup m (DocMathInline mathjax)     = markupMathInline m mathjax
+markup m (DocMathDisplay mathjax)    = markupMathDisplay m mathjax
 markup m (DocProperty p)             = markupProperty m p
 markup m (DocExamples e)             = markupExample m e
 markup m (DocHeader (Header l t))    = markupHeader m (Header l (markup m t))
@@ -508,6 +510,8 @@ idMarkup = Markup {
   markupHyperlink            = DocHyperlink,
   markupAName                = DocAName,
   markupPic                  = DocPic,
+  markupMathInline           = DocMathInline,
+  markupMathDisplay          = DocMathDisplay,
   markupProperty             = DocProperty,
   markupExample              = DocExamples,
   markupHeader               = DocHeader