@@ -29,7 +29,6 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
2929Conversion of 'Pandoc' documents to EPUB.
3030-}
3131module Text.Pandoc.Writers.EPUB ( writeEPUB, writeEPUBPure ) where
32−import Data.IORef ( IORef )
3332import qualified Data.Map as M
3433import qualified Data.Set as Set
3534import Data.Maybe ( fromMaybe, catMaybes )
@@ -54,7 +53,7 @@ import Text.Pandoc.Options ( WriterOptions(..)
5453 , ObfuscationMethod(NoObfuscation) )
5554import Text.Pandoc.Definition
5655import 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)
5857import Control.Monad (mplus, when)
5958import Text.XML.Light ( unode, Element(..), unqual, Attr(..), add_attrs
6059 , strContent, lookupAttr, Node(..), QName(..), parseXML
@@ -75,6 +74,11 @@ type EPUBAction = PandocAction [(FilePath, (FilePath, Maybe Entry))]
7574-- in filenames, chapter0003.xhtml.
7675data Chapter = Chapter (Maybe [Int]) [Block]
7776
77+data EPUBState = EPUBState { stMediaPaths :: [(FilePath, (FilePath, Maybe Entry))]
78+ }
79+
80+type E = StateT EPUBState EPUBAction
81+
7882data EPUBMetadata = EPUBMetadata{
7983 epubIdentifier :: [Identifier]
8084 , epubTitle :: [Title]
@@ -142,7 +146,7 @@ removeNote :: Inline -> Inline
142146removeNote (Note _) = Str ""
143147removeNote x = x
144148
145−getEPUBMetadata :: WriterOptions -> Meta -> EPUBAction EPUBMetadata
149+getEPUBMetadata :: WriterOptions -> Meta -> E EPUBMetadata
146150getEPUBMetadata opts meta = do
147151 let md = metadataFromMeta opts meta
148152 let elts = onlyElems $ parseXML $ writerEpubMetadata opts
@@ -150,7 +154,7 @@ getEPUBMetadata opts meta = do
150154 let addIdentifier m =
151155 if null (epubIdentifier m)
152156 then do
153− randomId <- fmap show P.newUUID
157+ randomId <- fmap show (lift P.newUUID)
154158 return $ m{ epubIdentifier = [Identifier randomId Nothing] }
155159 else return m
156160 let addLanguage m =
@@ -158,7 +162,7 @@ getEPUBMetadata opts meta = do
158162 then case lookup "lang" (writerVariables opts) of
159163 Just x -> return m{ epubLanguage = x }
160164 Nothing -> do
161− mLang <- P.lookupEnv "LANG"
165+ mLang <- lift $ P.lookupEnv "LANG"
162166 let localeLang =
163167 case mLang of
164168 Just lang ->
@@ -170,7 +174,7 @@ getEPUBMetadata opts meta = do
170174 let fixDate m =
171175 if null (epubDate m)
172176 then do
173− currentTime <- P.getCurrentTime
177+ currentTime <- lift P.getCurrentTime
174178 return $ m{ epubDate = [ Date{
175179 dateText = showDateTimeISO8601 currentTime
176180 , dateEvent = Nothing } ] }
@@ -338,12 +342,21 @@ writeEPUB :: WriterOptions -- ^ Writer options
338342writeEPUB opts doc = runIO $ writeEPUBPure opts doc
339343
340344writeEPUBPure :: WriterOptions -- ^ Writer options
341− -> Pandoc -- ^ Document to convert
342− -> EPUBAction B.ByteString
343−writeEPUBPure opts doc@(Pandoc meta _) = do
345+ -> Pandoc -- ^ Document to convert
346+ -> EPUBAction B.ByteString
347+writeEPUBPure opts doc =
348+ let initState = EPUBState { stMediaPaths = []
349+ }
350+ in
351+ evalStateT (pandocToEPUB opts doc) initState
352+
353+pandocToEPUB :: WriterOptions
354+ -> Pandoc
355+ -> E B.ByteString
356+pandocToEPUB opts doc@(Pandoc meta _) = do
344357 let version = fromMaybe EPUB2 (writerEpubVersion opts)
345358 let epub3 = version == EPUB3
346− epochtime <- floor <$> P.getPOSIXTime
359+ epochtime <- floor <$> lift P.getPOSIXTime
347360 let mkEntry path content = toEntry path epochtime content
348361 let vars = ("epub3", if epub3 then "true" else "false")
349362 : ("css", "stylesheet.css")
@@ -369,7 +382,7 @@ writeEPUBPure opts doc@(Pandoc meta _) = do
369382 let cpContent = renderHtml $ writeHtml
370383 opts'{ writerVariables = ("coverpage","true"):vars }
371384 (Pandoc meta [RawBlock (Format "html") $ "<div id=\"cover-image\">\n<img src=\"" ++ coverImage ++ "\" alt=\"cover image\" />\n</div>"])
372− imgContent <- P.readFileLazy img
385+ imgContent <- lift $ P.readFileLazy img
373386 return ( [mkEntry "cover.xhtml" cpContent]
374387 , [mkEntry coverImage imgContent] )
375388
@@ -380,18 +393,17 @@ writeEPUBPure opts doc@(Pandoc meta _) = do
380393 let tpEntry = mkEntry "title_page.xhtml" tpContent
381394
382395 -- handle pictures
383− mediaRef <- P.newIORef []
384− Pandoc _ blocks <- walkM (transformInline opts' mediaRef) doc >>=
385− walkM (transformBlock opts' mediaRef)
386− picEntries <- (catMaybes . map (snd . snd)) <$> P.readIORef mediaRef
387−
396+ -- mediaRef <- P.newIORef []
397+ Pandoc _ blocks <- walkM (transformInline opts') doc >>=
398+ walkM (transformBlock opts')
399+ picEntries <- (catMaybes . map (snd . snd)) <$> (gets stMediaPaths)
388400 -- handle fonts
389401 let matchingGlob f = do
390− xs <- P.namesMatching f
402+ xs <- lift $ P.namesMatching f
391403 when (null xs) $
392− P.warn $ f ++ " did not match any font files."
404+ lift $ P.warn $ f ++ " did not match any font files."
393405 return xs
394− let mkFontEntry f = mkEntry (takeFileName f) `fmap` P.readFileLazy f
406+ let mkFontEntry f = mkEntry (takeFileName f) `fmap` (lift $ P.readFileLazy f)
395407 fontFiles <- concat <$> mapM matchingGlob (writerEpubFonts opts')
396408 fontEntries <- mapM mkFontEntry fontFiles
397409
@@ -528,7 +540,7 @@ writeEPUBPure opts doc@(Pandoc meta _) = do
528540 let uuid = case epubIdentifier metadata of
529541 (x:_) -> identifierText x -- use first identifier as UUID
530542 [] -> error "epubIdentifier is null" -- shouldn't happen
531− currentTime <- P.getCurrentTime
543+ currentTime <- lift $ P.getCurrentTime
532544 let contentsData = UTF8.fromStringLazy $ ppTopElement $
533545 unode "package" ! [("version", case version of
534546 EPUB2 -> "2.0"
@@ -700,10 +712,10 @@ writeEPUBPure opts doc@(Pandoc meta _) = do
700712
701713 -- stylesheet
702714 stylesheet <- case epubStylesheet metadata of
703− Just (StylesheetPath fp) -> P.readFileUTF8 fp
715+ Just (StylesheetPath fp) -> lift $ P.readFileUTF8 fp
704716 Just (StylesheetContents s) -> return s
705717 Nothing -> UTF8.toString `fmap`
706− P.readDataFile (writerUserDataDir opts) "epub.css"
718+ (lift $ P.readDataFile (writerUserDataDir opts) "epub.css")
707719 let stylesheetEntry = mkEntry "stylesheet.css" $ UTF8.fromStringLazy stylesheet
708720
709721 -- construct archive
@@ -820,78 +832,77 @@ showDateTimeISO8601 :: UTCTime -> String
820832showDateTimeISO8601 = formatTime defaultTimeLocale "%FT%TZ"
821833
822834transformTag :: WriterOptions
823− -> IORef [(FilePath, (FilePath, Maybe Entry))] -- ^ (oldpath, newpath, entry) media
835+ -- -> IORef [(FilePath, (FilePath, Maybe Entry))] -- ^ (oldpath, newpath, entry) media
824836 -> Tag String
825− -> EPUBAction (Tag String)
826−transformTag opts mediaRef tag@(TagOpen name attr)
837+ -> E (Tag String)
838+transformTag opts tag@(TagOpen name attr)
827839 | name `elem` ["video", "source", "img", "audio"] &&
828840 lookup "data-external" attr == Nothing = do
829841 let src = fromAttrib "src" tag
830842 let poster = fromAttrib "poster" tag
831− newsrc <- modifyMediaRef opts mediaRef src
832− newposter <- modifyMediaRef opts mediaRef poster
843+ newsrc <- modifyMediaRef opts src
844+ newposter <- modifyMediaRef opts poster
833845 let attr' = filter (\(x,_) -> x /= "src" && x /= "poster") attr ++
834846 [("src", newsrc) | not (null newsrc)] ++
835847 [("poster", newposter) | not (null newposter)]
836848 return $ TagOpen name attr'
837−transformTag _ _ tag = return tag
849+transformTag _ tag = return tag
838850
839851modifyMediaRef :: WriterOptions
840− -> IORef [(FilePath, (FilePath, Maybe Entry))]
841852 -> FilePath
842− -> EPUBAction FilePath
843−modifyMediaRef _ _ "" = return ""
844−modifyMediaRef opts mediaRef oldsrc = do
845− media <- P.readIORef mediaRef
853+ -> E FilePath
854+modifyMediaRef _ "" = return ""
855+modifyMediaRef opts oldsrc = do
856+ media <- gets stMediaPaths
846857 case lookup oldsrc media of
847858 Just (n,_) -> return n
848859 Nothing -> do
849− res <- P.fetchItem' (writerMediaBag opts)
860+ res <- lift $ P.fetchItem' (writerMediaBag opts)
850861 (writerSourceURL opts) oldsrc
851862 (new, mbEntry) <-
852863 case res of
853864 Left _ -> do
854− P.warn $ "Could not find media `" ++ oldsrc ++ "', skipping..."
865+ lift $ P.warn $ "Could not find media `" ++ oldsrc ++ "', skipping..."
855866 return (oldsrc, Nothing)
856867 Right (img,mbMime) -> do
857868 let new = "media/file" ++ show (length media) ++
858869 fromMaybe (takeExtension (takeWhile (/='?') oldsrc))
859870 (('.':) <$> (mbMime >>= extensionFromMimeType))
860− epochtime <- floor `fmap` P.getPOSIXTime
871+ epochtime <- floor `fmap` lift P.getPOSIXTime
861872 let entry = toEntry new epochtime $ B.fromChunks . (:[]) $ img
862873 return (new, Just entry)
863− P.modifyIORef mediaRef ( (oldsrc, (new, mbEntry)): )
874+ modify $ \st -> st{ stMediaPaths = (oldsrc, (new, mbEntry)):media}
864875 return new
865876
866877transformBlock :: WriterOptions
867− -> IORef [(FilePath, (FilePath, Maybe Entry))] -- ^ (oldpath, newpath, entry) media
878+ -- -> IORef [(FilePath, (FilePath, Maybe Entry))] -- ^ (oldpath, newpath, entry) media
868879 -> Block
869− -> EPUBAction Block
870−transformBlock opts mediaRef (RawBlock fmt raw)
880+ -> E Block
881+transformBlock opts (RawBlock fmt raw)
871882 | fmt == Format "html" = do
872883 let tags = parseTags raw
873− tags' <- mapM (transformTag opts mediaRef) tags
884+ tags' <- mapM (transformTag opts) tags
874885 return $ RawBlock fmt (renderTags' tags')
875−transformBlock _ _ b = return b
886+transformBlock _ b = return b
876887
877888transformInline :: WriterOptions
878− -> IORef [(FilePath, (FilePath, Maybe Entry))] -- ^ (oldpath, newpath) media
889+ -- -> IORef [(FilePath, (FilePath, Maybe Entry))] -- ^ (oldpath, newpath) media
879890 -> Inline
880− -> EPUBAction Inline
881−transformInline opts mediaRef (Image attr lab (src,tit)) = do
882− newsrc <- modifyMediaRef opts mediaRef src
891+ -> E Inline
892+transformInline opts (Image attr lab (src,tit)) = do
893+ newsrc <- modifyMediaRef opts src
883894 return $ Image attr lab (newsrc, tit)
884−transformInline opts mediaRef (x@(Math t m))
895+transformInline opts (x@(Math t m))
885896 | WebTeX url <- writerHTMLMathMethod opts = do
886− newsrc <- modifyMediaRef opts mediaRef (url ++ urlEncode m)
897+ newsrc <- modifyMediaRef opts (url ++ urlEncode m)
887898 let mathclass = if t == DisplayMath then "display" else "inline"
888899 return $ Span ("",["math",mathclass],[]) [Image nullAttr [x] (newsrc, "")]
889−transformInline opts mediaRef (RawInline fmt raw)
900+transformInline opts (RawInline fmt raw)
890901 | fmt == Format "html" = do
891902 let tags = parseTags raw
892− tags' <- mapM (transformTag opts mediaRef) tags
903+ tags' <- mapM (transformTag opts) tags
893904 return $ RawInline fmt (renderTags' tags')
894−transformInline _ _ x = return x
905+transformInline _ x = return x
895906
896907(!) :: (t -> Element) -> [(String, String)] -> t -> Element
897908(!) f attrs n = add_attrs (map (\(k,v) -> Attr (unqual k) v) attrs) (f n)