@@ -28,26 +28,22 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
2828
2929Conversion of 'Pandoc' documents to EPUB.
3030-}
31−module Text.Pandoc.Writers.EPUB ( writeEPUB ) where
32−import Data.IORef ( IORef, newIORef, readIORef, modifyIORef )
31+module Text.Pandoc.Writers.EPUB ( writeEPUB, writeEPUBPure ) where
3332import qualified Data.Map as M
3433import qualified Data.Set as Set
3534import Data.Maybe ( fromMaybe, catMaybes )
3635import Data.List ( isPrefixOf, isInfixOf, intercalate )
37−import System.Environment ( getEnv )
3836import Text.Printf (printf)
3937import System.FilePath ( takeExtension, takeFileName )
40−import System.FilePath.Glob ( namesMatching )
4138import Network.HTTP ( urlEncode )
4239import qualified Data.ByteString.Lazy as B
4340import qualified Data.ByteString.Lazy.Char8 as B8
4441import qualified Text.Pandoc.UTF8 as UTF8
4542import Codec.Archive.Zip ( emptyArchive, addEntryToArchive, eRelativePath, fromEntry , Entry, toEntry, fromArchive)
46−import Data.Time.Clock.POSIX ( getPOSIXTime )
4743import Text.Pandoc.Compat.Time
4844import Text.Pandoc.Shared ( renderTags', safeRead, uniqueIdent, trim
49− , normalizeDate, readDataFile, stringify, warn
50− , hierarchicalize, fetchItem' )
45+ , normalizeDate, stringify
46+ , hierarchicalize )
5147import qualified Text.Pandoc.Shared as S (Element(..))
5248import Text.Pandoc.Builder (fromList, setMeta)
5349import Text.Pandoc.Options ( WriterOptions(..)
@@ -57,18 +53,19 @@ import Text.Pandoc.Options ( WriterOptions(..)
5753 , ObfuscationMethod(NoObfuscation) )
5854import Text.Pandoc.Definition
5955import Text.Pandoc.Walk (walk, walkM, query)
60−import Control.Monad.State (modify, get, State, put, evalState)
61−import Control.Monad (mplus, liftM, when)
56+import Text.Pandoc.UUID (getUUID)
57+import Control.Monad.State (modify, get, gets, State, StateT, put, evalState, evalStateT, lift)
58+import Control.Monad (mplus, when)
6259import Text.XML.Light ( unode, Element(..), unqual, Attr(..), add_attrs
6360 , strContent, lookupAttr, Node(..), QName(..), parseXML
6461 , onlyElems, node, ppElement)
65−import Text.Pandoc.UUID (getRandomUUID)
6662import Text.Pandoc.Writers.HTML ( writeHtml )
6763import Data.Char ( toLower, isDigit, isAlphaNum )
6864import Text.Pandoc.MIME (MimeType, getMimeType, extensionFromMimeType)
69−import qualified Control.Exception as E
7065import Text.Blaze.Html.Renderer.Utf8 (renderHtml)
7166import Text.HTML.TagSoup (Tag(TagOpen), fromAttrib, parseTags)
67+import Text.Pandoc.Free (PandocAction, runIO)
68+import qualified Text.Pandoc.Free as P
7269
7370-- A Chapter includes a list of blocks and maybe a section
7471-- number offset. Note, some chapters are unnumbered. The section
@@ -76,6 +73,11 @@ import Text.HTML.TagSoup (Tag(TagOpen), fromAttrib, parseTags)
7673-- in filenames, chapter0003.xhtml.
7774data Chapter = Chapter (Maybe [Int]) [Block]
7875
76+data EPUBState = EPUBState { stMediaPaths :: [(FilePath, (FilePath, Maybe Entry))]
77+ }
78+
79+type E = StateT EPUBState PandocAction
80+
7981data EPUBMetadata = EPUBMetadata{
8082 epubIdentifier :: [Identifier]
8183 , epubTitle :: [Title]
@@ -143,7 +145,7 @@ removeNote :: Inline -> Inline
143145removeNote (Note _) = Str ""
144146removeNote x = x
145147
146−getEPUBMetadata :: WriterOptions -> Meta -> IO EPUBMetadata
148+getEPUBMetadata :: WriterOptions -> Meta -> E EPUBMetadata
147149getEPUBMetadata opts meta = do
148150 let md = metadataFromMeta opts meta
149151 let elts = onlyElems $ parseXML $ writerEpubMetadata opts
@@ -151,7 +153,7 @@ getEPUBMetadata opts meta = do
151153 let addIdentifier m =
152154 if null (epubIdentifier m)
153155 then do
154− randomId <- fmap show getRandomUUID
156+ randomId <- (show . getUUID) <$> lift P.newStdGen
155157 return $ m{ epubIdentifier = [Identifier randomId Nothing] }
156158 else return m
157159 let addLanguage m =
@@ -159,16 +161,19 @@ getEPUBMetadata opts meta = do
159161 then case lookup "lang" (writerVariables opts) of
160162 Just x -> return m{ epubLanguage = x }
161163 Nothing -> do
162− localeLang <- E.catch (liftM
163− (map (\c -> if c == '_' then '-' else c) .
164− takeWhile (/='.')) $ getEnv "LANG")
165− (\e -> let _ = (e :: E.SomeException) in return "en-US")
164+ mLang <- lift $ P.lookupEnv "LANG"
165+ let localeLang =
166+ case mLang of
167+ Just lang ->
168+ map (\c -> if c == '_' then '-' else c) $
169+ takeWhile (/='.') lang
170+ Nothing -> "en-US"
166171 return m{ epubLanguage = localeLang }
167172 else return m
168173 let fixDate m =
169174 if null (epubDate m)
170175 then do
171− currentTime <- getCurrentTime
176+ currentTime <- lift P.getCurrentTime
172177 return $ m{ epubDate = [ Date{
173178 dateText = showDateTimeISO8601 currentTime
174179 , dateEvent = Nothing } ] }
@@ -333,10 +338,24 @@ metadataFromMeta opts meta = EPUBMetadata{
333338writeEPUB :: WriterOptions -- ^ Writer options
334339 -> Pandoc -- ^ Document to convert
335340 -> IO B.ByteString
336−writeEPUB opts doc@(Pandoc meta _) = do
341+writeEPUB opts doc = runIO $ writeEPUBPure opts doc
342+
343+writeEPUBPure :: WriterOptions -- ^ Writer options
344+ -> Pandoc -- ^ Document to convert
345+ -> PandocAction B.ByteString
346+writeEPUBPure opts doc =
347+ let initState = EPUBState { stMediaPaths = []
348+ }
349+ in
350+ evalStateT (pandocToEPUB opts doc) initState
351+
352+pandocToEPUB :: WriterOptions
353+ -> Pandoc
354+ -> E B.ByteString
355+pandocToEPUB opts doc@(Pandoc meta _) = do
337356 let version = fromMaybe EPUB2 (writerEpubVersion opts)
338357 let epub3 = version == EPUB3
339− epochtime <- floor `fmap` getPOSIXTime
358+ epochtime <- floor <$> lift P.getPOSIXTime
340359 let mkEntry path content = toEntry path epochtime content
341360 let vars = ("epub3", if epub3 then "true" else "false")
342361 : ("css", "stylesheet.css")
@@ -362,7 +381,7 @@ writeEPUB opts doc@(Pandoc meta _) = do
362381 let cpContent = renderHtml $ writeHtml
363382 opts'{ writerVariables = ("coverpage","true"):vars }
364383 (Pandoc meta [RawBlock (Format "html") $ "<div id=\"cover-image\">\n<img src=\"" ++ coverImage ++ "\" alt=\"cover image\" />\n</div>"])
365− imgContent <- B.readFile img
384+ imgContent <- lift $ P.readFileLazy img
366385 return ( [mkEntry "cover.xhtml" cpContent]
367386 , [mkEntry coverImage imgContent] )
368387
@@ -373,18 +392,17 @@ writeEPUB opts doc@(Pandoc meta _) = do
373392 let tpEntry = mkEntry "title_page.xhtml" tpContent
374393
375394 -- handle pictures
376− mediaRef <- newIORef []
377− Pandoc _ blocks <- walkM (transformInline opts' mediaRef) doc >>=
378− walkM (transformBlock opts' mediaRef)
379− picEntries <- (catMaybes . map (snd . snd)) <$> readIORef mediaRef
380−
395+ -- mediaRef <- P.newIORef []
396+ Pandoc _ blocks <- walkM (transformInline opts') doc >>=
397+ walkM (transformBlock opts')
398+ picEntries <- (catMaybes . map (snd . snd)) <$> (gets stMediaPaths)
381399 -- handle fonts
382400 let matchingGlob f = do
383− xs <- namesMatching f
401+ xs <- lift $ P.glob f
384402 when (null xs) $
385− warn $ f ++ " did not match any font files."
403+ lift $ P.warn $ f ++ " did not match any font files."
386404 return xs
387− let mkFontEntry f = mkEntry (takeFileName f) `fmap` B.readFile f
405+ let mkFontEntry f = mkEntry (takeFileName f) `fmap` (lift $ P.readFileLazy f)
388406 fontFiles <- concat <$> mapM matchingGlob (writerEpubFonts opts')
389407 fontEntries <- mapM mkFontEntry fontFiles
390408
@@ -521,7 +539,7 @@ writeEPUB opts doc@(Pandoc meta _) = do
521539 let uuid = case epubIdentifier metadata of
522540 (x:_) -> identifierText x -- use first identifier as UUID
523541 [] -> error "epubIdentifier is null" -- shouldn't happen
524− currentTime <- getCurrentTime
542+ currentTime <- lift $ P.getCurrentTime
525543 let contentsData = UTF8.fromStringLazy $ ppTopElement $
526544 unode "package" ! [("version", case version of
527545 EPUB2 -> "2.0"
@@ -693,10 +711,10 @@ writeEPUB opts doc@(Pandoc meta _) = do
693711
694712 -- stylesheet
695713 stylesheet <- case epubStylesheet metadata of
696− Just (StylesheetPath fp) -> UTF8.readFile fp
714+ Just (StylesheetPath fp) -> lift $ P.readFileUTF8 fp
697715 Just (StylesheetContents s) -> return s
698716 Nothing -> UTF8.toString `fmap`
699− readDataFile (writerUserDataDir opts) "epub.css"
717+ (lift $ P.readDataFile (writerUserDataDir opts) "epub.css")
700718 let stylesheetEntry = mkEntry "stylesheet.css" $ UTF8.fromStringLazy stylesheet
701719
702720 -- construct archive
@@ -813,78 +831,77 @@ showDateTimeISO8601 :: UTCTime -> String
813831showDateTimeISO8601 = formatTime defaultTimeLocale "%FT%TZ"
814832
815833transformTag :: WriterOptions
816− -> IORef [(FilePath, (FilePath, Maybe Entry))] -- ^ (oldpath, newpath, entry) media
834+ -- -> IORef [(FilePath, (FilePath, Maybe Entry))] -- ^ (oldpath, newpath, entry) media
817835 -> Tag String
818− -> IO (Tag String)
819−transformTag opts mediaRef tag@(TagOpen name attr)
836+ -> E (Tag String)
837+transformTag opts tag@(TagOpen name attr)
820838 | name `elem` ["video", "source", "img", "audio"] &&
821839 lookup "data-external" attr == Nothing = do
822840 let src = fromAttrib "src" tag
823841 let poster = fromAttrib "poster" tag
824− newsrc <- modifyMediaRef opts mediaRef src
825− newposter <- modifyMediaRef opts mediaRef poster
842+ newsrc <- modifyMediaRef opts src
843+ newposter <- modifyMediaRef opts poster
826844 let attr' = filter (\(x,_) -> x /= "src" && x /= "poster") attr ++
827845 [("src", newsrc) | not (null newsrc)] ++
828846 [("poster", newposter) | not (null newposter)]
829847 return $ TagOpen name attr'
830−transformTag _ _ tag = return tag
848+transformTag _ tag = return tag
831849
832850modifyMediaRef :: WriterOptions
833− -> IORef [(FilePath, (FilePath, Maybe Entry))]
834851 -> FilePath
835− -> IO FilePath
836−modifyMediaRef _ _ "" = return ""
837−modifyMediaRef opts mediaRef oldsrc = do
838− media <- readIORef mediaRef
852+ -> E FilePath
853+modifyMediaRef _ "" = return ""
854+modifyMediaRef opts oldsrc = do
855+ media <- gets stMediaPaths
839856 case lookup oldsrc media of
840857 Just (n,_) -> return n
841858 Nothing -> do
842− res <- fetchItem' (writerMediaBag opts)
859+ res <- lift $ P.fetchItem' (writerMediaBag opts)
843860 (writerSourceURL opts) oldsrc
844861 (new, mbEntry) <-
845862 case res of
846863 Left _ -> do
847− warn $ "Could not find media `" ++ oldsrc ++ "', skipping..."
864+ lift $ P.warn $ "Could not find media `" ++ oldsrc ++ "', skipping..."
848865 return (oldsrc, Nothing)
849866 Right (img,mbMime) -> do
850867 let new = "media/file" ++ show (length media) ++
851868 fromMaybe (takeExtension (takeWhile (/='?') oldsrc))
852869 (('.':) <$> (mbMime >>= extensionFromMimeType))
853− epochtime <- floor `fmap` getPOSIXTime
870+ epochtime <- floor `fmap` lift P.getPOSIXTime
854871 let entry = toEntry new epochtime $ B.fromChunks . (:[]) $ img
855872 return (new, Just entry)
856− modifyIORef mediaRef ( (oldsrc, (new, mbEntry)): )
873+ modify $ \st -> st{ stMediaPaths = (oldsrc, (new, mbEntry)):media}
857874 return new
858875
859876transformBlock :: WriterOptions
860− -> IORef [(FilePath, (FilePath, Maybe Entry))] -- ^ (oldpath, newpath, entry) media
877+ -- -> IORef [(FilePath, (FilePath, Maybe Entry))] -- ^ (oldpath, newpath, entry) media
861878 -> Block
862− -> IO Block
863−transformBlock opts mediaRef (RawBlock fmt raw)
879+ -> E Block
880+transformBlock opts (RawBlock fmt raw)
864881 | fmt == Format "html" = do
865882 let tags = parseTags raw
866− tags' <- mapM (transformTag opts mediaRef) tags
883+ tags' <- mapM (transformTag opts) tags
867884 return $ RawBlock fmt (renderTags' tags')
868−transformBlock _ _ b = return b
885+transformBlock _ b = return b
869886
870887transformInline :: WriterOptions
871− -> IORef [(FilePath, (FilePath, Maybe Entry))] -- ^ (oldpath, newpath) media
888+ -- -> IORef [(FilePath, (FilePath, Maybe Entry))] -- ^ (oldpath, newpath) media
872889 -> Inline
873− -> IO Inline
874−transformInline opts mediaRef (Image attr lab (src,tit)) = do
875− newsrc <- modifyMediaRef opts mediaRef src
890+ -> E Inline
891+transformInline opts (Image attr lab (src,tit)) = do
892+ newsrc <- modifyMediaRef opts src
876893 return $ Image attr lab (newsrc, tit)
877−transformInline opts mediaRef (x@(Math t m))
894+transformInline opts (x@(Math t m))
878895 | WebTeX url <- writerHTMLMathMethod opts = do
879− newsrc <- modifyMediaRef opts mediaRef (url ++ urlEncode m)
896+ newsrc <- modifyMediaRef opts (url ++ urlEncode m)
880897 let mathclass = if t == DisplayMath then "display" else "inline"
881898 return $ Span ("",["math",mathclass],[]) [Image nullAttr [x] (newsrc, "")]
882−transformInline opts mediaRef (RawInline fmt raw)
899+transformInline opts (RawInline fmt raw)
883900 | fmt == Format "html" = do
884901 let tags = parseTags raw
885− tags' <- mapM (transformTag opts mediaRef) tags
902+ tags' <- mapM (transformTag opts) tags
886903 return $ RawInline fmt (renderTags' tags')
887−transformInline _ _ x = return x
904+transformInline _ x = return x
888905
889906(!) :: (t -> Element) -> [(String, String)] -> t -> Element
890907(!) f attrs n = add_attrs (map (\(k,v) -> Attr (unqual k) v) attrs) (f n)