summaryrefslogtreecommitdiff
path: root/src/Text/Pandoc/SelfContained.hs
diff options
context:
space:
mode:
authorJohn MacFarlane <jgm@berkeley.edu>2017-02-24 13:11:29 +0100
committerJohn MacFarlane <jgm@berkeley.edu>2017-02-24 13:11:29 +0100
commitce647d1cd8e399ef895c0901cdb4cf52823de05e (patch)
treef6b1d51d940295ddf0445677a32eb8b79edfc0c7 /src/Text/Pandoc/SelfContained.hs
parent7c0a80c323f81e6262848bfcfc922301e3f406e0 (diff)
Some fixes to the preceding revisions in SelfContained.
Make sure we don't duplicate end tags for script or link.
Diffstat (limited to 'src/Text/Pandoc/SelfContained.hs')
-rw-r--r--src/Text/Pandoc/SelfContained.hs69
1 files changed, 42 insertions, 27 deletions
diff --git a/src/Text/Pandoc/SelfContained.hs b/src/Text/Pandoc/SelfContained.hs
index 8cbd70e26..e6d859421 100644
--- a/src/Text/Pandoc/SelfContained.hs
+++ b/src/Text/Pandoc/SelfContained.hs
@@ -67,57 +67,72 @@ makeDataURI (mime, raw) =
then mime ++ ";charset=utf-8"
else mime -- mime type already has charset
-convertTag :: PandocMonad m => Maybe String -> Tag String -> m [Tag String]
-convertTag sourceURL t@(TagOpen tagname as)
+convertTags :: PandocMonad m => Maybe String -> [Tag String] -> m [Tag String]
+convertTags _ [] = return []
+convertTags sourceURL (t@(TagOpen tagname as):ts)
| tagname `elem`
["img", "embed", "video", "input", "audio", "source", "track"] = do
as' <- mapM processAttribute as
- return [TagOpen tagname as']
+ rest <- convertTags sourceURL ts
+ return $ TagOpen tagname as' : rest
where processAttribute (x,y) =
if x == "src" || x == "data-src" || x == "href" || x == "poster"
then do
enc <- getDataURI sourceURL (fromAttrib "type" t) y
return (x, enc)
else return (x,y)
-convertTag sourceURL t@(TagOpen "script" as) =
+convertTags sourceURL (t@(TagOpen "script" as):TagClose "script":ts) =
case fromAttrib "src" t of
- [] -> return [t]
+ [] -> (t:) <$> convertTags sourceURL ts
src -> do
let typeAttr = fromAttrib "type" t
res <- getData sourceURL typeAttr src
+ rest <- convertTags sourceURL ts
case res of
- Left dataUri -> return [TagOpen "script"
- (("src",dataUri) : [(x,y) | (x,y) <- as, x /= "src"])]
+ Left dataUri -> return $ TagOpen "script"
+ (("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") &&
- not ("</" `B.isInfixOf` bs) ->
- return [
+ not ("</script" `B.isInfixOf` bs) ->
+ return $
TagOpen "script" [("type", typeAttr)|not (null typeAttr)]
- , TagText (toString bs)
- , TagClose "script" ]
- | otherwise -> return [TagOpen "script"
- (("src",makeDataURI (mime, bs)) :
- [(x,y) | (x,y) <- as, x /= "src"])]
-convertTag sourceURL t@(TagOpen "link" as) =
+ : TagText (toString bs)
+ : TagClose "script"
+ : rest
+ | otherwise ->
+ return $ TagOpen "script"
+ (("src",makeDataURI (mime, bs)) :
+ [(x,y) | (x,y) <- as, x /= "src"]) :
+ TagClose "script" : rest
+convertTags sourceURL (t@(TagOpen "link" as):ts) =
case fromAttrib "href" t of
- [] -> return [t]
+ [] -> (t:) <$> convertTags sourceURL ts
src -> do
res <- getData sourceURL (fromAttrib "type" t) src
case res of
- Left dataUri -> return [TagOpen "link"
- (("href",dataUri) : [(x,y) | (x,y) <- as, x /= "href"])]
+ Left dataUri -> do
+ rest <- convertTags sourceURL ts
+ return $ TagOpen "link"
+ (("href",dataUri) : [(x,y) | (x,y) <- as, x /= "href"]) :
+ rest
Right (mime, bs)
- | mime == "text/css" && not ("</" `B.isInfixOf` bs) ->
- return [
+ | mime == "text/css" && not ("</" `B.isInfixOf` bs) -> do
+ rest <- convertTags sourceURL $
+ dropWhile (==TagClose "link") ts
+ return $
TagOpen "style" [("type", "text/css")]
- , TagText (toString bs)
- , TagClose "style" ]
- | otherwise -> return [TagOpen "link"
- (("href",makeDataURI (mime, bs)) :
- [(x,y) | (x,y) <- as, x /= "href"])]
-convertTag _ t = return [t]
+ : TagText (toString bs)
+ : TagClose "style"
+ : rest
+ | otherwise -> do
+ rest <- convertTags sourceURL ts
+ return $ TagOpen "link"
+ (("href",makeDataURI (mime, bs)) :
+ [(x,y) | (x,y) <- as, x /= "href"]) : rest
+convertTags sourceURL (t:ts) = (t:) <$> convertTags sourceURL ts
cssURLs :: PandocMonad m
=> Maybe String -> FilePath -> ByteString -> m ByteString
@@ -210,5 +225,5 @@ getData sourceURL mimetype src = do
makeSelfContained :: PandocMonad m => WriterOptions -> String -> m String
makeSelfContained opts inp = do
let tags = parseTags inp
- out' <- concat <$> mapM (convertTag (writerSourceURL opts)) tags
+ out' <- convertTags (writerSourceURL opts) tags
return $ renderTags' out'