@@ -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,18 @@ 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 Control.Monad.State (modify, get, gets, State, StateT, put, evalState, evalStateT, lift)
57+import Control.Monad (mplus, when)
6258import Text.XML.Light ( unode, Element(..), unqual, Attr(..), add_attrs
6359 , strContent, lookupAttr, Node(..), QName(..), parseXML
6460 , onlyElems, node, ppElement)
65−import Text.Pandoc.UUID (getRandomUUID)
6661import Text.Pandoc.Writers.HTML ( writeHtml )
6762import Data.Char ( toLower, isDigit, isAlphaNum )
6863import Text.Pandoc.MIME (MimeType, getMimeType, extensionFromMimeType)
69−import qualified Control.Exception as E
7064import Text.Blaze.Html.Renderer.Utf8 (renderHtml)
7165import Text.HTML.TagSoup (Tag(TagOpen), fromAttrib, parseTags)
66+import Text.Pandoc.Free (PandocAction, runIO)
67+import qualified Text.Pandoc.Free as P
7268
7369-- A Chapter includes a list of blocks and maybe a section
7470-- number offset. Note, some chapters are unnumbered. The section
@@ -76,6 +72,11 @@ import Text.HTML.TagSoup (Tag(TagOpen), fromAttrib, parseTags)
7672-- in filenames, chapter0003.xhtml.
7773data Chapter = Chapter (Maybe [Int]) [Block]
7874
75+data EPUBState = EPUBState { stMediaPaths :: [(FilePath, (FilePath, Maybe Entry))]
76+ }
77+
78+type E = StateT EPUBState PandocAction
79+
7980data EPUBMetadata = EPUBMetadata{
8081 epubIdentifier :: [Identifier]
8182 , epubTitle :: [Title]
@@ -143,7 +144,7 @@ removeNote :: Inline -> Inline
143144removeNote (Note _) = Str ""
144145removeNote x = x
145146
146−getEPUBMetadata :: WriterOptions -> Meta -> IO EPUBMetadata
147+getEPUBMetadata :: WriterOptions -> Meta -> E EPUBMetadata
147148getEPUBMetadata opts meta = do
148149 let md = metadataFromMeta opts meta
149150 let elts = onlyElems $ parseXML $ writerEpubMetadata opts
@@ -151,7 +152,7 @@ getEPUBMetadata opts meta = do
151152 let addIdentifier m =
152153 if null (epubIdentifier m)
153154 then do
154− randomId <- fmap show getRandomUUID
155+ randomId <- fmap show (lift P.newUUID)
155156 return $ m{ epubIdentifier = [Identifier randomId Nothing] }
156157 else return m
157158 let addLanguage m =
@@ -159,16 +160,19 @@ getEPUBMetadata opts meta = do
159160 then case lookup "lang" (writerVariables opts) of
160161 Just x -> return m{ epubLanguage = x }
161162 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")
163+ mLang <- lift $ P.lookupEnv "LANG"
164+ let localeLang =
165+ case mLang of
166+ Just lang ->
167+ map (\c -> if c == '_' then '-' else c) $
168+ takeWhile (/='.') lang
169+ Nothing -> "en-US"
166170 return m{ epubLanguage = localeLang }
167171 else return m
168172 let fixDate m =
169173 if null (epubDate m)
170174 then do
171− currentTime <- getCurrentTime
175+ currentTime <- lift P.getCurrentTime
172176 return $ m{ epubDate = [ Date{
173177 dateText = showDateTimeISO8601 currentTime
174178 , dateEvent = Nothing } ] }
@@ -333,10 +337,24 @@ metadataFromMeta opts meta = EPUBMetadata{
333337writeEPUB :: WriterOptions -- ^ Writer options
334338 -> Pandoc -- ^ Document to convert
335339 -> IO B.ByteString
336−writeEPUB opts doc@(Pandoc meta _) = do
340+writeEPUB opts doc = runIO $ writeEPUBPure opts doc
341+
342+writeEPUBPure :: WriterOptions -- ^ Writer options
343+ -> Pandoc -- ^ Document to convert
344+ -> PandocAction B.ByteString
345+writeEPUBPure opts doc =
346+ let initState = EPUBState { stMediaPaths = []
347+ }
348+ in
349+ evalStateT (pandocToEPUB opts doc) initState
350+
351+pandocToEPUB :: WriterOptions
352+ -> Pandoc
353+ -> E B.ByteString
354+pandocToEPUB opts doc@(Pandoc meta _) = do
337355 let version = fromMaybe EPUB2 (writerEpubVersion opts)
338356 let epub3 = version == EPUB3
339− epochtime <- floor `fmap` getPOSIXTime
357+ epochtime <- floor <$> lift P.getPOSIXTime
340358 let mkEntry path content = toEntry path epochtime content
341359 let vars = ("epub3", if epub3 then "true" else "false")
342360 : ("css", "stylesheet.css")
@@ -362,7 +380,7 @@ writeEPUB opts doc@(Pandoc meta _) = do
362380 let cpContent = renderHtml $ writeHtml
363381 opts'{ writerVariables = ("coverpage","true"):vars }
364382 (Pandoc meta [RawBlock (Format "html") $ "<div id=\"cover-image\">\n<img src=\"" ++ coverImage ++ "\" alt=\"cover image\" />\n</div>"])
365− imgContent <- B.readFile img
383+ imgContent <- lift $ P.readFileLazy img
366384 return ( [mkEntry "cover.xhtml" cpContent]
367385 , [mkEntry coverImage imgContent] )
368386
@@ -373,18 +391,17 @@ writeEPUB opts doc@(Pandoc meta _) = do
373391 let tpEntry = mkEntry "title_page.xhtml" tpContent
374392
375393 -- 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−
394+ -- mediaRef <- P.newIORef []
395+ Pandoc _ blocks <- walkM (transformInline opts') doc >>=
396+ walkM (transformBlock opts')
397+ picEntries <- (catMaybes . map (snd . snd)) <$> (gets stMediaPaths)
381398 -- handle fonts
382399 let matchingGlob f = do
383− xs <- namesMatching f
400+ xs <- lift $ P.glob f
384401 when (null xs) $
385− warn $ f ++ " did not match any font files."
402+ lift $ P.warn $ f ++ " did not match any font files."
386403 return xs
387− let mkFontEntry f = mkEntry (takeFileName f) `fmap` B.readFile f
404+ let mkFontEntry f = mkEntry (takeFileName f) `fmap` (lift $ P.readFileLazy f)
388405 fontFiles <- concat <$> mapM matchingGlob (writerEpubFonts opts')
389406 fontEntries <- mapM mkFontEntry fontFiles
390407
@@ -521,7 +538,7 @@ writeEPUB opts doc@(Pandoc meta _) = do
521538 let uuid = case epubIdentifier metadata of
522539 (x:_) -> identifierText x -- use first identifier as UUID
523540 [] -> error "epubIdentifier is null" -- shouldn't happen
524− currentTime <- getCurrentTime
541+ currentTime <- lift $ P.getCurrentTime
525542 let contentsData = UTF8.fromStringLazy $ ppTopElement $
526543 unode "package" ! [("version", case version of
527544 EPUB2 -> "2.0"
@@ -693,10 +710,10 @@ writeEPUB opts doc@(Pandoc meta _) = do
693710
694711 -- stylesheet
695712 stylesheet <- case epubStylesheet metadata of
696− Just (StylesheetPath fp) -> UTF8.readFile fp
713+ Just (StylesheetPath fp) -> lift $ P.readFileUTF8 fp
697714 Just (StylesheetContents s) -> return s
698715 Nothing -> UTF8.toString `fmap`
699− readDataFile (writerUserDataDir opts) "epub.css"
716+ (lift $ P.readDataFile (writerUserDataDir opts) "epub.css")
700717 let stylesheetEntry = mkEntry "stylesheet.css" $ UTF8.fromStringLazy stylesheet
701718
702719 -- construct archive
@@ -813,78 +830,77 @@ showDateTimeISO8601 :: UTCTime -> String
813830showDateTimeISO8601 = formatTime defaultTimeLocale "%FT%TZ"
814831
815832transformTag :: WriterOptions
816− -> IORef [(FilePath, (FilePath, Maybe Entry))] -- ^ (oldpath, newpath, entry) media
833+ -- -> IORef [(FilePath, (FilePath, Maybe Entry))] -- ^ (oldpath, newpath, entry) media
817834 -> Tag String
818− -> IO (Tag String)
819−transformTag opts mediaRef tag@(TagOpen name attr)
835+ -> E (Tag String)
836+transformTag opts tag@(TagOpen name attr)
820837 | name `elem` ["video", "source", "img", "audio"] &&
821838 lookup "data-external" attr == Nothing = do
822839 let src = fromAttrib "src" tag
823840 let poster = fromAttrib "poster" tag
824− newsrc <- modifyMediaRef opts mediaRef src
825− newposter <- modifyMediaRef opts mediaRef poster
841+ newsrc <- modifyMediaRef opts src
842+ newposter <- modifyMediaRef opts poster
826843 let attr' = filter (\(x,_) -> x /= "src" && x /= "poster") attr ++
827844 [("src", newsrc) | not (null newsrc)] ++
828845 [("poster", newposter) | not (null newposter)]
829846 return $ TagOpen name attr'
830−transformTag _ _ tag = return tag
847+transformTag _ tag = return tag
831848
832849modifyMediaRef :: WriterOptions
833− -> IORef [(FilePath, (FilePath, Maybe Entry))]
834850 -> FilePath
835− -> IO FilePath
836−modifyMediaRef _ _ "" = return ""
837−modifyMediaRef opts mediaRef oldsrc = do
838− media <- readIORef mediaRef
851+ -> E FilePath
852+modifyMediaRef _ "" = return ""
853+modifyMediaRef opts oldsrc = do
854+ media <- gets stMediaPaths
839855 case lookup oldsrc media of
840856 Just (n,_) -> return n
841857 Nothing -> do
842− res <- fetchItem' (writerMediaBag opts)
858+ res <- lift $ P.fetchItem' (writerMediaBag opts)
843859 (writerSourceURL opts) oldsrc
844860 (new, mbEntry) <-
845861 case res of
846862 Left _ -> do
847− warn $ "Could not find media `" ++ oldsrc ++ "', skipping..."
863+ lift $ P.warn $ "Could not find media `" ++ oldsrc ++ "', skipping..."
848864 return (oldsrc, Nothing)
849865 Right (img,mbMime) -> do
850866 let new = "media/file" ++ show (length media) ++
851867 fromMaybe (takeExtension (takeWhile (/='?') oldsrc))
852868 (('.':) <$> (mbMime >>= extensionFromMimeType))
853− epochtime <- floor `fmap` getPOSIXTime
869+ epochtime <- floor `fmap` lift P.getPOSIXTime
854870 let entry = toEntry new epochtime $ B.fromChunks . (:[]) $ img
855871 return (new, Just entry)
856− modifyIORef mediaRef ( (oldsrc, (new, mbEntry)): )
872+ modify $ \st -> st{ stMediaPaths = (oldsrc, (new, mbEntry)):media}
857873 return new
858874
859875transformBlock :: WriterOptions
860− -> IORef [(FilePath, (FilePath, Maybe Entry))] -- ^ (oldpath, newpath, entry) media
876+ -- -> IORef [(FilePath, (FilePath, Maybe Entry))] -- ^ (oldpath, newpath, entry) media
861877 -> Block
862− -> IO Block
863−transformBlock opts mediaRef (RawBlock fmt raw)
878+ -> E Block
879+transformBlock opts (RawBlock fmt raw)
864880 | fmt == Format "html" = do
865881 let tags = parseTags raw
866− tags' <- mapM (transformTag opts mediaRef) tags
882+ tags' <- mapM (transformTag opts) tags
867883 return $ RawBlock fmt (renderTags' tags')
868−transformBlock _ _ b = return b
884+transformBlock _ b = return b
869885
870886transformInline :: WriterOptions
871− -> IORef [(FilePath, (FilePath, Maybe Entry))] -- ^ (oldpath, newpath) media
887+ -- -> IORef [(FilePath, (FilePath, Maybe Entry))] -- ^ (oldpath, newpath) media
872888 -> Inline
873− -> IO Inline
874−transformInline opts mediaRef (Image attr lab (src,tit)) = do
875− newsrc <- modifyMediaRef opts mediaRef src
889+ -> E Inline
890+transformInline opts (Image attr lab (src,tit)) = do
891+ newsrc <- modifyMediaRef opts src
876892 return $ Image attr lab (newsrc, tit)
877−transformInline opts mediaRef (x@(Math t m))
893+transformInline opts (x@(Math t m))
878894 | WebTeX url <- writerHTMLMathMethod opts = do
879− newsrc <- modifyMediaRef opts mediaRef (url ++ urlEncode m)
895+ newsrc <- modifyMediaRef opts (url ++ urlEncode m)
880896 let mathclass = if t == DisplayMath then "display" else "inline"
881897 return $ Span ("",["math",mathclass],[]) [Image nullAttr [x] (newsrc, "")]
882−transformInline opts mediaRef (RawInline fmt raw)
898+transformInline opts (RawInline fmt raw)
883899 | fmt == Format "html" = do
884900 let tags = parseTags raw
885− tags' <- mapM (transformTag opts mediaRef) tags
901+ tags' <- mapM (transformTag opts) tags
886902 return $ RawInline fmt (renderTags' tags')
887−transformInline _ _ x = return x
903+transformInline _ x = return x
888904
889905(!) :: (t -> Element) -> [(String, String)] -> t -> Element
890906(!) f attrs n = add_attrs (map (\(k,v) -> Attr (unqual k) v) attrs) (f n)