diff options
| -rw-r--r-- | src/Text/Pandoc/SelfContained.hs | 54 |
1 files changed, 41 insertions, 13 deletions
diff --git a/src/Text/Pandoc/SelfContained.hs b/src/Text/Pandoc/SelfContained.hs index c0a12adf2..e9a91b690 100644 --- a/src/Text/Pandoc/SelfContained.hs +++ b/src/Text/Pandoc/SelfContained.hs @@ -35,6 +35,7 @@ import Codec.Compression.GZip as Gzip import Control.Applicative ((<|>)) import Control.Monad.Except (throwError) import Control.Monad.Trans (lift) +import Data.Monoid ((<>)) import Data.ByteString (ByteString) import Data.ByteString.Base64 import qualified Data.ByteString.Char8 as B @@ -95,9 +96,9 @@ convertTags sourceURL (t@(TagOpen "script" as):TagClose "script":ts) = (("src",dataUri) : [(x,y) | (x,y) <- as, x /= "src"]) : TagClose "script" : rest Right (mime, bs) - | (mime == "text/javascript" || - mime == "application/javascript" || - mime == "application/x-javascript") && + | ("text/javascript" `isPrefixOf` mime || + "application/javascript" `isPrefixOf` mime || + "application/x-javascript" `isPrefixOf` mime) && not ("</script" `B.isInfixOf` bs) -> return $ TagOpen "script" [("type", typeAttr)|not (null typeAttr)] @@ -121,11 +122,12 @@ convertTags sourceURL (t@(TagOpen "link" as):ts) = (("href",dataUri) : [(x,y) | (x,y) <- as, x /= "href"]) : rest Right (mime, bs) - | mime == "text/css" && not ("</" `B.isInfixOf` bs) -> do + | "text/css" `isPrefixOf` mime + && not ("</" `B.isInfixOf` bs) -> do rest <- convertTags sourceURL $ dropWhile (==TagClose "link") ts return $ - TagOpen "style" [("type", "text/css")] + TagOpen "style" [("type", mime)] : TagText (toString bs) : TagClose "style" : rest @@ -149,7 +151,20 @@ cssURLs sourceURL d orig = do parseCSSUrls :: PandocMonad m => Maybe String -> FilePath -> ParsecT ByteString () m ByteString parseCSSUrls sourceURL d = B.concat <$> P.many - (pCSSWhite <|> pCSSComment <|> pCSSUrl sourceURL d <|> pCSSOther) + (pCSSWhite <|> pCSSComment <|> pCSSImport sourceURL d <|> + pCSSUrl sourceURL d <|> pCSSOther) + +pCSSImport :: PandocMonad m => Maybe String -> FilePath + -> ParsecT ByteString () m ByteString +pCSSImport sourceURL d = P.try $ do + P.string "@import" + P.spaces + res <- pCSSUrl' sourceURL d + P.spaces + P.optional $ P.char ';' >> P.spaces + case res of + Left b -> return $ B.pack "@import " <> b + Right (_, b) -> return b -- Note: some whitespace in CSS is significant, so we can't collapse it! pCSSWhite :: PandocMonad m => ParsecT ByteString () m ByteString @@ -170,13 +185,25 @@ pCSSOther = do pCSSUrl :: PandocMonad m => Maybe String -> FilePath -> ParsecT ByteString () m ByteString pCSSUrl sourceURL d = P.try $ do + res <- pCSSUrl' sourceURL d + case res of + Left b -> return b + Right (mt,b) -> do + let enc = makeDataURI (mt, b) + return (B.pack $ "url(" ++ enc ++ ")") + +pCSSUrl' :: PandocMonad m + => Maybe String -> FilePath + -> ParsecT ByteString () m (Either ByteString (MimeType, ByteString)) +pCSSUrl' sourceURL d = P.try $ do P.string "url(" P.spaces quote <- P.option Nothing (Just <$> P.oneOf "\"'") url <- P.manyTill P.anyChar (maybe (P.lookAhead (P.char ')')) P.char quote) P.spaces P.char ')' - let fallback = B.pack ("url(" ++ maybe "" (:[]) quote ++ trim url ++ + let fallback = Left $ + B.pack ("url(" ++ maybe "" (:[]) quote ++ trim url ++ maybe "" (:[]) quote ++ ")") -- pipes are used in URLs provided by Google Code fonts -- but parseURI doesn't like them, so we escape them: @@ -186,13 +213,14 @@ pCSSUrl sourceURL d = P.try $ do u -> do let url' = if isURI u then u else d </> u res <- lift $ getData sourceURL "" url' case res of - Left uri -> return (B.pack $ "url(" ++ uri ++ ")") + Left uri -> return $ Left (B.pack $ "url(" ++ uri ++ ")") Right (mt, raw) -> do - -- note that the downloaded content may + -- note that the downloaded CSS may -- itself contain url(...). - raw' <- cssURLs sourceURL d raw - let enc = makeDataURI (mt, raw') - return (B.pack $ "url(" ++ enc ++ ")") + b <- if "text/css" `isPrefixOf` mt + then cssURLs sourceURL d raw + else return raw + return $ Right (mt, b) getDataURI :: PandocMonad m => Maybe String -> MimeType -> String -> m String getDataURI sourceURL mimetype src = do @@ -224,7 +252,7 @@ getData sourceURL mimetype src = do uriQuery = "", uriFragment = "" } _ -> Nothing - result <- if mime == "text/css" + result <- if "text/css" `isPrefixOf` mime then cssURLs cssSourceURL (takeDirectory src) raw' else return raw' return $ Right (mime, result) |