@@ -40,9 +40,7 @@ import System.FilePath (takeExtension, takeDirectory, (</>))
4040import Data.Char (toLower, isAscii, isAlphaNum)
4141import Codec.Compression.GZip as Gzip
4242import qualified Data.ByteString.Lazy as L
43−import Control.Monad.Trans (MonadIO(..))
44−import Text.Pandoc.Shared (renderTags', err, warn, trim)
45−import Text.Pandoc.MediaBag (MediaBag)
43+import Text.Pandoc.Shared (renderTags', trim)
4644import Text.Pandoc.MIME (MimeType)
4745import Text.Pandoc.UTF8 (toString)
4846import Text.Pandoc.Options (WriterOptions(..))
@@ -50,8 +48,11 @@ import Data.List (isPrefixOf)
5048import Control.Applicative ((<|>))
5149import Text.Parsec (runParserT, ParsecT)
5250import qualified Text.Parsec as P
51+import Control.Monad.Except (throwError)
5352import Control.Monad.Trans (lift)
54−import Text.Pandoc.Class (fetchItem, runIO, setMediaBag)
53+import Text.Pandoc.Class (fetchItem, PandocMonad(..), report)
54+import Text.Pandoc.Error
55+import Text.Pandoc.Logging
5556
5657isOk :: Char -> Bool
5758isOk c = isAscii c && isAlphaNum c
@@ -66,8 +67,8 @@ makeDataURI mime raw =
6667 then mime ++ ";charset=utf-8"
6768 else mime -- mime type already has charset
6869
69−convertTag :: MediaBag -> Maybe String -> Tag String -> IO (Tag String)
70−convertTag media sourceURL t@(TagOpen tagname as)
70+convertTag :: PandocMonad m => Maybe String -> Tag String -> m (Tag String)
71+convertTag sourceURL t@(TagOpen tagname as)
7172 | tagname `elem`
7273 ["img", "embed", "video", "input", "audio", "source", "track"] = do
7374 as' <- mapM processAttribute as
@@ -75,55 +76,57 @@ convertTag media sourceURL t@(TagOpen tagname as)
7576 where processAttribute (x,y) =
7677 if x == "src" || x == "data-src" || x == "href" || x == "poster"
7778 then do
78− enc <- getDataURI media sourceURL (fromAttrib "type" t) y
79+ enc <- getDataURI sourceURL (fromAttrib "type" t) y
7980 return (x, enc)
8081 else return (x,y)
81−convertTag media sourceURL t@(TagOpen "script" as) =
82+convertTag sourceURL t@(TagOpen "script" as) =
8283 case fromAttrib "src" t of
8384 [] -> return t
8485 src -> do
85− enc <- getDataURI media sourceURL (fromAttrib "type" t) src
86+ enc <- getDataURI sourceURL (fromAttrib "type" t) src
8687 return $ TagOpen "script" (("src",enc) : [(x,y) | (x,y) <- as, x /= "src"])
87−convertTag media sourceURL t@(TagOpen "link" as) =
88+convertTag sourceURL t@(TagOpen "link" as) =
8889 case fromAttrib "href" t of
8990 [] -> return t
9091 src -> do
91− enc <- getDataURI media sourceURL (fromAttrib "type" t) src
92+ enc <- getDataURI sourceURL (fromAttrib "type" t) src
9293 return $ TagOpen "link" (("href",enc) : [(x,y) | (x,y) <- as, x /= "href"])
93−convertTag _ _ t = return t
94+convertTag _ t = return t
9495
95−cssURLs :: MediaBag -> Maybe String -> FilePath -> ByteString
96− -> IO ByteString
97−cssURLs media sourceURL d orig = do
98− res <- runParserT (parseCSSUrls media sourceURL d) () "css" orig
96+cssURLs :: PandocMonad m
97+ => Maybe String -> FilePath -> ByteString -> m ByteString
98+cssURLs sourceURL d orig = do
99+ res <- runParserT (parseCSSUrls sourceURL d) () "css" orig
99100 case res of
100− Left e -> warn ("Could not parse CSS: " ++ show e) >> return orig
101+ Left e -> do
102+ report $ CouldNotParseCSS (show e)
103+ return orig
101104 Right bs -> return bs
102105
103−parseCSSUrls :: MediaBag -> Maybe String -> FilePath
104− -> ParsecT ByteString () IO ByteString
105−parseCSSUrls media sourceURL d = B.concat <$> P.many
106− (pCSSWhite <|> pCSSComment <|> pCSSUrl media sourceURL d <|> pCSSOther)
106+parseCSSUrls :: PandocMonad m
107+ => Maybe String -> FilePath -> ParsecT ByteString () m ByteString
108+parseCSSUrls sourceURL d = B.concat <$> P.many
109+ (pCSSWhite <|> pCSSComment <|> pCSSUrl sourceURL d <|> pCSSOther)
107110
108111-- Note: some whitespace in CSS is significant, so we can't collapse it!
109−pCSSWhite :: ParsecT ByteString () IO ByteString
112+pCSSWhite :: PandocMonad m => ParsecT ByteString () m ByteString
110113pCSSWhite = B.singleton <$> P.space <* P.spaces
111114
112−pCSSComment :: ParsecT ByteString () IO ByteString
115+pCSSComment :: PandocMonad m => ParsecT ByteString () m ByteString
113116pCSSComment = P.try $ do
114117 P.string "/*"
115118 P.manyTill P.anyChar (P.try (P.string "*/"))
116119 return B.empty
117120
118−pCSSOther :: ParsecT ByteString () IO ByteString
121+pCSSOther :: PandocMonad m => ParsecT ByteString () m ByteString
119122pCSSOther = do
120123 (B.pack <$> P.many1 (P.noneOf "u/ \n\r\t")) <|>
121124 (B.singleton <$> P.char 'u') <|>
122125 (B.singleton <$> P.char '/')
123126
124−pCSSUrl :: MediaBag -> Maybe String -> FilePath
125− -> ParsecT ByteString () IO ByteString
126−pCSSUrl media sourceURL d = P.try $ do
127+pCSSUrl :: PandocMonad m
128+ => Maybe String -> FilePath -> ParsecT ByteString () m ByteString
129+pCSSUrl sourceURL d = P.try $ do
127130 P.string "url("
128131 P.spaces
129132 quote <- P.option Nothing (Just <$> P.oneOf "\"'")
@@ -136,30 +139,24 @@ pCSSUrl media sourceURL d = P.try $ do
136139 '#':_ -> return fallback
137140 'd':'a':'t':'a':':':_ -> return fallback
138141 u -> do let url' = if isURI u then u else d </> u
139− enc <- lift $ getDataURI media sourceURL "" url'
142+ enc <- lift $ getDataURI sourceURL "" url'
140143 return (B.pack $ "url(" ++ enc ++ ")")
141144
142145
143−getDataURI :: MediaBag -> Maybe String -> MimeType -> String
144− -> IO String
145−getDataURI _ _ _ src@('d':'a':'t':'a':':':_) = return src -- already data: uri
146−getDataURI media sourceURL mimetype src = do
146+getDataURI :: PandocMonad m => Maybe String -> MimeType -> String -> m String
147+getDataURI _ _ src@('d':'a':'t':'a':':':_) = return src -- already data: uri
148+getDataURI sourceURL mimetype src = do
147149 let ext = map toLower $ takeExtension src
148− fetchResult <- runIO $ do setMediaBag media
149− fetchItem sourceURL src
150− (raw, respMime) <- case fetchResult of
151− Left msg -> err 67 $ "Could not fetch " ++ src ++
152− "\n" ++ show msg
153− Right x -> return x
150+ (raw, respMime) <- fetchItem sourceURL src
154151 let raw' = if ext == ".gz"
155152 then B.concat $ L.toChunks $ Gzip.decompress $ L.fromChunks
156153 $ [raw]
157154 else raw
158− let mime = case (mimetype, respMime) of
159− ("",Nothing) -> error
155+ mime <- case (mimetype, respMime) of
156+ ("",Nothing) -> throwError $ PandocSomeError
160157 $ "Could not determine mime type for `" ++ src ++ "'"
161− (x, Nothing) -> x
162− (_, Just x ) -> x
158+ (x, Nothing) -> return x
159+ (_, Just x ) -> return x
163160 let cssSourceURL = case parseURI src of
164161 Just u
165162 | uriScheme u `elem` ["http:","https:"] ->
@@ -168,14 +165,14 @@ getDataURI media sourceURL mimetype src = do
168165 uriFragment = "" }
169166 _ -> Nothing
170167 result <- if mime == "text/css"
171− then cssURLs media cssSourceURL (takeDirectory src) raw'
168+ then cssURLs cssSourceURL (takeDirectory src) raw'
172169 else return raw'
173170 return $ makeDataURI mime result
174171
175172-- | Convert HTML into self-contained HTML, incorporating images,
176173-- scripts, and CSS using data: URIs.
177−makeSelfContained :: MonadIO m => WriterOptions -> MediaBag -> String -> m String
178−makeSelfContained opts mediabag inp = liftIO $ do
174+makeSelfContained :: PandocMonad m => WriterOptions -> String -> m String
175+makeSelfContained opts inp = do
179176 let tags = parseTags inp
180− out' <- mapM (convertTag mediabag (writerSourceURL opts)) tags
177+ out' <- mapM (convertTag (writerSourceURL opts)) tags
181178 return $ renderTags' out'