Merge pull request #5497 from mb21/html-writer-video-audio

Output HTML5 video and audio elements

8 files changed, 61 insertions, 39 deletions

diff --git a/src/Text/Pandoc/MIME.hs b/src/Text/Pandoc/MIME.hs
index 19488c9bc..ee0fe3efb 100644
--- a/src/Text/Pandoc/MIME.hs
+++ b/src/Text/Pandoc/MIME.hs
@@ -11,12 +11,13 @@
 Mime type lookup for ODT writer.
 -}
 module Text.Pandoc.MIME ( MimeType, getMimeType, getMimeTypeDef,
-                          extensionFromMimeType )where
+                          extensionFromMimeType, mediaCategory ) where
 import Prelude
 import Data.Char (toLower)
 import Data.List (isPrefixOf, isSuffixOf)
+import Data.List.Split (splitOn)
 import qualified Data.Map as M
-import Data.Maybe (fromMaybe)
+import Data.Maybe (fromMaybe, listToMaybe)
 import System.FilePath
 
 type MimeType = String
@@ -42,15 +43,25 @@ extensionFromMimeType mimetype =
   M.lookup (takeWhile (/=';') mimetype) reverseMimeTypes
   -- note:  we just look up the basic mime type, dropping the content-encoding etc.
 
+-- | Determine general media category for file path, e.g.
+--
+-- prop> mediaCategory "foo.jpg" = Just "image"
+mediaCategory :: FilePath -> Maybe String
+mediaCategory fp = getMimeType fp >>= listToMaybe . splitOn "/"
+
 reverseMimeTypes :: M.Map MimeType String
 reverseMimeTypes = M.fromList $ map (\(k,v) -> (v,k)) mimeTypesList
 
 mimeTypes :: M.Map String MimeType
 mimeTypes = M.fromList mimeTypesList
 
+-- | Collection of common mime types.
+-- Except for first entry, list borrowed from
+-- <https://github.com/Happstack/happstack-server/blob/master/src/Happstack/Server/FileServe/BuildingBlocks.hs happstack-server>
 mimeTypesList :: [(String, MimeType)]
