@@ -29,7 +29,6 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
29Conversion of 'Pandoc' documents to EPUB.
29Conversion of 'Pandoc' documents to EPUB.
31module Text.Pandoc.Writers.EPUB ( writeEPUB, writeEPUBPure ) where
31module Text.Pandoc.Writers.EPUB ( writeEPUB, writeEPUBPure ) where
32−import Data.IORef ( IORef )
33import qualified Data.Map as M
32import qualified Data.Map as M
34import qualified Data.Set as Set
33import qualified Data.Set as Set
35import Data.Maybe ( fromMaybe, catMaybes )
34import Data.Maybe ( fromMaybe, catMaybes )
@@ -54,7 +53,7 @@ import Text.Pandoc.Options ( WriterOptions(..)
54 , ObfuscationMethod(NoObfuscation) )
53 , ObfuscationMethod(NoObfuscation) )
55import Text.Pandoc.Definition
54import Text.Pandoc.Definition
56import Text.Pandoc.Walk (walk, walkM, query)
55import Text.Pandoc.Walk (walk, walkM, query)
57−import Control.Monad.State (modify, get, State, put, evalState)
56+import Control.Monad.State (modify, get, gets, State, StateT, put, evalState, evalStateT, lift)
58import Control.Monad (mplus, when)
57import Control.Monad (mplus, when)
59import Text.XML.Light ( unode, Element(..), unqual, Attr(..), add_attrs
58import Text.XML.Light ( unode, Element(..), unqual, Attr(..), add_attrs
60 , strContent, lookupAttr, Node(..), QName(..), parseXML
59 , strContent, lookupAttr, Node(..), QName(..), parseXML
@@ -75,6 +74,11 @@ type EPUBAction = PandocAction [(FilePath, (FilePath, Maybe Entry))]
75-- in filenames, chapter0003.xhtml.
74-- in filenames, chapter0003.xhtml.
76data Chapter = Chapter (Maybe [Int]) [Block]
75data Chapter = Chapter (Maybe [Int]) [Block]
77+data EPUBState = EPUBState { stMediaPaths :: [(FilePath, (FilePath, Maybe Entry))]
80+type E = StateT EPUBState EPUBAction
78data EPUBMetadata = EPUBMetadata{
82data EPUBMetadata = EPUBMetadata{
79 epubIdentifier :: [Identifier]
83 epubIdentifier :: [Identifier]
80 , epubTitle :: [Title]
84 , epubTitle :: [Title]
@@ -142,7 +146,7 @@ removeNote :: Inline -> Inline
142removeNote (Note _) = Str ""
146removeNote (Note _) = Str ""
143removeNote x = x
147removeNote x = x
145−getEPUBMetadata :: WriterOptions -> Meta -> EPUBAction EPUBMetadata
149+getEPUBMetadata :: WriterOptions -> Meta -> E EPUBMetadata
146getEPUBMetadata opts meta = do
150getEPUBMetadata opts meta = do
147 let md = metadataFromMeta opts meta
151 let md = metadataFromMeta opts meta
148 let elts = onlyElems $ parseXML $ writerEpubMetadata opts
152 let elts = onlyElems $ parseXML $ writerEpubMetadata opts
@@ -150,7 +154,7 @@ getEPUBMetadata opts meta = do
150 let addIdentifier m =
154 let addIdentifier m =
151 if null (epubIdentifier m)
155 if null (epubIdentifier m)
153− randomId <- fmap show P.newUUID
157+ randomId <- fmap show (lift P.newUUID)
154 return $ m{ epubIdentifier = [Identifier randomId Nothing] }
158 return $ m{ epubIdentifier = [Identifier randomId Nothing] }
155 else return m
159 else return m
156 let addLanguage m =
160 let addLanguage m =
@@ -158,7 +162,7 @@ getEPUBMetadata opts meta = do
158 then case lookup "lang" (writerVariables opts) of
162 then case lookup "lang" (writerVariables opts) of
159 Just x -> return m{ epubLanguage = x }
163 Just x -> return m{ epubLanguage = x }
160 Nothing -> do
164 Nothing -> do
161− mLang <- P.lookupEnv "LANG"
165+ mLang <- lift $ P.lookupEnv "LANG"
162 let localeLang =
166 let localeLang =
163 case mLang of
167 case mLang of
164 Just lang ->
168 Just lang ->
@@ -170,7 +174,7 @@ getEPUBMetadata opts meta = do
170 let fixDate m =
174 let fixDate m =
171 if null (epubDate m)
175 if null (epubDate m)
173− currentTime <- P.getCurrentTime
177+ currentTime <- lift P.getCurrentTime
174 return $ m{ epubDate = [ Date{
178 return $ m{ epubDate = [ Date{
175 dateText = showDateTimeISO8601 currentTime
179 dateText = showDateTimeISO8601 currentTime
176 , dateEvent = Nothing } ] }
180 , dateEvent = Nothing } ] }
@@ -338,12 +342,21 @@ writeEPUB :: WriterOptions -- ^ Writer options
338writeEPUB opts doc = runIO $ writeEPUBPure opts doc
342writeEPUB opts doc = runIO $ writeEPUBPure opts doc
340writeEPUBPure :: WriterOptions -- ^ Writer options
344writeEPUBPure :: WriterOptions -- ^ Writer options
341− -> Pandoc -- ^ Document to convert
345+ -> Pandoc -- ^ Document to convert
342− -> EPUBAction B.ByteString
346+ -> EPUBAction B.ByteString
343−writeEPUBPure opts doc@(Pandoc meta _) = do
347+writeEPUBPure opts doc =
348+ let initState = EPUBState { stMediaPaths = []
351+ evalStateT (pandocToEPUB opts doc) initState
353+pandocToEPUB :: WriterOptions
356+pandocToEPUB opts doc@(Pandoc meta _) = do
344 let version = fromMaybe EPUB2 (writerEpubVersion opts)
357 let version = fromMaybe EPUB2 (writerEpubVersion opts)
345 let epub3 = version == EPUB3
358 let epub3 = version == EPUB3
346− epochtime <- floor <$> P.getPOSIXTime
359+ epochtime <- floor <$> lift P.getPOSIXTime
347 let mkEntry path content = toEntry path epochtime content
360 let mkEntry path content = toEntry path epochtime content
348 let vars = ("epub3", if epub3 then "true" else "false")
361 let vars = ("epub3", if epub3 then "true" else "false")
349 : ("css", "stylesheet.css")
362 : ("css", "stylesheet.css")
@@ -368,7 +381,7 @@ writeEPUBPure opts doc@(Pandoc meta _) = do
368 let cpContent = renderHtml $ writeHtml
381 let cpContent = renderHtml $ writeHtml
369 opts'{ writerVariables = ("coverpage","true"):vars }
382 opts'{ writerVariables = ("coverpage","true"):vars }
370 (Pandoc meta [RawBlock (Format "html") $ "<div id=\"cover-image\">\n<img src=\"" ++ coverImage ++ "\" alt=\"cover image\" />\n</div>"])
383 (Pandoc meta [RawBlock (Format "html") $ "<div id=\"cover-image\">\n<img src=\"" ++ coverImage ++ "\" alt=\"cover image\" />\n</div>"])
371− imgContent <- P.readFileLazy img
384+ imgContent <- lift $ P.readFileLazy img
372 return ( [mkEntry "cover.xhtml" cpContent]
385 return ( [mkEntry "cover.xhtml" cpContent]
373 , [mkEntry coverImage imgContent] )
386 , [mkEntry coverImage imgContent] )
@@ -379,18 +392,17 @@ writeEPUBPure opts doc@(Pandoc meta _) = do
379 let tpEntry = mkEntry "title_page.xhtml" tpContent
392 let tpEntry = mkEntry "title_page.xhtml" tpContent
381 -- handle pictures
394 -- handle pictures
382− mediaRef <- P.newIORef []
395+ -- mediaRef <- P.newIORef []
383− Pandoc _ blocks <- walkM (transformInline opts' mediaRef) doc >>=
396+ Pandoc _ blocks <- walkM (transformInline opts') doc >>=
384− walkM (transformBlock opts' mediaRef)
397+ walkM (transformBlock opts')
385− picEntries <- (catMaybes . map (snd . snd)) <$> P.readIORef mediaRef
398+ picEntries <- (catMaybes . map (snd . snd)) <$> (gets stMediaPaths)
387 -- handle fonts
399 -- handle fonts
388 let matchingGlob f = do
400 let matchingGlob f = do
389− xs <- P.namesMatching f
401+ xs <- lift $ P.namesMatching f
390 when (null xs) $
402 when (null xs) $
391− P.warn $ f ++ " did not match any font files."
403+ lift $ P.warn $ f ++ " did not match any font files."
392 return xs
404 return xs
393− let mkFontEntry f = mkEntry (takeFileName f) `fmap` P.readFileLazy f
405+ let mkFontEntry f = mkEntry (takeFileName f) `fmap` (lift $ P.readFileLazy f)
394 fontFiles <- concat <$> mapM matchingGlob (writerEpubFonts opts')
406 fontFiles <- concat <$> mapM matchingGlob (writerEpubFonts opts')
395 fontEntries <- mapM mkFontEntry fontFiles
407 fontEntries <- mapM mkFontEntry fontFiles
@@ -527,7 +539,7 @@ writeEPUBPure opts doc@(Pandoc meta _) = do
527 let uuid = case epubIdentifier metadata of
539 let uuid = case epubIdentifier metadata of
528 (x:_) -> identifierText x -- use first identifier as UUID
540 (x:_) -> identifierText x -- use first identifier as UUID
529 [] -> error "epubIdentifier is null" -- shouldn't happen
541 [] -> error "epubIdentifier is null" -- shouldn't happen
530− currentTime <- P.getCurrentTime
542+ currentTime <- lift $ P.getCurrentTime
531 let contentsData = UTF8.fromStringLazy $ ppTopElement $
543 let contentsData = UTF8.fromStringLazy $ ppTopElement $
532 unode "package" ! [("version", case version of
544 unode "package" ! [("version", case version of
533 EPUB2 -> "2.0"
545 EPUB2 -> "2.0"
@@ -699,10 +711,10 @@ writeEPUBPure opts doc@(Pandoc meta _) = do
700 -- stylesheet
712 -- stylesheet
701 stylesheet <- case epubStylesheet metadata of
713 stylesheet <- case epubStylesheet metadata of
702− Just (StylesheetPath fp) -> P.readFileUTF8 fp
714+ Just (StylesheetPath fp) -> lift $ P.readFileUTF8 fp
703 Just (StylesheetContents s) -> return s
715 Just (StylesheetContents s) -> return s
704 Nothing -> UTF8.toString `fmap`
716 Nothing -> UTF8.toString `fmap`
705− P.readDataFile (writerUserDataDir opts) "epub.css"
717+ (lift $ P.readDataFile (writerUserDataDir opts) "epub.css")
706 let stylesheetEntry = mkEntry "stylesheet.css" $ UTF8.fromStringLazy stylesheet
718 let stylesheetEntry = mkEntry "stylesheet.css" $ UTF8.fromStringLazy stylesheet
708 -- construct archive
720 -- construct archive
@@ -819,78 +831,77 @@ showDateTimeISO8601 :: UTCTime -> String
819showDateTimeISO8601 = formatTime defaultTimeLocale "%FT%TZ"
831showDateTimeISO8601 = formatTime defaultTimeLocale "%FT%TZ"
821transformTag :: WriterOptions
833transformTag :: WriterOptions
822− -> IORef [(FilePath, (FilePath, Maybe Entry))] -- ^ (oldpath, newpath, entry) media
834+ -- -> IORef [(FilePath, (FilePath, Maybe Entry))] -- ^ (oldpath, newpath, entry) media
823 -> Tag String
835 -> Tag String
824− -> EPUBAction (Tag String)
836+ -> E (Tag String)
825−transformTag opts mediaRef tag@(TagOpen name attr)
837+transformTag opts tag@(TagOpen name attr)
826 | name `elem` ["video", "source", "img", "audio"] &&
838 | name `elem` ["video", "source", "img", "audio"] &&
827 lookup "data-external" attr == Nothing = do
839 lookup "data-external" attr == Nothing = do
828 let src = fromAttrib "src" tag
840 let src = fromAttrib "src" tag
829 let poster = fromAttrib "poster" tag
841 let poster = fromAttrib "poster" tag
830− newsrc <- modifyMediaRef opts mediaRef src
842+ newsrc <- modifyMediaRef opts src
831− newposter <- modifyMediaRef opts mediaRef poster
843+ newposter <- modifyMediaRef opts poster
832 let attr' = filter (\(x,_) -> x /= "src" && x /= "poster") attr ++
844 let attr' = filter (\(x,_) -> x /= "src" && x /= "poster") attr ++
833 [("src", newsrc) | not (null newsrc)] ++
845 [("src", newsrc) | not (null newsrc)] ++
834 [("poster", newposter) | not (null newposter)]
846 [("poster", newposter) | not (null newposter)]
835 return $ TagOpen name attr'
847 return $ TagOpen name attr'
836−transformTag _ _ tag = return tag
848+transformTag _ tag = return tag
838modifyMediaRef :: WriterOptions
850modifyMediaRef :: WriterOptions
839− -> IORef [(FilePath, (FilePath, Maybe Entry))]
840 -> FilePath
851 -> FilePath
841− -> EPUBAction FilePath
852+ -> E FilePath
842−modifyMediaRef _ _ "" = return ""
853+modifyMediaRef _ "" = return ""
843−modifyMediaRef opts mediaRef oldsrc = do
854+modifyMediaRef opts oldsrc = do
844− media <- P.readIORef mediaRef
855+ media <- gets stMediaPaths
845 case lookup oldsrc media of
856 case lookup oldsrc media of
846 Just (n,_) -> return n
857 Just (n,_) -> return n
847 Nothing -> do
858 Nothing -> do
848− res <- P.fetchItem' (writerMediaBag opts)
859+ res <- lift $ P.fetchItem' (writerMediaBag opts)
849 (writerSourceURL opts) oldsrc
860 (writerSourceURL opts) oldsrc
850 (new, mbEntry) <-
861 (new, mbEntry) <-
851 case res of
862 case res of
852 Left _ -> do
863 Left _ -> do
853− P.warn $ "Could not find media `" ++ oldsrc ++ "', skipping..."
864+ lift $ P.warn $ "Could not find media `" ++ oldsrc ++ "', skipping..."
854 return (oldsrc, Nothing)
865 return (oldsrc, Nothing)
855 Right (img,mbMime) -> do
866 Right (img,mbMime) -> do
856 let new = "media/file" ++ show (length media) ++
867 let new = "media/file" ++ show (length media) ++
857 fromMaybe (takeExtension (takeWhile (/='?') oldsrc))
868 fromMaybe (takeExtension (takeWhile (/='?') oldsrc))
858 (('.':) <$> (mbMime >>= extensionFromMimeType))
869 (('.':) <$> (mbMime >>= extensionFromMimeType))
859− epochtime <- floor `fmap` P.getPOSIXTime
870+ epochtime <- floor `fmap` lift P.getPOSIXTime
860 let entry = toEntry new epochtime $ B.fromChunks . (:[]) $ img
871 let entry = toEntry new epochtime $ B.fromChunks . (:[]) $ img
861 return (new, Just entry)
872 return (new, Just entry)
862− P.modifyIORef mediaRef ( (oldsrc, (new, mbEntry)): )
873+ modify $ \st -> st{ stMediaPaths = (oldsrc, (new, mbEntry)):media}
863 return new
874 return new
865transformBlock :: WriterOptions
876transformBlock :: WriterOptions
866− -> IORef [(FilePath, (FilePath, Maybe Entry))] -- ^ (oldpath, newpath, entry) media
877+ -- -> IORef [(FilePath, (FilePath, Maybe Entry))] -- ^ (oldpath, newpath, entry) media
868− -> EPUBAction Block
879+ -> E Block
869−transformBlock opts mediaRef (RawBlock fmt raw)
880+transformBlock opts (RawBlock fmt raw)
870 | fmt == Format "html" = do
881 | fmt == Format "html" = do
871 let tags = parseTags raw
882 let tags = parseTags raw
872− tags' <- mapM (transformTag opts mediaRef) tags
883+ tags' <- mapM (transformTag opts) tags
873 return $ RawBlock fmt (renderTags' tags')
884 return $ RawBlock fmt (renderTags' tags')
874−transformBlock _ _ b = return b
885+transformBlock _ b = return b
876transformInline :: WriterOptions
887transformInline :: WriterOptions
877− -> IORef [(FilePath, (FilePath, Maybe Entry))] -- ^ (oldpath, newpath) media
888+ -- -> IORef [(FilePath, (FilePath, Maybe Entry))] -- ^ (oldpath, newpath) media
878 -> Inline
889 -> Inline
879− -> EPUBAction Inline
890+ -> E Inline
880−transformInline opts mediaRef (Image attr lab (src,tit)) = do
891+transformInline opts (Image attr lab (src,tit)) = do
881− newsrc <- modifyMediaRef opts mediaRef src
892+ newsrc <- modifyMediaRef opts src
882 return $ Image attr lab (newsrc, tit)
893 return $ Image attr lab (newsrc, tit)
883−transformInline opts mediaRef (x@(Math t m))
894+transformInline opts (x@(Math t m))
884 | WebTeX url <- writerHTMLMathMethod opts = do
895 | WebTeX url <- writerHTMLMathMethod opts = do
885− newsrc <- modifyMediaRef opts mediaRef (url ++ urlEncode m)
896+ newsrc <- modifyMediaRef opts (url ++ urlEncode m)
886 let mathclass = if t == DisplayMath then "display" else "inline"
897 let mathclass = if t == DisplayMath then "display" else "inline"
887 return $ Span ("",["math",mathclass],[]) [Image nullAttr [x] (newsrc, "")]
898 return $ Span ("",["math",mathclass],[]) [Image nullAttr [x] (newsrc, "")]
888−transformInline opts mediaRef (RawInline fmt raw)
899+transformInline opts (RawInline fmt raw)
889 | fmt == Format "html" = do
900 | fmt == Format "html" = do
890 let tags = parseTags raw
901 let tags = parseTags raw
891− tags' <- mapM (transformTag opts mediaRef) tags
902+ tags' <- mapM (transformTag opts) tags
892 return $ RawInline fmt (renderTags' tags')
903 return $ RawInline fmt (renderTags' tags')
893−transformInline _ _ x = return x
904+transformInline _ x = return x
895(!) :: (t -> Element) -> [(String, String)] -> t -> Element
906(!) :: (t -> Element) -> [(String, String)] -> t -> Element
896(!) f attrs n = add_attrs (map (\(k,v) -> Attr (unqual k) v) attrs) (f n)
907(!) f attrs n = add_attrs (map (\(k,v) -> Attr (unqual k) v) attrs) (f n)