module Text.Pandoc.SelfContained ( makeSelfContained ) where
import Text.HTML.TagSoup
import Network.URI (isAbsoluteURI, escapeURIString)
import Data.ByteString.Base64
import qualified Data.ByteString.Char8 as B
import Data.ByteString (ByteString)
import System.FilePath (takeExtension, dropExtension, takeDirectory, (</>))
import Data.Char (toLower, isAscii, isAlphaNum)
import Codec.Compression.GZip as Gzip
import qualified Data.ByteString.Lazy as L
import Text.Pandoc.Shared (renderTags', openURL, readDataFile)
import Text.Pandoc.UTF8 (toString, fromString)
import Text.Pandoc.MIME (getMimeType)
import System.Directory (doesFileExist)
isOk :: Char -> Bool
isOk c = isAscii c && isAlphaNum c
convertTag :: Maybe FilePath -> Tag String -> IO (Tag String)
convertTag userdata t@(TagOpen "img" as) =
case fromAttrib "src" t of
[] -> return t
src -> do
(raw, mime) <- getRaw userdata (fromAttrib "type" t) src
let enc = "data:" ++ mime ++ ";base64," ++ toString (encode raw)
return $ TagOpen "img" (("src",enc) : [(x,y) | (x,y) <- as, x /= "src"])
convertTag userdata t@(TagOpen "video" as) =
case fromAttrib "src" t of
[] -> return t
src -> do
(raw, mime) <- getRaw userdata (fromAttrib "type" t) src
let enc = "data:" ++ mime ++ ";base64," ++ toString (encode raw)
return $ TagOpen "video" (("src",enc) : [(x,y) | (x,y) <- as, x /= "src"])
convertTag userdata t@(TagOpen "script" as) =
case fromAttrib "src" t of
[] -> return t
src -> do
(raw, mime) <- getRaw userdata (fromAttrib "type" t) src
let enc = "data:" ++ mime ++ "," ++ escapeURIString isOk (toString raw)
return $ TagOpen "script" (("src",enc) : [(x,y) | (x,y) <- as, x /= "src"])
convertTag userdata t@(TagOpen "link" as) =
case fromAttrib "href" t of
[] -> return t
src -> do
(raw, mime) <- getRaw userdata (fromAttrib "type" t) src
let enc = "data:" ++ mime ++ "," ++ escapeURIString isOk (toString raw)
return $ TagOpen "link" (("href",enc) : [(x,y) | (x,y) <- as, x /= "href"])
convertTag _ t = return t
cssURLs :: Maybe FilePath -> FilePath -> ByteString -> IO ByteString
cssURLs userdata d orig =
case B.breakSubstring "url(" orig of
(x,y) | B.null y -> return orig
| otherwise -> do
let (u,v) = B.breakSubstring ")" $ B.drop 4 y
let url = toString
$ case B.take 1 u of
"\"" -> B.takeWhile (/='"') $ B.drop 1 u
"'" -> B.takeWhile (/='\'') $ B.drop 1 u
_ -> u
let url' = if isAbsoluteURI url
then url
else d </> url
(raw, mime) <- getRaw userdata "" url'
rest <- cssURLs userdata d v
let enc = "data:" `B.append` fromString mime `B.append`
";base64," `B.append` (encode raw)
return $ x `B.append` "url(" `B.append` enc `B.append` rest
getItem :: Maybe FilePath -> String -> IO (ByteString, Maybe String)
getItem userdata f =
if isAbsoluteURI f
then openURL f
else do
let mime = case takeExtension f of
".gz" -> getMimeType $ dropExtension f
x -> getMimeType x
exists <- doesFileExist f
cont <- if exists then B.readFile f else readDataFile userdata f
return (cont, mime)
getRaw :: Maybe FilePath -> String -> String -> IO (ByteString, String)
getRaw userdata mimetype src = do
let ext = map toLower $ takeExtension src
(raw, respMime) <- getItem userdata src
let raw' = if ext == ".gz"
then B.concat $ L.toChunks $ Gzip.decompress $ L.fromChunks
$ [raw]
else raw
let mime = case (mimetype, respMime) of
("",Nothing) -> error
$ "Could not determine mime type for `" ++ src ++ "'"
(x, Nothing) -> x
(_, Just x ) -> x
result <- if mime == "text/css"
then cssURLs userdata (takeDirectory src) raw'
else return raw'
return (result, mime)
makeSelfContained :: Maybe FilePath -> String -> IO String
makeSelfContained userdata inp = do
let tags = parseTags inp
out' <- mapM (convertTag userdata) tags
return $ renderTags' out'