git.iko.soy/typeable/pandoc
on master help sign in
SelfContained: fixed problem with embedded fonts.

Closes #3629. However, there is still room for improvement. `@import` with following media declaration is not handled. Also `@import` with a simple filename (rather than `url(...)` is not handled.

commit8d4fbe6a2a50d93bff0e9c7ada73774ff1bc17c6 authorJohn MacFarlane <jgm@berkeley.edu> dateSat 20 May 2017, 17:09 (9 years ago) parentca77f0a
1 file changed+41−13
src/Text/Pandoc/SelfContained.hs+41−13
src/Text/Pandoc/SelfContained.hs+41−13
@@ -35,6 +35,7 @@ import Codec.Compression.GZip as Gzip
3535import Control.Applicative ((<|>))
3636import Control.Monad.Except (throwError)
3737import Control.Monad.Trans (lift)
38+import Data.Monoid ((<>))
3839import Data.ByteString (ByteString)
3940import Data.ByteString.Base64
4041import qualified Data.ByteString.Char8 as B
@@ -95,9 +96,9 @@ convertTags sourceURL (t@(TagOpen "script" as):TagClose "script":ts) =
9596 (("src",dataUri) : [(x,y) | (x,y) <- as, x /= "src"]) :
9697 TagClose "script" : rest
9798 Right (mime, bs)
98− | (mime == "text/javascript" ||
99− mime == "application/javascript" ||
100− mime == "application/x-javascript") &&
99+ | ("text/javascript" `isPrefixOf` mime ||
100+ "application/javascript" `isPrefixOf` mime ||
101+ "application/x-javascript" `isPrefixOf` mime) &&
101102 not ("</script" `B.isInfixOf` bs) ->
102103 return $
103104 TagOpen "script" [("type", typeAttr)|not (null typeAttr)]
@@ -121,11 +122,12 @@ convertTags sourceURL (t@(TagOpen "link" as):ts) =
121122 (("href",dataUri) : [(x,y) | (x,y) <- as, x /= "href"]) :
122123 rest
123124 Right (mime, bs)
124− | mime == "text/css" && not ("</" `B.isInfixOf` bs) -> do
125+ | "text/css" `isPrefixOf` mime
126+ && not ("</" `B.isInfixOf` bs) -> do
125127 rest <- convertTags sourceURL $
126128 dropWhile (==TagClose "link") ts
127129 return $
128− TagOpen "style" [("type", "text/css")]
130+ TagOpen "style" [("type", mime)]
129131 : TagText (toString bs)
130132 : TagClose "style"
131133 : rest
@@ -149,7 +151,20 @@ cssURLs sourceURL d orig = do
149151parseCSSUrls :: PandocMonad m
150152 => Maybe String -> FilePath -> ParsecT ByteString () m ByteString
151153parseCSSUrls sourceURL d = B.concat <$> P.many
152− (pCSSWhite <|> pCSSComment <|> pCSSUrl sourceURL d <|> pCSSOther)
154+ (pCSSWhite <|> pCSSComment <|> pCSSImport sourceURL d <|>
155+ pCSSUrl sourceURL d <|> pCSSOther)
156+
157+pCSSImport :: PandocMonad m => Maybe String -> FilePath
158+ -> ParsecT ByteString () m ByteString
159+pCSSImport sourceURL d = P.try $ do
160+ P.string "@import"
161+ P.spaces
162+ res <- pCSSUrl' sourceURL d
163+ P.spaces
164+ P.optional $ P.char ';' >> P.spaces
165+ case res of
166+ Left b -> return $ B.pack "@import " <> b
167+ Right (_, b) -> return b
153168
154169-- Note: some whitespace in CSS is significant, so we can't collapse it!
155170pCSSWhite :: PandocMonad m => ParsecT ByteString () m ByteString
@@ -170,13 +185,25 @@ pCSSOther = do
170185pCSSUrl :: PandocMonad m
171186 => Maybe String -> FilePath -> ParsecT ByteString () m ByteString
172187pCSSUrl sourceURL d = P.try $ do
188+ res <- pCSSUrl' sourceURL d
189+ case res of
190+ Left b -> return b
191+ Right (mt,b) -> do
192+ let enc = makeDataURI (mt, b)
193+ return (B.pack $ "url(" ++ enc ++ ")")
194+
195+pCSSUrl' :: PandocMonad m
196+ => Maybe String -> FilePath
197+ -> ParsecT ByteString () m (Either ByteString (MimeType, ByteString))
198+pCSSUrl' sourceURL d = P.try $ do
173199 P.string "url("
174200 P.spaces
175201 quote <- P.option Nothing (Just <$> P.oneOf "\"'")
176202 url <- P.manyTill P.anyChar (maybe (P.lookAhead (P.char ')')) P.char quote)
177203 P.spaces
178204 P.char ')'
179− let fallback = B.pack ("url(" ++ maybe "" (:[]) quote ++ trim url ++
205+ let fallback = Left $
206+ B.pack ("url(" ++ maybe "" (:[]) quote ++ trim url ++
180207 maybe "" (:[]) quote ++ ")")
181208 -- pipes are used in URLs provided by Google Code fonts
182209 -- but parseURI doesn't like them, so we escape them:
@@ -186,13 +213,14 @@ pCSSUrl sourceURL d = P.try $ do
186213 u -> do let url' = if isURI u then u else d </> u
187214 res <- lift $ getData sourceURL "" url'
188215 case res of
189− Left uri -> return (B.pack $ "url(" ++ uri ++ ")")
216+ Left uri -> return $ Left (B.pack $ "url(" ++ uri ++ ")")
190217 Right (mt, raw) -> do
191− -- note that the downloaded content may
218+ -- note that the downloaded CSS may
192219 -- itself contain url(...).
193− raw' <- cssURLs sourceURL d raw
194− let enc = makeDataURI (mt, raw')
195− return (B.pack $ "url(" ++ enc ++ ")")
220+ b <- if "text/css" `isPrefixOf` mt
221+ then cssURLs sourceURL d raw
222+ else return raw
223+ return $ Right (mt, b)
196224
197225getDataURI :: PandocMonad m => Maybe String -> MimeType -> String -> m String
198226getDataURI sourceURL mimetype src = do
@@ -224,7 +252,7 @@ getData sourceURL mimetype src = do
224252 uriQuery = "",
225253 uriFragment = "" }
226254 _ -> Nothing
227− result <- if mime == "text/css"
255+ result <- if "text/css" `isPrefixOf` mime
228256 then cssURLs cssSourceURL (takeDirectory src) raw'
229257 else return raw'
230258 return $ Right (mime, result)