@@ -31,7 +31,7 @@ Conversion of 'Pandoc' documents to EPUB.
3131module Text.Pandoc.Writers.EPUB ( writeEPUB ) where
3232import Data.IORef ( IORef, newIORef, readIORef, modifyIORef )
3333import qualified Data.Map as M
34−import Data.Maybe ( fromMaybe )
34+import Data.Maybe ( fromMaybe, catMaybes )
3535import Data.List ( isPrefixOf, isInfixOf, intercalate )
3636import System.Environment ( getEnv )
3737import Text.Printf (printf)
@@ -60,14 +60,14 @@ import Text.Pandoc.Walk (walk, walkM)
6060import Data.Default
6161import Text.Pandoc.Writers.Markdown (writePlain)
6262import Control.Monad.State (modify, get, execState, State, put, evalState)
63−import Control.Monad (foldM, mplus, liftM, when)
63+import Control.Monad (mplus, liftM, when)
6464import Text.XML.Light ( unode, Element(..), unqual, Attr(..), add_attrs
6565 , strContent, lookupAttr, Node(..), QName(..), parseXML
6666 , onlyElems, node, ppElement)
6767import Text.Pandoc.UUID (getRandomUUID)
6868import Text.Pandoc.Writers.HTML (writeHtmlString, writeHtml)
6969import Data.Char ( toLower, isDigit, isAlphaNum )
70−import Text.Pandoc.MIME (MimeType, getMimeType)
70+import Text.Pandoc.MIME (MimeType, getMimeType, extensionFromMimeType)
7171import qualified Control.Exception as E
7272import Text.Blaze.Html.Renderer.Utf8 (renderHtml)
7373import Text.HTML.TagSoup (Tag(TagOpen), fromAttrib, parseTags)
@@ -378,17 +378,7 @@ writeEPUB opts doc@(Pandoc meta _) = do
378378 mediaRef <- newIORef []
379379 Pandoc _ blocks <- walkM (transformInline opts' mediaRef) doc >>=
380380 walkM (transformBlock opts' mediaRef)
381− pics <- readIORef mediaRef
382− let readPicEntry entries (oldsrc, newsrc) = do
383− res <- fetchItem' (writerMediaBag opts')
384− (writerSourceURL opts') oldsrc
385− case res of
386− Left _ -> do
387− warn $ "Could not find media `" ++ oldsrc ++ "', skipping..."
388− return entries
389− Right (img,_) -> return $
390− (toEntry newsrc epochtime $ B.fromChunks . (:[]) $ img) : entries
391− picEntries <- foldM readPicEntry [] pics
381+ picEntries <- (catMaybes . map (snd . snd)) <$> readIORef mediaRef
392382
393383 -- handle fonts
394384 let matchingGlob f = do
@@ -794,59 +784,75 @@ metadataElement version md currentTime =
794784showDateTimeISO8601 :: UTCTime -> String
795785showDateTimeISO8601 = formatTime defaultTimeLocale "%FT%TZ"
796786
797−transformTag :: IORef [(FilePath, FilePath)] -- ^ (oldpath, newpath) media
787+transformTag :: WriterOptions
788+ -> IORef [(FilePath, (FilePath, Maybe Entry))] -- ^ (oldpath, newpath, entry) media
798789 -> Tag String
799790 -> IO (Tag String)
800−transformTag mediaRef tag@(TagOpen name attr)
791+transformTag opts mediaRef tag@(TagOpen name attr)
801792 | name `elem` ["video", "source", "img", "audio"] = do
802793 let src = fromAttrib "src" tag
803794 let poster = fromAttrib "poster" tag
804− newsrc <- modifyMediaRef mediaRef src
805− newposter <- modifyMediaRef mediaRef poster
795+ newsrc <- modifyMediaRef opts mediaRef src
796+ newposter <- modifyMediaRef opts mediaRef poster
806797 let attr' = filter (\(x,_) -> x /= "src" && x /= "poster") attr ++
807798 [("src", newsrc) | not (null newsrc)] ++
808799 [("poster", newposter) | not (null newposter)]
809800 return $ TagOpen name attr'
810−transformTag _ tag = return tag
811−
812−modifyMediaRef :: IORef [(FilePath, FilePath)] -> FilePath -> IO FilePath
813−modifyMediaRef _ "" = return ""
814−modifyMediaRef mediaRef oldsrc = do
801+transformTag _ _ tag = return tag
802+
803+modifyMediaRef :: WriterOptions
804+ -> IORef [(FilePath, (FilePath, Maybe Entry))]
805+ -> FilePath
806+ -> IO FilePath
807+modifyMediaRef _ _ "" = return ""
808+modifyMediaRef opts mediaRef oldsrc = do
815809 media <- readIORef mediaRef
816810 case lookup oldsrc media of
817− Just n -> return n
818− Nothing -> do
819− let new = "media/file" ++ show (length media) ++
820− takeExtension (takeWhile (/='?') oldsrc) -- remove query
821− modifyIORef mediaRef ( (oldsrc, new): )
811+ Just (n,_) -> return n
812+ Nothing -> do
813+ res <- fetchItem' (writerMediaBag opts)
814+ (writerSourceURL opts) oldsrc
815+ (new, mbEntry) <-
816+ case res of
817+ Left _ -> do
818+ warn $ "Could not find media `" ++ oldsrc ++ "', skipping..."
819+ return (oldsrc, Nothing)
820+ Right (img,mbMime) -> do
821+ let new = "media/file" ++ show (length media) ++
822+ fromMaybe (takeExtension (takeWhile (/='?') oldsrc))
823+ (('.':) <$> (mbMime >>= extensionFromMimeType))
824+ epochtime <- floor `fmap` getPOSIXTime
825+ let entry = toEntry new epochtime $ B.fromChunks . (:[]) $ img
826+ return (new, Just entry)
827+ modifyIORef mediaRef ( (oldsrc, (new, mbEntry)): )
822828 return new
823829
824830transformBlock :: WriterOptions
825− -> IORef [(FilePath, FilePath)] -- ^ (oldpath, newpath) media
831+ -> IORef [(FilePath, (FilePath, Maybe Entry))] -- ^ (oldpath, newpath, entry) media
826832 -> Block
827833 -> IO Block
828−transformBlock _ mediaRef (RawBlock fmt raw)
834+transformBlock opts mediaRef (RawBlock fmt raw)
829835 | fmt == Format "html" = do
830836 let tags = parseTags raw
831− tags' <- mapM (transformTag mediaRef) tags
837+ tags' <- mapM (transformTag opts mediaRef) tags
832838 return $ RawBlock fmt (renderTags' tags')
833839transformBlock _ _ b = return b
834840
835841transformInline :: WriterOptions
836− -> IORef [(FilePath, FilePath)] -- ^ (oldpath, newpath) media
842+ -> IORef [(FilePath, (FilePath, Maybe Entry))] -- ^ (oldpath, newpath) media
837843 -> Inline
838844 -> IO Inline
839−transformInline _ mediaRef (Image lab (src,tit)) = do
840− newsrc <- modifyMediaRef mediaRef src
845+transformInline opts mediaRef (Image lab (src,tit)) = do
846+ newsrc <- modifyMediaRef opts mediaRef src
841847 return $ Image lab (newsrc, tit)
842848transformInline opts _ (x@(Math _ _))
843849 | WebTeX _ <- writerHTMLMathMethod opts = do
844850 raw <- makeSelfContained opts $ writeHtmlInline opts x
845851 return $ RawInline (Format "html") raw
846−transformInline _ mediaRef (RawInline fmt raw)
852+transformInline opts mediaRef (RawInline fmt raw)
847853 | fmt == Format "html" = do
848854 let tags = parseTags raw
849− tags' <- mapM (transformTag mediaRef) tags
855+ tags' <- mapM (transformTag opts mediaRef) tags
850856 return $ RawInline fmt (renderTags' tags')
851857transformInline _ _ x = return x
852858