-mimeTypesList = -- List borrowed from happstack-server.
-           [("gz","application/x-gzip")
+mimeTypesList =
+           [("cpt","image/x-corelphotopaint")
+           ,("gz","application/x-gzip")
            ,("cabal","application/x-cabal")
            ,("%","application/x-trash")
            ,("323","text/h323")
diff --git a/src/Text/Pandoc/Writers/HTML.hs b/src/Text/Pandoc/Writers/HTML.hs
index 5004f4111..ca44583ab 100644
--- a/src/Text/Pandoc/Writers/HTML.hs
+++ b/src/Text/Pandoc/Writers/HTML.hs
@@ -65,18 +65,21 @@ import Text.Blaze.Internal (preEscapedString, preEscapedText)
 #endif
 #if MIN_VERSION_blaze_html(0,5,1)
 import qualified Text.Blaze.XHtml5 as H5
+import qualified Text.Blaze.XHtml5.Attributes as A5
 #else
 import qualified Text.Blaze.Html5 as H5
+import qualified Text.Blaze.Html5.Attributes as A5
 #endif
 import Control.Monad.Except (throwError)
 import Data.Aeson (Value)
-import System.FilePath (takeBaseName, takeExtension)
+import System.FilePath (takeBaseName)
 import Text.Blaze.Html.Renderer.Text (renderHtml)
 import qualified Text.Blaze.XHtml1.Transitional as H
 import qualified Text.Blaze.XHtml1.Transitional.Attributes as A
 import Text.Pandoc.Class (PandocMonad, report, runPure)
 import Text.Pandoc.Error
 import Text.Pandoc.Logging
+import Text.Pandoc.MIME (mediaCategory)
 import Text.TeXMath
 import Text.XML.Light (elChildren, unode, unqual)
 import qualified Text.XML.Light as XML
@@ -665,18 +668,6 @@ dimensionsToAttrList attr = consolidateStyles $ go Width ++ go Height
                (Just x)         -> [("style", show dir ++ ":" ++ show x)]
                Nothing          -> []
 
-imageExts :: [String]
-imageExts = [ "art", "bmp", "cdr", "cdt", "cpt", "cr2", "crw", "djvu", "erf",
-              "gif", "ico", "ief", "jng", "jpg", "jpeg", "nef", "orf", "pat", "pbm",
-              "pcx", "pgm", "png", "pnm", "ppm", "psd", "ras", "rgb", "svg", "tiff",
-              "wbmp", "xbm", "xpm", "xwd" ]
-
-treatAsImage :: FilePath -> Bool
-treatAsImage fp =
-  let path = maybe fp uriPath (parseURIReference fp)
-      ext  = map toLower $ drop 1 $ takeExtension path
-  in  null ext || ext `elem` imageExts
-
 figure :: PandocMonad m
        => WriterOptions -> Attr -> [Inline] -> (String, String)
        -> StateT WriterState m Html
@@ -1135,8 +1126,8 @@ inlineToHtml opts inline = do
                         return $ if null tit
                                     then link'
                                     else link' ! A.title (toValue tit)
-    (Image attr txt (s,tit)) | treatAsImage s -> do
-                        let alternate' = stringify txt
+    (Image attr txt (s,tit)) -> do
+                        let alternate = stringify txt
                         slideVariant <- gets stSlideVariant
                         let isReveal = slideVariant == RevealJsSlides
                         attrs <- imgAttrsToHtml opts attr
@@ -1146,22 +1137,23 @@ inlineToHtml opts inline = do
                                   then customAttribute "data-src" $ toValue s
                                   else A.src $ toValue s) :
                               [A.title $ toValue tit | not (null tit)] ++
-                              [A.alt $ toValue alternate' | not (null txt)] ++
-                              attrs
-                        let tag = if html5 then H5.img else H.img
-                        return $ foldl (!) tag attributes
-                        -- note:  null title included, as in Markdown.pl
-    (Image attr _ (s,tit)) -> do
-                        slideVariant <- gets stSlideVariant
-                        let isReveal = slideVariant == RevealJsSlides
-                        attrs <- imgAttrsToHtml opts attr
-                        let attributes =
-                              (if isReveal
-                                  then customAttribute "data-src" $ toValue s
-                                  else A.src $ toValue s) :
-                              [A.title $ toValue tit | not (null tit)] ++
                               attrs
-                        return $ foldl (!) H5.embed attributes
+                            imageTag = (if html5 then H5.img else H.img
+                              , [A.alt $ toValue alternate | not (null txt)] )
+                            mediaTag tg fallbackTxt =
+                              let linkTxt = if null txt
+                                            then fallbackTxt
+                                            else alternate
+                              in (tg $ H.a ! A.href (toValue s) $ toHtml linkTxt
+                                 , [A5.controls ""] )
+                            normSrc = maybe s uriPath (parseURIReference s)
+                            (tag, specAttrs) = case mediaCategory normSrc of
+                              Just "image" -> imageTag
+                              Just "video" -> mediaTag H5.video "Video"
+                              Just "audio" -> mediaTag H5.audio "Audio"
+                              Just _       -> (H5.embed, [])
+                              _            -> imageTag
+                        return $ foldl (!) tag $ attributes ++ specAttrs
                         -- note:  null title included, as in Markdown.pl
     (Note contents) -> do
                         notes <- gets stNotes
diff --git a/test/command/2662.md b/test/command/2662.md
index 543209053..74e075c2d 100644
--- a/test/command/2662.md
+++ b/test/command/2662.md
@@ -7,5 +7,5 @@
    :scale: 300 %
    :alt: alternate text
 ^D
-<p><img src="http://url.to.image/foo.png" alt="alternate text" class="align-left" width="600" height="300" /></p>
+<p><img src="http://url.to.image/foo.png" class="align-left" width="600" height="300" alt="alternate text" /></p>
 ```
diff --git a/test/command/3450.md b/test/command/3450.md
index 5b35e1d9e..5ccfd05ff 100644
--- a/test/command/3450.md
+++ b/test/command/3450.md
@@ -2,7 +2,7 @@
 % pandoc -fmarkdown-implicit_figures
 ![image](lalune.jpg){height=2em}
 ^D
-<p><img src="lalune.jpg" alt="image" style="height:2em" /></p>
+<p><img src="lalune.jpg" style="height:2em" alt="image" /></p>
 ```
 ```
 % pandoc -fmarkdown-implicit_figures -t latex
diff --git a/test/command/4012.md b/test/command/4012.md
index 579ee2459..602c23219 100644
--- a/test/command/4012.md
+++ b/test/command/4012.md
@@ -4,5 +4,5 @@ pandoc -f markdown-implicit_figures
 
 [image]: http://example.com/image.jpg {height=35mm}
 ^D
-<p><img src="http://example.com/image.jpg" alt="image" style="height:35mm" /></p>
+<p><img src="http://example.com/image.jpg" style="height:35mm" alt="image" /></p>
 ```
diff --git a/test/command/4677.md b/test/command/4677.md
index 11a62fd08..482db4c02 100644
--- a/test/command/4677.md
+++ b/test/command/4677.md
@@ -3,6 +3,6 @@
 ![Caption](img.png){#img:1}
 ^D
 <figure>
-<img src="img.png" alt="" id="img:1" /><figcaption>Caption</figcaption>
+<img src="img.png" id="img:1" alt="" /><figcaption>Caption</figcaption>
 </figure>
 ```
diff --git a/test/command/5121.md b/test/command/5121.md
index 0f45c4afe..42f2fdea2 100644
--- a/test/command/5121.md
+++ b/test/command/5121.md
@@ -5,7 +5,7 @@
 ## Header 2
 ^D
 <figure>
-<img src="./my-figure.jpg" alt="" width="500" /><figcaption>My caption</figcaption>
+<img src="./my-figure.jpg" width="500" alt="" /><figcaption>My caption</figcaption>
 </figure>
 
 Header 2
diff --git a/test/command/video-audio.md b/test/command/video-audio.md
new file mode 100644
index 000000000..451b614d8
--- /dev/null
+++ b/test/command/video-audio.md
@@ -0,0 +1,19 @@
+```
+% pandoc -f markdown-implicit_figures -t html
+![](./test.mp4)
+
+![Your browser does not support video.](foo/test.webm){width=300}
+
+![](test.mp3)
+
+![](./test.pdf)
+
+![](./test.jpg)
+^D
+<p><video src="./test.mp4" controls=""><a href="./test.mp4">Video</a></video></p>
+<p><video src="foo/test.webm" width="300" controls=""><a href="foo/test.webm">Your browser does not support video.</a></video></p>
+<p><audio src="test.mp3" controls=""><a href="test.mp3">Audio</a></audio></p>
+<p><embed src="./test.pdf" /></p>
+<p><img src="./test.jpg" /></p>
+```
+