aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/Text/Pandoc/Writers/EPUB.hs23
1 files changed, 16 insertions, 7 deletions
diff --git a/src/Text/Pandoc/Writers/EPUB.hs b/src/Text/Pandoc/Writers/EPUB.hs
index 82b6e8221..82a6b4403 100644
--- a/src/Text/Pandoc/Writers/EPUB.hs
+++ b/src/Text/Pandoc/Writers/EPUB.hs
@@ -67,6 +67,7 @@ data Chapter = Chapter (Maybe [Int]) [Block]
data EPUBState = EPUBState {
stMediaPaths :: [(FilePath, (FilePath, Maybe Entry))]
+ , stMediaNextId :: Int
, stEpubSubdir :: String
}
@@ -390,7 +391,7 @@ writeEPUB epubVersion opts doc = do
-- sanity check on epubSubdir
unless (all (\c -> isAscii c && isAlphaNum c) epubSubdir) $
throwError $ PandocEpubSubdirectoryError epubSubdir
- let initState = EPUBState { stMediaPaths = [], stEpubSubdir = epubSubdir }
+ let initState = EPUBState { stMediaPaths = [], stMediaNextId = 0, stEpubSubdir = epubSubdir }
evalStateT (pandocToEPUB epubVersion opts doc) initState
pandocToEPUB :: PandocMonad m
@@ -994,17 +995,25 @@ modifyMediaRef oldsrc = do
Just (n,_) -> return n
Nothing -> catchError
(do (img, mbMime) <- P.fetchItem oldsrc
- let new = "media/file" ++ show (length media) ++
- fromMaybe (takeExtension (takeWhile (/='?') oldsrc))
- (('.':) <$> (mbMime >>= extensionFromMimeType))
- entry <- mkEntry new (B.fromChunks . (:[]) $ img)
+ let ext = fromMaybe (takeExtension (takeWhile (/='?') oldsrc))
+ (('.':) <$> (mbMime >>= extensionFromMimeType))
+ newName <- getMediaNextNewName ext
+ let newPath = "media/" ++ newName
+ entry <- mkEntry newPath (B.fromChunks . (:[]) $ img)
modify $ \st -> st{ stMediaPaths =
- (oldsrc, (new, Just entry)):media}
- return new)
+ (oldsrc, (newPath, Just entry)):media}
+ return newPath)
(\e -> do
report $ CouldNotFetchResource oldsrc (show e)
return oldsrc)
+getMediaNextNewName :: PandocMonad m => String -> E m String
+getMediaNextNewName ext = do
+ nextId <- gets stMediaNextId
+ modify $ \st -> st { stMediaNextId = nextId + 1 }
+ let nextName = "file" ++ show nextId ++ ext
+ (P.fetchItem nextName >> getMediaNextNewName ext) `catchError` const (return nextName)
+
transformBlock :: PandocMonad m
=> Block
-> E m Block