diff --git a/app/Media.hs b/app/Media.hs index e2a71c8..9b3a4ac 100644 --- a/app/Media.hs +++ b/app/Media.hs @@ -4,82 +4,154 @@ import Text.Pandoc.JSON import Control.Exception import Data.Monoid ((<>)) -import Data.List (partition) +import Data.List (partition, elem) +import System.FilePath main :: IO () main = toJSONFilter media -media :: Inline -> IO [Inline] -media (Image ("audio",att,att') [] (filename,_)) = return $ [toHtml $ ""] - where - (direct, css) = classToPlain att -media (Image ("audio",att,att') alt (filename,_)) = return $ [toHtml $ "
"] - ++ [toHtml $ "
"] - ++ alt - ++ [toHtml $ "
"] - where - (direct, css) = classToPlain att ---no description of video -media (Image ("video", att, att') [] (filename,_)) = return $ [toHtml $ ""] - where - (direct, css) = classToPlain att ---with description of video -media (Image ("video", att, att') alt (filename,_)) = return $ [toHtml $ "
"] - ++ [toHtml $ ""] - ++ [toHtml $ "
"] - ++ alt - ++ [toHtml $ "
"] - where - (direct, css) = classToPlain att ---no description of image -media (Image ("img", att, att') [] (filename,_)) = return $ [toHtml $ "
"] - ++ [toHtml $ " unwords direct <> " src=\"" <> filename <> "\"" <> attToString ("",css,att') <> ">"] - ++ [toHtml $ "
"] - where - (direct, css) = classToPlain att ---with description of image -media (Image ("img", att, att') alt (filename,_)) = return $ [toHtml $ "
"] - ++ [toHtml $ " unwords direct <> " src=\"" <> filename <> "\"" <> attToString ("",css,att') <> ">"] - ++ [toHtml $ "
"] - ++ alt - ++ [toHtml $ "
"] - where - (direct, css) = classToPlain att -media (Image ("svg", att, att') [] (filename,_)) = handle (\(fileerror :: IOException) -> return [toHtml $ "Could not read file: " <> filename <> "
" <> show fileerror]) $ - do - svg <- readFile filename - return $ [toHtml $ "
unwords direct <> " " <> attToString ("", css, att') <> ">"] -- use attributes on figure, as svg gets dumped in.. - ++ [toHtml $ svg] - ++ [toHtml $ "
"] - where - (direct, css) = classToPlain att -media (Image ("svg", att, att') alt (filename,_)) = handle (\(fileerror :: IOException) -> return $ [toHtml $ "Could not read file: " <> filename <> "
" <> show filename]) $ - do - svg <- readFile filename - return $ [toHtml $ "
unwords direct <> " " <> attToString ("", css, att') <> ">"] -- use attributes on figure, as svg gets dumped in.. - ++ [toHtml $ svg] - ++ [toHtml $ "
"] - ++ alt - ++ [toHtml $ "
"] - where - (direct, css) = classToPlain att -media (Image ("demo", att, att') [] (filename,_)) = return $ [toHtml $ ""] - where - (direct, css) = classToPlain att -media (Image ("demo", att, att') alt (filename,_)) = return $ [toHtml $ "
"] - ++ [toHtml $ ""] - ++ [toHtml $ "
"] - ++ alt - ++ [toHtml $ "
"] - where - (direct, css) = classToPlain att +-- | File-extensions that should be treated as audio +audioExt :: [String] +audioExt = ["mp3","aac"] +-- | File-extensions that should be treated as video +videoExt :: [String] +videoExt = [ "avi" + , "mp4" + , "mov" + ] + +-- | File-extensions that should be treated as image +imgExt :: [String] +imgExt = + [ "jpg" + , "jpeg" + , "png" + , "gif" + , "tif" + , "tiff" + , "bmp" + ] + +-- | File-extensions that should be treated as demo and will be included +-- in an iframe. +demoExt :: [String] +demoExt = ["html", "htm"] + +-- | main media-plugin. +-- +-- Will convert the following syntax +-- +-- +-- - `![](foo.aac){#audio}` +-- - `![](foo.mp4){#video}` +-- - `![](foo.png){#img}` +-- - `![](foo.svg){#svg}` +-- - `![](foo.html){#demo}` +-- +-- HTML-id's maybe ommitted if the file-extension is in whitelist. +-- +-- If a type is detected by extension a custom id (not matching the extension) +-- will be preserved. +-- +media :: Inline -> IO [Inline] +--audio +media (Image (id',att,att') [] (filename,_)) + | id' == "audio" || (takeExtension filename `elem` audioExt) + = return $ [toHtml $ ""] + where + (direct, css) = classToPlain att +media (Image (id',att,att') alt (filename,_)) + | id' == "audio" || (takeExtension filename `elem` audioExt) + = return $ [toHtml $ "
"] + ++ [toHtml $ "
"] + ++ alt + ++ [toHtml $ "
"] + where + (direct, css) = classToPlain att +--videos +media (Image (id', att, att') [] (filename,_)) + | id' == "video" || (takeExtension filename `elem` videoExt) + = return $ [toHtml $ ""] + where + (direct, css) = classToPlain att +media (Image (id', att, att') alt (filename,_)) + | id' == "video" || (takeExtension filename `elem` videoExt) + = return $ [toHtml $ "
"] + ++ [toHtml $ ""] + ++ [toHtml $ "
"] + ++ alt + ++ [toHtml $ "
"] + where + (direct, css) = classToPlain att +--images +media (Image (id', att, att') [] (filename,_)) + | id' == "img" || (takeExtension filename `elem` imgExt) + = return $ [toHtml $ "
"] + ++ [toHtml $ " unwords direct <> " src=\"" <> filename <> "\"" <> attToString (idFilter "img" id',css,att') <> ">"] + ++ [toHtml $ "
"] + where + (direct, css) = classToPlain att +media (Image (id', att, att') alt (filename,_)) + | id' == "img" || (takeExtension filename `elem` imgExt) + = return $ [toHtml $ "
"] + ++ [toHtml $ " unwords direct <> " src=\"" <> filename <> "\"" <> attToString (idFilter "img" id',css,att') <> ">"] + ++ [toHtml $ "
"] + ++ alt + ++ [toHtml $ "
"] + where + (direct, css) = classToPlain att +--load svg and dump it in +media (Image (id', att, att') [] (filename,_)) + | id' == "svg" || (takeExtension filename == "svg") + = handle (\(fileerror :: IOException) -> return [toHtml $ "Could not read file: " <> filename <> "
" <> show fileerror]) $ + do + svg <- readFile filename + return $ [toHtml $ "
unwords direct <> " " <> attToString (idFilter "svg" id', css, att') <> ">"] -- use attributes on figure, as svg gets dumped in.. + ++ [toHtml $ svg] + ++ [toHtml $ "
"] + where + (direct, css) = classToPlain att +media (Image (id', att, att') alt (filename,_)) + | id' == "svg" || (takeExtension filename == "svg") + = handle (\(fileerror :: IOException) -> return $ [toHtml $ "Could not read file: " <> filename <> "
" <> show filename]) $ + do + svg <- readFile filename + return $ [toHtml $ "
unwords direct <> " " <> attToString (idFilter "svg" id', css, att') <> ">"] -- use attributes on figure, as svg gets dumped in.. + ++ [toHtml $ svg] + ++ [toHtml $ "
"] + ++ alt + ++ [toHtml $ "
"] + where + (direct, css) = classToPlain att +--html-demos etc. as IFrames +media (Image (id', att, att') [] (filename,_)) + | id' == "demo" || (takeExtension filename `elem` demoExt) + = return $ [toHtml $ ""] + where + (direct, css) = classToPlain att +media (Image (id', att, att') alt (filename,_)) + | id' == "demo" || (takeExtension filename `elem` demoExt) + = return $ [toHtml $ "
"] + ++ [toHtml $ ""] + ++ [toHtml $ "
"] + ++ alt + ++ [toHtml $ "
"] + where + (direct, css) = classToPlain att +-- if not matched media x = return [x] attToString :: Attr -> String -attToString (ident, classes, kvpairs) = ident <> " class=\"" <> unwords classes <> "\" " <> unwords ((\(k,v) -> k <> "=\"" <> v <> "\"") <$> kvpairs) +attToString ("", classes, kvpairs) = "class=\"" <> unwords classes <> "\" " <> unwords ((\(k,v) -> k <> "=\"" <> v <> "\"") <$> kvpairs) +attToString (id', classes, kvpairs) = "id=\"" <> id' <> "\" class=\"" <> unwords classes <> "\" " <> unwords ((\(k,v) -> k <> "=\"" <> v <> "\"") <$> kvpairs) + + +idFilter :: String -> String -> String +idFilter a b + | a == b = "" + | otherwise = a classToPlain :: [String] -> ([String],[String]) classToPlain = partition (`elem` [ "data-autoplay" diff --git a/pandoc-slide-filter.cabal b/pandoc-slide-filter.cabal index b9f0a90..1d3d65b 100644 --- a/pandoc-slide-filter.cabal +++ b/pandoc-slide-filter.cabal @@ -19,6 +19,7 @@ executable media ghc-options: -threaded -rtsopts -with-rtsopts=-N build-depends: base , pandoc-types + , filepath default-language: Haskell2010 executable styling