@@ -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")
@@ -368,7 +381,7 @@ writeEPUBPure opts doc@(Pandoc meta _) = do
368381 let cpContent = renderHtml $ writeHtml
369382 opts'{ writerVariables = ("coverpage","true"):vars }
370383 (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
372385 return ( [mkEntry "cover.xhtml" cpContent]
373386 , [mkEntry coverImage imgContent] )
374387
@@ -379,18 +392,17 @@ writeEPUBPure opts doc@(Pandoc meta _) = do
379392 let tpEntry = mkEntry "title_page.xhtml" tpContent
380393
381394 -- handle pictures
382− mediaRef <- P.newIORef []
383− Pandoc _ blocks <- walkM (transformInline opts' mediaRef) doc >>=
384− walkM (transformBlock opts' mediaRef)
385− picEntries <- (catMaybes . map (snd . snd)) <$> P.readIORef mediaRef
386−
395+ -- mediaRef <- P.newIORef []
396+ Pandoc _ blocks <- walkM (transformInline opts') doc >>=
397+ walkM (transformBlock opts')
398+ picEntries <- (catMaybes . map (snd . snd)) <$> (gets stMediaPaths)
387399 -- handle fonts
388400 let matchingGlob f = do
389− xs <- P.namesMatching f
401+ xs <- lift $ P.namesMatching f
390402 when (null xs) $
391− P.warn $ f ++ " did not match any font files."
403+ lift $ P.warn $ f ++ " did not match any font files."
392404 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)
394406 fontFiles <- concat <$> mapM matchingGlob (writerEpubFonts opts')
395407 fontEntries <- mapM mkFontEntry fontFiles
396408
@@ -527,7 +539,7 @@ writeEPUBPure opts doc@(Pandoc meta _) = do
527539 let uuid = case epubIdentifier metadata of
528540 (x:_) -> identifierText x -- use first identifier as UUID
529541 [] -> error "epubIdentifier is null" -- shouldn't happen
530− currentTime <- P.getCurrentTime
542+ currentTime <- lift $ P.getCurrentTime
531543 let contentsData = UTF8.fromStringLazy $ ppTopElement $
532544 unode "package" ! [("version", case version of
533545 EPUB2 -> "2.0"
@@ -699,10 +711,10 @@ writeEPUBPure opts doc@(Pandoc meta _) = do
699711
700712 -- stylesheet
701713 stylesheet <- case epubStylesheet metadata of
702− Just (StylesheetPath fp) -> P.readFileUTF8 fp
714+ Just (StylesheetPath fp) -> lift $ P.readFileUTF8 fp
703715 Just (StylesheetContents s) -> return s
704716 Nothing -> UTF8.toString `fmap`
705− P.readDataFile (writerUserDataDir opts) "epub.css"
717+ (lift $ P.readDataFile (writerUserDataDir opts) "epub.css")
706718 let stylesheetEntry = mkEntry "stylesheet.css" $ UTF8.fromStringLazy stylesheet
707719
708720 -- construct archive
@@ -819,78 +831,77 @@ showDateTimeISO8601 :: UTCTime -> String
819831showDateTimeISO8601 = formatTime defaultTimeLocale "%FT%TZ"
820832
821833transformTag :: WriterOptions
822− -> IORef [(FilePath, (FilePath, Maybe Entry))] -- ^ (oldpath, newpath, entry) media
834+ -- -> IORef [(FilePath, (FilePath, Maybe Entry))] -- ^ (oldpath, newpath, entry) media
823835 -> Tag String
824− -> EPUBAction (Tag String)
825−transformTag opts mediaRef tag@(TagOpen name attr)
836+ -> E (Tag String)
837+transformTag opts tag@(TagOpen name attr)
826838 | name `elem` ["video", "source", "img", "audio"] &&
827839 lookup "data-external" attr == Nothing = do
828840 let src = fromAttrib "src" tag
829841 let poster = fromAttrib "poster" tag
830− newsrc <- modifyMediaRef opts mediaRef src
831− newposter <- modifyMediaRef opts mediaRef poster
842+ newsrc <- modifyMediaRef opts src
843+ newposter <- modifyMediaRef opts poster
832844 let attr' = filter (\(x,_) -> x /= "src" && x /= "poster") attr ++
833845 [("src", newsrc) | not (null newsrc)] ++
834846 [("poster", newposter) | not (null newposter)]
835847 return $ TagOpen name attr'
836−transformTag _ _ tag = return tag
848+transformTag _ tag = return tag
837849
838850modifyMediaRef :: WriterOptions
839− -> IORef [(FilePath, (FilePath, Maybe Entry))]
840851 -> FilePath
841− -> EPUBAction FilePath
842−modifyMediaRef _ _ "" = return ""
843−modifyMediaRef opts mediaRef oldsrc = do
844− media <- P.readIORef mediaRef
852+ -> E FilePath
853+modifyMediaRef _ "" = return ""
854+modifyMediaRef opts oldsrc = do
855+ media <- gets stMediaPaths
845856 case lookup oldsrc media of
846857 Just (n,_) -> return n
847858 Nothing -> do
848− res <- P.fetchItem' (writerMediaBag opts)
859+ res <- lift $ P.fetchItem' (writerMediaBag opts)
849860 (writerSourceURL opts) oldsrc
850861 (new, mbEntry) <-
851862 case res of
852863 Left _ -> do
853− P.warn $ "Could not find media `" ++ oldsrc ++ "', skipping..."
864+ lift $ P.warn $ "Could not find media `" ++ oldsrc ++ "', skipping..."
854865 return (oldsrc, Nothing)
855866 Right (img,mbMime) -> do
856867 let new = "media/file" ++ show (length media) ++
857868 fromMaybe (takeExtension (takeWhile (/='?') oldsrc))
858869 (('.':) <$> (mbMime >>= extensionFromMimeType))
859− epochtime <- floor `fmap` P.getPOSIXTime
870+ epochtime <- floor `fmap` lift P.getPOSIXTime
860871 let entry = toEntry new epochtime $ B.fromChunks . (:[]) $ img
861872 return (new, Just entry)
862− P.modifyIORef mediaRef ( (oldsrc, (new, mbEntry)): )
873+ modify $ \st -> st{ stMediaPaths = (oldsrc, (new, mbEntry)):media}
863874 return new
864875
865876transformBlock :: WriterOptions
866− -> IORef [(FilePath, (FilePath, Maybe Entry))] -- ^ (oldpath, newpath, entry) media
877+ -- -> IORef [(FilePath, (FilePath, Maybe Entry))] -- ^ (oldpath, newpath, entry) media
867878 -> Block
868− -> EPUBAction Block
869−transformBlock opts mediaRef (RawBlock fmt raw)
879+ -> E Block
880+transformBlock opts (RawBlock fmt raw)
870881 | fmt == Format "html" = do
871882 let tags = parseTags raw
872− tags' <- mapM (transformTag opts mediaRef) tags
883+ tags' <- mapM (transformTag opts) tags
873884 return $ RawBlock fmt (renderTags' tags')
874−transformBlock _ _ b = return b
885+transformBlock _ b = return b
875886
876887transformInline :: WriterOptions
877− -> IORef [(FilePath, (FilePath, Maybe Entry))] -- ^ (oldpath, newpath) media
888+ -- -> IORef [(FilePath, (FilePath, Maybe Entry))] -- ^ (oldpath, newpath) media
878889 -> Inline
879− -> EPUBAction Inline
880−transformInline opts mediaRef (Image attr lab (src,tit)) = do
881− newsrc <- modifyMediaRef opts mediaRef src
890+ -> E Inline
891+transformInline opts (Image attr lab (src,tit)) = do
892+ newsrc <- modifyMediaRef opts src
882893 return $ Image attr lab (newsrc, tit)
883−transformInline opts mediaRef (x@(Math t m))
894+transformInline opts (x@(Math t m))
884895 | WebTeX url <- writerHTMLMathMethod opts = do
885− newsrc <- modifyMediaRef opts mediaRef (url ++ urlEncode m)
896+ newsrc <- modifyMediaRef opts (url ++ urlEncode m)
886897 let mathclass = if t == DisplayMath then "display" else "inline"
887898 return $ Span ("",["math",mathclass],[]) [Image nullAttr [x] (newsrc, "")]
888−transformInline opts mediaRef (RawInline fmt raw)
899+transformInline opts (RawInline fmt raw)
889900 | fmt == Format "html" = do
890901 let tags = parseTags raw
891− tags' <- mapM (transformTag opts mediaRef) tags
902+ tags' <- mapM (transformTag opts) tags
892903 return $ RawInline fmt (renderTags' tags')
893−transformInline _ _ x = return x
904+transformInline _ x = return x
894905
895906(!) :: (t -> Element) -> [(String, String)] -> t -> Element
896907(!) f attrs n = add_attrs (map (\(k,v) -> Attr (unqual k) v) attrs) (f n)