From 43448d7d536889f58a1f5c50ee403f9c4534edf4 Mon Sep 17 00:00:00 2001 From: John MacFarlane Date: Fri, 2 Nov 2012 17:46:22 -0700 Subject: Preliminary changes for epub3 format. * EPUB writer now exports writeEPUB2 and writeEPUB3. * 'epub' output format is epub v2, while 'epub3' is v3. --- src/Text/Pandoc.hs | 6 ++-- src/Text/Pandoc/Templates.hs | 1 + src/Text/Pandoc/Writers/EPUB.hs | 79 +++++++++++++++++++++++++++++++++-------- src/pandoc.hs | 2 +- 4 files changed, 70 insertions(+), 18 deletions(-) (limited to 'src') diff --git a/src/Text/Pandoc.hs b/src/Text/Pandoc.hs index 1e6b1d010..ce2b16152 100644 --- a/src/Text/Pandoc.hs +++ b/src/Text/Pandoc.hs @@ -92,7 +92,8 @@ module Text.Pandoc , writeRTF , writeODT , writeDocx - , writeEPUB + , writeEPUB2 + , writeEPUB3 , writeFB2 , writeOrg , writeAsciiDoc @@ -199,7 +200,8 @@ writers = [ ,("json" , PureStringWriter $ \_ -> encodeJSON) ,("docx" , IOByteStringWriter writeDocx) ,("odt" , IOByteStringWriter writeODT) - ,("epub" , IOByteStringWriter writeEPUB) + ,("epub" , IOByteStringWriter writeEPUB2) + ,("epub3" , IOByteStringWriter writeEPUB3) ,("fb2" , IOStringWriter writeFB2) ,("html" , PureStringWriter writeHtmlString) ,("html5" , PureStringWriter $ \o -> diff --git a/src/Text/Pandoc/Templates.hs b/src/Text/Pandoc/Templates.hs index e81fd9d14..4e43160ba 100644 --- a/src/Text/Pandoc/Templates.hs +++ b/src/Text/Pandoc/Templates.hs @@ -94,6 +94,7 @@ getDefaultTemplate user writer = do "json" -> return $ Right "" "docx" -> return $ Right "" "epub" -> return $ Right "" + "epub3" -> return $ Right "" "odt" -> getDefaultTemplate user "opendocument" "markdown_strict" -> getDefaultTemplate user "markdown" "multimarkdown" -> getDefaultTemplate user "markdown" diff --git a/src/Text/Pandoc/Writers/EPUB.hs b/src/Text/Pandoc/Writers/EPUB.hs index c2faf3a31..3b4ae8505 100644 --- a/src/Text/Pandoc/Writers/EPUB.hs +++ b/src/Text/Pandoc/Writers/EPUB.hs @@ -27,7 +27,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Conversion of 'Pandoc' documents to EPUB. -} -module Text.Pandoc.Writers.EPUB ( writeEPUB ) where +module Text.Pandoc.Writers.EPUB ( writeEPUB2, writeEPUB3 ) where import Data.IORef import Data.Maybe ( fromMaybe, isNothing ) import Data.List ( isPrefixOf, intercalate ) @@ -38,6 +38,8 @@ import qualified Data.ByteString.Lazy as B import Text.Pandoc.UTF8 ( fromStringLazy ) import Codec.Archive.Zip import Data.Time.Clock.POSIX +import Data.Time +import System.Locale import Text.Pandoc.Shared hiding ( Element ) import qualified Text.Pandoc.Shared as Shared import Text.Pandoc.Options @@ -56,11 +58,20 @@ import Prelude hiding (catch) import Control.Exception (catch, SomeException) import Text.HTML.TagSoup +data EPUBVersion = EPUB2 | EPUB3 deriving Eq + +writeEPUB2, writeEPUB3 :: WriterOptions -- ^ Writer options + -> Pandoc -- ^ Document to convert + -> IO B.ByteString +writeEPUB2 = writeEPUB EPUB2 +writeEPUB3 = writeEPUB EPUB3 + -- | Produce an EPUB file from a Pandoc document. -writeEPUB :: WriterOptions -- ^ Writer options +writeEPUB :: EPUBVersion + -> WriterOptions -- ^ Writer options -> Pandoc -- ^ Document to convert -> IO B.ByteString -writeEPUB opts doc@(Pandoc meta _) = do +writeEPUB version opts doc@(Pandoc meta _) = do epochtime <- floor `fmap` getPOSIXTime let mkEntry path content = toEntry path epochtime content let opts' = opts{ writerEmailObfuscation = NoObfuscation @@ -163,17 +174,23 @@ writeEPUB opts doc@(Pandoc meta _) = do let plainTitle = plainify $ docTitle meta let plainAuthors = map plainify $ docAuthors meta let plainDate = maybe "" id $ normalizeDate $ stringify $ docDate meta + currentTime <- getCurrentTime let contentsData = fromStringLazy $ ppTopElement $ - unode "package" ! [("version","2.0") + unode "package" ! [("version", case version of + EPUB2 -> "2.0" + EPUB3 -> "3.0") ,("xmlns","http://www.idpf.org/2007/opf") ,("unique-identifier","BookId")] $ - [ metadataElement (writerEPUBMetadata opts') - uuid lang plainTitle plainAuthors plainDate mbCoverImage + [ metadataElement version (writerEPUBMetadata opts') + uuid lang plainTitle plainAuthors plainDate currentTime mbCoverImage , unode "manifest" $ [ unode "item" ! [("id","ncx"), ("href","toc.ncx") ,("media-type","application/x-dtbncx+xml")] $ () , unode "item" ! [("id","style"), ("href","stylesheet.css") ,("media-type","text/css")] $ () + , unode "item" ! [("id","nav"), ("href","nav.xhtml") + ,("properties","nav") + ,("media-type","application/xhtml+xml")] $ () ] ++ map chapterNode (cpgEntry ++ (tpEntry : chapterEntries)) ++ map pictureNode (cpicEntry ++ picEntries) ++ @@ -190,8 +207,9 @@ writeEPUB opts doc@(Pandoc meta _) = do -- toc.ncx let secs = hierarchicalize blocks'' - let navPointNode :: Shared.Element -> State Int Element - navPointNode (Sec _ nums ident ils children) = do + let navPointNode :: (Int -> String -> String -> [Element] -> Element) + -> Shared.Element -> State Int Element + navPointNode formatter (Sec _ nums ident ils children) = do n <- get modify (+1) let showNums :: [Int] -> String @@ -206,14 +224,17 @@ writeEPUB opts doc@(Pandoc meta _) = do let isSec (Sec lev _ _ _ _) = lev <= 3 -- only includes levels 1-3 isSec _ = False let subsecs = filter isSec children - subs <- mapM navPointNode subsecs - return $ unode "navPoint" ! + subs <- mapM (navPointNode formatter) subsecs + return $ formatter n tit src subs + navPointNode _ (Blk _) = error "navPointNode encountered Blk" + + let navMapFormatter :: Int -> String -> String -> [Element] -> Element + navMapFormatter n tit src subs = unode "navPoint" ! [("id", "navPoint-" ++ show n) ,("playOrder", show n)] $ [ unode "navLabel" $ unode "text" tit , unode "content" ! [("src", src)] $ () ] ++ subs - navPointNode (Blk _) = error "navPointNode encountered Blk" let tpNode = unode "navPoint" ! [("id", "navPoint-0")] $ [ unode "navLabel" $ unode "text" (plainify $ docTitle meta) @@ -236,10 +257,31 @@ writeEPUB opts doc@(Pandoc meta _) = do Just _ -> [unode "meta" ! [("name","cover"), ("content","cover-image")] $ ()] , unode "docTitle" $ unode "text" $ plainTitle - , unode "navMap" $ tpNode : evalState (mapM navPointNode secs) 1 + , unode "navMap" $ + tpNode : evalState (mapM (navPointNode navMapFormatter) secs) 1 ] let tocEntry = mkEntry "toc.ncx" tocData + let navXhtmlFormatter :: Int -> String -> String -> [Element] -> Element + navXhtmlFormatter n tit src subs = unode "li" ! + [("id", "toc-li-" ++ show n)] $ + unode "a" ! [("href",src)] $ + unode "span" tit : + case subs of + [] -> [] + (_:_) -> [unode "ol" subs] + + let navData = fromStringLazy $ ppTopElement $ + unode "html" ! [("xmlns","http://www.w3.org/1999/xhtml") + ,("xmlns:epub","http://www.idpf.org/2007/ops")] $ + [ unode "head" $ unode "title" plainTitle + , unode "body" $ + unode "nav" ! [("epub:type","toc")] $ + [ unode "h1" plainTitle + , unode "ol" $ evalState (mapM (navPointNode navXhtmlFormatter) secs) 1] + ] + let navEntry = mkEntry "nav.xhtml" navData + -- mimetype let mimetypeEntry = mkEntry "mimetype" $ fromStringLazy "application/epub+zip" @@ -269,11 +311,13 @@ writeEPUB opts doc@(Pandoc meta _) = do let archive = foldr addEntryToArchive emptyArchive (mimetypeEntry : containerEntry : appleEntry : stylesheetEntry : tpEntry : contentsEntry : tocEntry : - (picEntries ++ cpicEntry ++ cpgEntry ++ chapterEntries ++ fontEntries) ) + ([navEntry | version == EPUB3] ++ picEntries ++ cpicEntry ++ cpgEntry ++ + chapterEntries ++ fontEntries) ) return $ fromArchive archive -metadataElement :: String -> UUID -> String -> String -> [String] -> String -> Maybe a -> Element -metadataElement metadataXML uuid lang title authors date mbCoverImage = +metadataElement :: EPUBVersion -> String -> UUID -> String -> String -> [String] + -> String -> UTCTime -> Maybe a -> Element +metadataElement version metadataXML uuid lang title authors date currentTime mbCoverImage = let userNodes = parseXML metadataXML elt = unode "metadata" ! [("xmlns:dc","http://purl.org/dc/elements/1.1/") ,("xmlns:opf","http://www.idpf.org/2007/opf")] $ @@ -292,10 +336,15 @@ metadataElement metadataXML uuid lang title authors date mbCoverImage = not (elt `contains` "identifier") ] ++ [ unode "dc:creator" ! [("opf:role","aut")] $ a | a <- authors ] ++ [ unode "dc:date" date | not (elt `contains` "date") ] ++ + [ unode "meta" ! [("property", "dcterms:modified")] $ + (showDateTimeISO8601 currentTime) | version == EPUB3 ] ++ [ unode "meta" ! [("name","cover"), ("content","cover-image")] $ () | not (isNothing mbCoverImage) ] in elt{ elContent = elContent elt ++ map Elem newNodes } +showDateTimeISO8601 :: UTCTime -> String +showDateTimeISO8601 = formatTime defaultTimeLocale "%FT%TZ" + transformInlines :: HTMLMathMethod -> FilePath -> IORef [(FilePath, FilePath)] -- ^ (oldpath, newpath) images diff --git a/src/pandoc.hs b/src/pandoc.hs index db98f41ee..7268f57f8 100644 --- a/src/pandoc.hs +++ b/src/pandoc.hs @@ -83,7 +83,7 @@ wrapWords indent c = wrap' (c - indent) (c - indent) else ", " ++ x ++ wrap' cols (remaining - (length x + 2)) xs isTextFormat :: String -> Bool -isTextFormat s = takeWhile (`notElem` "+-") s `notElem` ["odt","docx","epub"] +isTextFormat s = takeWhile (`notElem` "+-") s `notElem` ["odt","docx","epub","epub3"] -- | Data structure for command line options. data Opt = Opt -- cgit v1.2.3