89b3fcc · typeable/pandoc

git.iko.soy/typeable/pandoc

on master help sign in

SelfContained: special handling for css @import.

89b3fccJohn MacFarlane10 years ago

src/Text/Pandoc/SelfContained.hs+36−5

compare with master

unifiedsplit

@@ -31,6 +31,7 @@ offline, by incorporating linked images, CSS, and scripts into

31the HTML using data URIs.

32-}

33module Text.Pandoc.SelfContained ( makeDataURI, makeSelfContained ) where

34+import Data.Monoid ((<>))

34import Codec.Compression.GZip as Gzip

35import Codec.Compression.GZip as Gzip

35import Control.Applicative ((<|>))

36import Control.Applicative ((<|>))

36import Control.Monad.Except (throwError)

37import Control.Monad.Except (throwError)

@@ -149,7 +150,32 @@ cssURLs sourceURL d orig = do

149parseCSSUrls :: PandocMonad m

150parseCSSUrls :: PandocMonad m

150 => Maybe String -> FilePath -> ParsecT ByteString () m ByteString

151 => Maybe String -> FilePath -> ParsecT ByteString () m ByteString

151parseCSSUrls sourceURL d = B.concat <$> P.many

152parseCSSUrls sourceURL d = B.concat <$> P.many

153+ ( pCSSWhite

154+ <|> pCSSComment

155+ <|> pCSSImport sourceURL d

152− (pCSSWhite <|> pCSSComment <|> pCSSUrl sourceURL d <|> pCSSOther)

156+ <|> (pCSSUrl >>= processCSSUrl sourceURL d)

157+ <|> pCSSOther

158+ )

159+

160+pCSSImport :: PandocMonad m

161+ => Maybe String -> FilePath -> ParsecT ByteString () m ByteString

162+pCSSImport sourceURL d = P.try $ do

163+ P.string "@import"

164+ P.spaces

165+ url <- pCSSUrl

166+ P.spaces

167+ media <- P.manyTill P.anyChar (P.char ';')

168+ let u = escapeURIString (/='|') (trim url)

169+ let url' = if isURI u then u else d </> u

170+ res <- lift $ getData sourceURL "" url'

171+ case res of

172+ Left uri -> return (B.pack $ "url(" ++ uri ++ ")")

173+ Right (_, raw) -> do

174+ raw' <- cssURLs sourceURL d raw

175+ if null media

176+ then return raw'

177+ else return $ B.pack ("@media " ++ media ++ "{\n") <> raw' <>

178+ B.pack "}"

153

179

154-- Note: some whitespace in CSS is significant, so we can't collapse it!

180-- Note: some whitespace in CSS is significant, so we can't collapse it!

155pCSSWhite :: PandocMonad m => ParsecT ByteString () m ByteString

181pCSSWhite :: PandocMonad m => ParsecT ByteString () m ByteString

@@ -168,16 +194,21 @@ pCSSOther = do

168 (B.singleton <$> P.char '/')

194 (B.singleton <$> P.char '/')

169

195

170pCSSUrl :: PandocMonad m

196pCSSUrl :: PandocMonad m

171− => Maybe String -> FilePath -> ParsecT ByteString () m ByteString

197+ => ParsecT ByteString () m String

172−pCSSUrl sourceURL d = P.try $ do

198+pCSSUrl = P.try $ do

173 P.string "url("

199 P.string "url("

174 P.spaces

200 P.spaces

175 quote <- P.option Nothing (Just <$> P.oneOf "\"'")

201 quote <- P.option Nothing (Just <$> P.oneOf "\"'")

176 url <- P.manyTill P.anyChar (maybe (P.lookAhead (P.char ')')) P.char quote)

202 url <- P.manyTill P.anyChar (maybe (P.lookAhead (P.char ')')) P.char quote)

177 P.spaces

203 P.spaces

178 P.char ')'

204 P.char ')'

205+ return url

206+

207+processCSSUrl :: PandocMonad m

208+ => Maybe String -> FilePath -> String

209+ -> ParsecT ByteString () m ByteString

210+processCSSUrl sourceURL d url = do

179− let fallback = B.pack ("url(" ++ maybe "" (:[]) quote ++ trim url ++

211+ let fallback = B.pack ("url('" ++ trim url ++ "')")

180− maybe "" (:[]) quote ++ ")")

181 -- pipes are used in URLs provided by Google Code fonts

212 -- pipes are used in URLs provided by Google Code fonts

182 -- but parseURI doesn't like them, so we escape them:

213 -- but parseURI doesn't like them, so we escape them:

183 case escapeURIString (/='|') (trim url) of

214 case escapeURIString (/='|') (trim url) of