@@ -27,7 +27,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
2727
2828Conversion of 'Pandoc' documents to EPUB.
2929-}
30−module Text.Pandoc.Writers.EPUB ( writeEPUB ) where
30+module Text.Pandoc.Writers.EPUB ( writeEPUB2, writeEPUB3 ) where
3131import Data.IORef
3232import Data.Maybe ( fromMaybe, isNothing )
3333import Data.List ( isPrefixOf, intercalate )
@@ -38,6 +38,8 @@ import qualified Data.ByteString.Lazy as B
3838import Text.Pandoc.UTF8 ( fromStringLazy )
3939import Codec.Archive.Zip
4040import Data.Time.Clock.POSIX
41+import Data.Time
42+import System.Locale
4143import Text.Pandoc.Shared hiding ( Element )
4244import qualified Text.Pandoc.Shared as Shared
4345import Text.Pandoc.Options
@@ -56,11 +58,20 @@ import Prelude hiding (catch)
5658import Control.Exception (catch, SomeException)
5759import Text.HTML.TagSoup
5860
61+data EPUBVersion = EPUB2 | EPUB3 deriving Eq
62+
63+writeEPUB2, writeEPUB3 :: WriterOptions -- ^ Writer options
64+ -> Pandoc -- ^ Document to convert
65+ -> IO B.ByteString
66+writeEPUB2 = writeEPUB EPUB2
67+writeEPUB3 = writeEPUB EPUB3
68+
5969-- | Produce an EPUB file from a Pandoc document.
60−writeEPUB :: WriterOptions -- ^ Writer options
70+writeEPUB :: EPUBVersion
71+ -> WriterOptions -- ^ Writer options
6172 -> Pandoc -- ^ Document to convert
6273 -> IO B.ByteString
63−writeEPUB opts doc@(Pandoc meta _) = do
74+writeEPUB version opts doc@(Pandoc meta _) = do
6475 epochtime <- floor `fmap` getPOSIXTime
6576 let mkEntry path content = toEntry path epochtime content
6677 let opts' = opts{ writerEmailObfuscation = NoObfuscation
@@ -163,17 +174,23 @@ writeEPUB opts doc@(Pandoc meta _) = do
163174 let plainTitle = plainify $ docTitle meta
164175 let plainAuthors = map plainify $ docAuthors meta
165176 let plainDate = maybe "" id $ normalizeDate $ stringify $ docDate meta
177+ currentTime <- getCurrentTime
166178 let contentsData = fromStringLazy $ ppTopElement $
167− unode "package" ! [("version","2.0")
179+ unode "package" ! [("version", case version of
180+ EPUB2 -> "2.0"
181+ EPUB3 -> "3.0")
168182 ,("xmlns","http://www.idpf.org/2007/opf")
169183 ,("unique-identifier","BookId")] $
170− [ metadataElement (writerEPUBMetadata opts')
171− uuid lang plainTitle plainAuthors plainDate mbCoverImage
184+ [ metadataElement version (writerEPUBMetadata opts')
185+ uuid lang plainTitle plainAuthors plainDate currentTime mbCoverImage
172186 , unode "manifest" $
173187 [ unode "item" ! [("id","ncx"), ("href","toc.ncx")
174188 ,("media-type","application/x-dtbncx+xml")] $ ()
175189 , unode "item" ! [("id","style"), ("href","stylesheet.css")
176190 ,("media-type","text/css")] $ ()
191+ , unode "item" ! [("id","nav"), ("href","nav.xhtml")
192+ ,("properties","nav")
193+ ,("media-type","application/xhtml+xml")] $ ()
177194 ] ++
178195 map chapterNode (cpgEntry ++ (tpEntry : chapterEntries)) ++
179196 map pictureNode (cpicEntry ++ picEntries) ++
@@ -190,8 +207,9 @@ writeEPUB opts doc@(Pandoc meta _) = do
190207 -- toc.ncx
191208 let secs = hierarchicalize blocks''
192209
193− let navPointNode :: Shared.Element -> State Int Element
194− navPointNode (Sec _ nums ident ils children) = do
210+ let navPointNode :: (Int -> String -> String -> [Element] -> Element)
211+ -> Shared.Element -> State Int Element
212+ navPointNode formatter (Sec _ nums ident ils children) = do
195213 n <- get
196214 modify (+1)
197215 let showNums :: [Int] -> String
@@ -206,14 +224,17 @@ writeEPUB opts doc@(Pandoc meta _) = do
206224 let isSec (Sec lev _ _ _ _) = lev <= 3 -- only includes levels 1-3
207225 isSec _ = False
208226 let subsecs = filter isSec children
209− subs <- mapM navPointNode subsecs
210− return $ unode "navPoint" !
227+ subs <- mapM (navPointNode formatter) subsecs
228+ return $ formatter n tit src subs
229+ navPointNode _ (Blk _) = error "navPointNode encountered Blk"
230+
231+ let navMapFormatter :: Int -> String -> String -> [Element] -> Element
232+ navMapFormatter n tit src subs = unode "navPoint" !
211233 [("id", "navPoint-" ++ show n)
212234 ,("playOrder", show n)] $
213235 [ unode "navLabel" $ unode "text" tit
214236 , unode "content" ! [("src", src)] $ ()
215237 ] ++ subs
216− navPointNode (Blk _) = error "navPointNode encountered Blk"
217238
218239 let tpNode = unode "navPoint" ! [("id", "navPoint-0")] $
219240 [ unode "navLabel" $ unode "text" (plainify $ docTitle meta)
@@ -236,10 +257,31 @@ writeEPUB opts doc@(Pandoc meta _) = do
236257 Just _ -> [unode "meta" ! [("name","cover"),
237258 ("content","cover-image")] $ ()]
238259 , unode "docTitle" $ unode "text" $ plainTitle
239− , unode "navMap" $ tpNode : evalState (mapM navPointNode secs) 1
260+ , unode "navMap" $
261+ tpNode : evalState (mapM (navPointNode navMapFormatter) secs) 1
240262 ]
241263 let tocEntry = mkEntry "toc.ncx" tocData
242264
265+ let navXhtmlFormatter :: Int -> String -> String -> [Element] -> Element
266+ navXhtmlFormatter n tit src subs = unode "li" !
267+ [("id", "toc-li-" ++ show n)] $
268+ unode "a" ! [("href",src)] $
269+ unode "span" tit :
270+ case subs of
271+ [] -> []
272+ (_:_) -> [unode "ol" subs]
273+
274+ let navData = fromStringLazy $ ppTopElement $
275+ unode "html" ! [("xmlns","http://www.w3.org/1999/xhtml")
276+ ,("xmlns:epub","http://www.idpf.org/2007/ops")] $
277+ [ unode "head" $ unode "title" plainTitle
278+ , unode "body" $
279+ unode "nav" ! [("epub:type","toc")] $
280+ [ unode "h1" plainTitle
281+ , unode "ol" $ evalState (mapM (navPointNode navXhtmlFormatter) secs) 1]
282+ ]
283+ let navEntry = mkEntry "nav.xhtml" navData
284+
243285 -- mimetype
244286 let mimetypeEntry = mkEntry "mimetype" $ fromStringLazy "application/epub+zip"
245287
@@ -269,11 +311,13 @@ writeEPUB opts doc@(Pandoc meta _) = do
269311 let archive = foldr addEntryToArchive emptyArchive
270312 (mimetypeEntry : containerEntry : appleEntry : stylesheetEntry : tpEntry :
271313 contentsEntry : tocEntry :
272− (picEntries ++ cpicEntry ++ cpgEntry ++ chapterEntries ++ fontEntries) )
314+ ([navEntry | version == EPUB3] ++ picEntries ++ cpicEntry ++ cpgEntry ++
315+ chapterEntries ++ fontEntries) )
273316 return $ fromArchive archive
274317
275−metadataElement :: String -> UUID -> String -> String -> [String] -> String -> Maybe a -> Element
276−metadataElement metadataXML uuid lang title authors date mbCoverImage =
318+metadataElement :: EPUBVersion -> String -> UUID -> String -> String -> [String]
319+ -> String -> UTCTime -> Maybe a -> Element
320+metadataElement version metadataXML uuid lang title authors date currentTime mbCoverImage =
277321 let userNodes = parseXML metadataXML
278322 elt = unode "metadata" ! [("xmlns:dc","http://purl.org/dc/elements/1.1/")
279323 ,("xmlns:opf","http://www.idpf.org/2007/opf")] $
@@ -292,10 +336,15 @@ metadataElement metadataXML uuid lang title authors date mbCoverImage =
292336 not (elt `contains` "identifier") ] ++
293337 [ unode "dc:creator" ! [("opf:role","aut")] $ a | a <- authors ] ++
294338 [ unode "dc:date" date | not (elt `contains` "date") ] ++
339+ [ unode "meta" ! [("property", "dcterms:modified")] $
340+ (showDateTimeISO8601 currentTime) | version == EPUB3 ] ++
295341 [ unode "meta" ! [("name","cover"), ("content","cover-image")] $ () |
296342 not (isNothing mbCoverImage) ]
297343 in elt{ elContent = elContent elt ++ map Elem newNodes }
298344
345+showDateTimeISO8601 :: UTCTime -> String
346+showDateTimeISO8601 = formatTime defaultTimeLocale "%FT%TZ"
347+
299348transformInlines :: HTMLMathMethod
300349 -> FilePath
301350 -> IORef [(FilePath, FilePath)] -- ^ (oldpath, newpath) images