{-# LANGUAGE ScopedTypeVariables #-}
module Text.Pandoc.Util.Filter.Media
(media)
where
import Text.Pandoc.JSON
import Control.Exception
import Data.Monoid ((<>))
import Data.Char (toLower)
import System.FilePath
import Text.Pandoc.Util.Filter
{-# ANN module "HLint: ignore Redundant $" #-}
audioExt :: [String]
audioExt = ["mp3","aac"]
videoExt :: [String]
videoExt = [ "avi"
, "mp4"
, "mov"
]
imgExt :: [String]
imgExt =
[ "jpg"
, "jpeg"
, "png"
, "gif"
, "tif"
, "tiff"
, "bmp"
, "svg"
]
demoExt :: [String]
demoExt = ["html", "htm"]
media :: Inline -> IO [Inline]
media (Image (id',att,att') [] (filename,_))
| id' == "audio" || checkExtension filename audioExt
= return $ [toHtml $ "<audio " <> unwords direct <> " src=\"" <> filename <> "\"" <> attToString (idFilter "audio" id',css,att') <> "></audio>"]
where
(direct, css) = classToRevealAttr att
media (Image (id',att,att') alt (filename,_))
| id' == "audio" || checkExtension filename audioExt
= return $ [toHtml $ "<figure><audio " <> unwords direct <> " src=\"" <> filename <> "\"" <> attToString (idFilter "audio" id',css,att') <> "></audio>"]
<> [toHtml $ "<figcaption>"]
<> alt
<> [toHtml $ "</figcaption></figure>"]
where
(direct, css) = classToRevealAttr att
media (Image (id', att, att') [] (filename,_))
| id' == "video" || checkExtension filename videoExt
= return $ [toHtml $ "<video " <> unwords direct <> " src=\"" <> filename <> "\"" <> attToString (idFilter "video" id',css,att') <> "></video>"]
where
(direct, css) = classToRevealAttr att
media (Image (id', att, att') alt (filename,_))
| id' == "video" || checkExtension filename videoExt
= return $ [toHtml $ "<figure>"]
<> [toHtml $ "<video " <> unwords direct <> " src=\"" <> filename <> "\"" <> attToString (idFilter "video" id',css,att') <> "></video>"]
<> [toHtml $ "<figcaption>"]
<> alt
<> [toHtml $ "</figcaption></figure>"]
where
(direct, css) = classToRevealAttr att
media (Image (id', att, att') [] (filename,_))
| id' == "img" || checkExtension filename imgExt
= return $ [toHtml $ "<figure>"]
<> [toHtml $ "<img " <> unwords direct <> " src=\"" <> filename <> "\"" <> attToString (idFilter "img" id',css,att') <> "></img>"]
<> [toHtml $ "</figure>"]
where
(direct, css) = classToRevealAttr att
media (Image (id', att, att') alt (filename,_))
| id' == "img" || checkExtension filename imgExt
= return $ [toHtml $ "<figure>"]
<> [toHtml $ "<img " <> unwords direct <> " src=\"" <> filename <> "\"" <> attToString (idFilter "img" id',css,att') <> "></img>"]
<> [toHtml $ "<figcaption>"]
<> alt
<> [toHtml $ "</figcaption></figure>"]
where
(direct, css) = classToRevealAttr att
media (Image (id', att, att') [] (filename,_))
| id' == "svg"
= handle (\(fileerror :: IOException) -> return [toHtml $ "Could not read file: " <> filename <> "<br />" <> show fileerror]) $
do
svg <- readFile filename
return $ [toHtml $ "<figure " <> unwords direct <> " " <> attToString (idFilter "svg" id', css, att') <> ">"]
<> [toHtml $ svg]
<> [toHtml $ "</figure>"]
where
(direct, css) = classToRevealAttr att
media (Image (id', att, att') alt (filename,_))
| id' == "svg"
= handle (\(fileerror :: IOException) -> return [toHtml $ "Could not read file: " <> filename <> "<br />" <> show fileerror]) $
do
svg <- readFile filename
return $ [toHtml $ "<figure " <> unwords direct <> " " <> attToString (idFilter "svg" id', css, att') <> ">"]
<> [toHtml $ svg]
<> [toHtml $ "<figcaption>"]
<> alt
<> [toHtml $ "</figcaption></figure>"]
where
(direct, css) = classToRevealAttr att
media (Image (id', att, att') [] (filename,_))
| id' == "demo" || checkExtension filename demoExt
= return [toHtml $ "<iframe " <> unwords direct <> " src=\"" <> filename <> "?plugin\"" <> attToString (idFilter "demo" id', css, att') <> "></iframe>"]
where
(direct, css) = classToRevealAttr att
media (Image (id', att, att') alt (filename,_))
| id' == "demo" || checkExtension filename demoExt
= return $ [toHtml $ "<figure>"]
<> [toHtml $ "<iframe " <> unwords direct <> " src=\"" <> filename <> "?plugin\"" <> attToString (idFilter "demo" id', css, att') <> "></iframe>"]
<> [toHtml $ "<figcaption>"]
<> alt
<> [toHtml $ "</figcaption></figure>"]
where
(direct, css) = classToRevealAttr att
media x = return [x]
checkExtension :: String -> [String] -> Bool
checkExtension fn exts = (fmap toLower . tail . takeExtension) fn `elem` exts
idFilter :: String -> String -> String
idFilter a b
| a == b = ""
| otherwise = b