@@ -1,4 +1,4 @@
1−{-# LANGUAGE PatternGuards, CPP #-}
1+{-# LANGUAGE PatternGuards, CPP, ScopedTypeVariables #-}
3Copyright (C) 2010 John MacFarlane <jgm@berkeley.edu>
3Copyright (C) 2010 John MacFarlane <jgm@berkeley.edu>
@@ -30,16 +30,18 @@ Conversion of 'Pandoc' documents to EPUB.
31module Text.Pandoc.Writers.EPUB ( writeEPUB ) where
31module Text.Pandoc.Writers.EPUB ( writeEPUB ) where
32import Data.IORef
32import Data.IORef
33+import qualified Data.Map as M
33−import Data.Maybe ( fromMaybe, isNothing )
34+import Data.Maybe ( fromMaybe )
34import Data.List ( isInfixOf, intercalate )
35import Data.List ( isInfixOf, intercalate )
35import System.Environment ( getEnv )
36import System.Environment ( getEnv )
36import Text.Printf (printf)
37import Text.Printf (printf)
37import System.FilePath ( (</>), takeBaseName, takeExtension, takeFileName )
38import System.FilePath ( (</>), takeBaseName, takeExtension, takeFileName )
38import qualified Data.ByteString.Lazy as B
39import qualified Data.ByteString.Lazy as B
39import qualified Data.ByteString.Lazy.Char8 as B8
40import qualified Data.ByteString.Lazy.Char8 as B8
40−import Text.Pandoc.UTF8 ( fromStringLazy, toString )
41+import qualified Text.Pandoc.UTF8 as UTF8
41import Text.Pandoc.SelfContained ( makeSelfContained )
42import Text.Pandoc.SelfContained ( makeSelfContained )
42import Codec.Archive.Zip
43import Codec.Archive.Zip
44+import Control.Applicative ((<$>))
43import Data.Time.Clock.POSIX
45import Data.Time.Clock.POSIX
44import Data.Time
46import Data.Time
45import System.Locale
47import System.Locale
@@ -54,7 +56,7 @@ import Text.XML.Light hiding (ppTopElement)
54import Text.Pandoc.UUID
56import Text.Pandoc.UUID
55import Text.Pandoc.Writers.HTML
57import Text.Pandoc.Writers.HTML
56import Text.Pandoc.Writers.Markdown ( writePlain )
58import Text.Pandoc.Writers.Markdown ( writePlain )
57−import Data.Char ( toLower )
59+import Data.Char ( toLower, isDigit )
58import Network.URI ( unEscapeString )
60import Network.URI ( unEscapeString )
59import Text.Pandoc.MIME (getMimeType)
61import Text.Pandoc.MIME (getMimeType)
60#if MIN_VERSION_base(4,6,0)
62#if MIN_VERSION_base(4,6,0)
@@ -70,12 +72,237 @@ import Text.Blaze.Html.Renderer.Utf8 (renderHtml)
70-- in filenames, chapter0003.xhtml.
72-- in filenames, chapter0003.xhtml.
71data Chapter = Chapter (Maybe [Int]) [Block]
73data Chapter = Chapter (Maybe [Int]) [Block]
75+data EPUBMetadata = EPUBMetadata{
76+ epubIdentifier :: [Identifier]
77+ , epubTitle :: [Title]
79+ , epubLanguage :: String
80+ , epubCreator :: [Creator]
81+ , epubContributor :: [Creator]
82+ , epubSubject :: [String]
83+ , epubDescription :: Maybe String
84+ , epubType :: Maybe String
85+ , epubFormat :: Maybe String
86+ , epubPublisher :: Maybe String
87+ , epubSource :: Maybe String
88+ , epubRelation :: Maybe String
89+ , epubCoverage :: Maybe String
90+ , epubRights :: Maybe String
91+ , epubCoverImage :: Maybe String
92+ , epubStylesheet :: Maybe Stylesheet
95+data Stylesheet = StylesheetPath FilePath
96+ | StylesheetContents String
99+data Creator = Creator{
100+ creatorText :: String
101+ , creatorRole :: Maybe String
102+ , creatorFileAs :: Maybe String
105+data Identifier = Identifier{
106+ identifierText :: String
107+ , identifierScheme :: Maybe String
112+ , titleFileAs :: Maybe String
113+ , titleType :: Maybe String
116+dcName :: String -> QName
117+dcName n = QName n Nothing (Just "dc")
119+dcNode :: Node t => String -> t -> Element
120+dcNode = node . dcName
122+opfName :: String -> QName
123+opfName n = QName n Nothing (Just "opf")
125+plainify :: [Inline] -> String
127+ trimr $ writePlain def{ writerStandalone = False }
128+ $ Pandoc nullMeta [Plain $ walk removeNote t]
130+removeNote :: Inline -> Inline
131+removeNote (Note _) = Str ""
134+getEPUBMetadata :: WriterOptions -> Meta -> IO EPUBMetadata
135+getEPUBMetadata opts meta = do
136+ let md = metadataFromMeta opts meta
137+ let elts = onlyElems $ parseXML $ writerEpubMetadata opts
138+ let md' = foldr addMetadataFromXML md elts
139+ let addIdentifier m =
140+ if null (epubIdentifier m)
142+ randomId <- fmap show getRandomUUID
143+ return $ m{ epubIdentifier = [Identifier randomId Nothing] }
146+ if null (epubLanguage m)
147+ then case lookup "lang" (writerVariables opts) of
148+ Just x -> return m{ epubLanguage = x }
150+ localeLang <- catch (liftM
151+ (map (\c -> if c == '_' then '-' else c) .
152+ takeWhile (/='.')) $ getEnv "LANG")
153+ (\e -> let _ = (e :: SomeException) in return "en-US")
154+ return m{ epubLanguage = localeLang }
157+ if null (epubDate m)
159+ currentTime <- getCurrentTime
160+ return $ m{ epubDate = showDateTimeISO8601 currentTime }
163+ if any (\c -> creatorRole c == Just "aut") $ epubCreator m
166+ let authors' = map plainify $ docAuthors meta
167+ let toAuthor name = Creator{ creatorText = name
168+ , creatorRole = Just "aut"
169+ , creatorFileAs = Nothing }
170+ return $ m{ epubCreator = map toAuthor authors' ++ epubCreator m }
171+ addIdentifier md' >>= fixDate >>= addAuthor >>= addLanguage
173+addMetadataFromXML :: Element -> EPUBMetadata -> EPUBMetadata
174+addMetadataFromXML e@(Element (QName name _ (Just "dc")) attrs _ _) md
175+ | name == "identifier" = md{ epubIdentifier =
176+ Identifier{ identifierText = strContent e
177+ , identifierScheme = lookupAttr (opfName "scheme") attrs
178+ } : epubIdentifier md }
179+ | name == "title" = md{ epubTitle =
180+ Title{ titleText = strContent e
181+ , titleFileAs = getAttr "file-as"
182+ , titleType = getAttr "type"
184+ | name == "date" = md{ epubDate = fromMaybe "" $ normalizeDate'
186+ | name == "language" = md{ epubLanguage = strContent e }
187+ | name == "creator" = md{ epubCreator =
188+ Creator{ creatorText = strContent e
189+ , creatorRole = getAttr "role"
190+ , creatorFileAs = getAttr "file-as"
191+ } : epubCreator md }
192+ | name == "contributor" = md{ epubContributor =
193+ Creator { creatorText = strContent e
194+ , creatorRole = getAttr "role"
195+ , creatorFileAs = getAttr "file-as"
196+ } : epubContributor md }
197+ | name == "subject" = md{ epubSubject = strContent e : epubSubject md }
198+ | name == "description" = md { epubDescription = Just $ strContent e }
199+ | name == "type" = md { epubType = Just $ strContent e }
200+ | name == "format" = md { epubFormat = Just $ strContent e }
201+ | name == "type" = md { epubType = Just $ strContent e }
202+ | name == "publisher" = md { epubPublisher = Just $ strContent e }
203+ | name == "source" = md { epubSource = Just $ strContent e }
204+ | name == "relation" = md { epubRelation = Just $ strContent e }
205+ | name == "coverage" = md { epubCoverage = Just $ strContent e }
206+ | name == "rights" = md { epubRights = Just $ strContent e }
208+ where getAttr n = lookupAttr (opfName n) attrs
209+addMetadataFromXML _ md = md
211+metaValueToString :: MetaValue -> String
212+metaValueToString (MetaString s) = s
213+metaValueToString (MetaInlines ils) = plainify ils
214+metaValueToString (MetaBlocks bs) = plainify $ query (:[]) bs
215+metaValueToString (MetaBool b) = show b
216+metaValueToString _ = ""
218+getList :: String -> Meta -> (MetaValue -> a) -> [a]
219+getList s meta handleMetaValue =
220+ case lookupMeta s meta of
221+ Just (MetaList xs) -> map handleMetaValue xs
222+ Just mv -> [handleMetaValue mv]
225+getIdentifier :: Meta -> [Identifier]
226+getIdentifier meta = getList "identifier" meta handleMetaValue
227+ where handleMetaValue (MetaMap m) =
228+ Identifier{ identifierText = maybe "" metaValueToString
230+ , identifierScheme = metaValueToString <$>
231+ M.lookup "scheme" m }
232+ handleMetaValue mv = Identifier (metaValueToString mv) Nothing
234+getTitle :: Meta -> [Title]
235+getTitle meta = getList "title" meta handleMetaValue
236+ where handleMetaValue (MetaMap m) =
237+ Title{ titleText = maybe "" metaValueToString $ M.lookup "text" m
238+ , titleFileAs = metaValueToString <$> M.lookup "file-as" m
239+ , titleType = metaValueToString <$> M.lookup "type" m }
240+ handleMetaValue mv = Title (metaValueToString mv) Nothing Nothing
242+getCreator :: String -> Meta -> [Creator]
243+getCreator s meta = getList s meta handleMetaValue
244+ where handleMetaValue (MetaMap m) =
245+ Creator{ creatorText = maybe "" metaValueToString $ M.lookup "text" m
246+ , creatorFileAs = metaValueToString <$> M.lookup "file-as" m
247+ , creatorRole = metaValueToString <$> M.lookup "role" m }
248+ handleMetaValue mv = Creator (metaValueToString mv) Nothing Nothing
250+simpleList :: String -> Meta -> [String]
252+ case lookupMeta s meta of
253+ Just (MetaList xs) -> map metaValueToString xs
254+ Just x -> [metaValueToString x]
257+metadataFromMeta :: WriterOptions -> Meta -> EPUBMetadata
258+metadataFromMeta opts meta = EPUBMetadata{
259+ epubIdentifier = identifiers
260+ , epubTitle = titles
262+ , epubLanguage = language
263+ , epubCreator = creators
264+ , epubContributor = contributors
265+ , epubSubject = subjects
266+ , epubDescription = description
267+ , epubType = epubtype
268+ , epubFormat = format
269+ , epubPublisher = publisher
270+ , epubSource = source
271+ , epubRelation = relation
272+ , epubCoverage = coverage
273+ , epubRights = rights
274+ , epubCoverImage = coverImage
275+ , epubStylesheet = stylesheet
277+ where identifiers = getIdentifier meta
278+ titles = getTitle meta
279+ date = fromMaybe "" $
280+ (metaValueToString <$> lookupMeta "date" meta) >>= normalizeDate'
281+ language = maybe "" metaValueToString $
282+ lookupMeta "language" meta `mplus` lookupMeta "lang" meta
283+ creators = getCreator "creator" meta
284+ contributors = getCreator "contributor" meta
285+ subjects = simpleList "subject" meta
286+ description = metaValueToString <$> lookupMeta "description" meta
287+ epubtype = metaValueToString <$> lookupMeta "type" meta
288+ format = metaValueToString <$> lookupMeta "format" meta
289+ publisher = metaValueToString <$> lookupMeta "publisher" meta
290+ source = metaValueToString <$> lookupMeta "source" meta
291+ relation = metaValueToString <$> lookupMeta "relation" meta
292+ coverage = metaValueToString <$> lookupMeta "coverage" meta
293+ rights = metaValueToString <$> lookupMeta "rights" meta
294+ coverImage = lookup "epub-cover-image" (writerVariables opts) `mplus`
295+ (metaValueToString <$> lookupMeta "cover-image" meta)
296+ stylesheet = (StylesheetContents <$> writerEpubStylesheet opts) `mplus`
297+ ((StylesheetPath . metaValueToString) <$>
298+ lookupMeta "stylesheet" meta)
73-- | Produce an EPUB file from a Pandoc document.
300-- | Produce an EPUB file from a Pandoc document.
74writeEPUB :: WriterOptions -- ^ Writer options
301writeEPUB :: WriterOptions -- ^ Writer options
75 -> Pandoc -- ^ Document to convert
302 -> Pandoc -- ^ Document to convert
76 -> IO B.ByteString
303 -> IO B.ByteString
77writeEPUB opts doc@(Pandoc meta _) = do
304writeEPUB opts doc@(Pandoc meta _) = do
78− let version = maybe EPUB2 id (writerEpubVersion opts)
305+ let version = fromMaybe EPUB2 (writerEpubVersion opts)
79 let epub3 = version == EPUB3
306 let epub3 = version == EPUB3
80 epochtime <- floor `fmap` getPOSIXTime
307 epochtime <- floor `fmap` getPOSIXTime
81 let mkEntry path content = toEntry path epochtime content
308 let mkEntry path content = toEntry path epochtime content
@@ -93,11 +320,11 @@ writeEPUB opts doc@(Pandoc meta _) = do
93 then MathML Nothing
320 then MathML Nothing
94 else writerHTMLMathMethod opts
321 else writerHTMLMathMethod opts
95 , writerWrapText = False }
322 , writerWrapText = False }
96− let mbCoverImage = lookup "epub-cover-image" vars
323+ metadata <- getEPUBMetadata opts' meta
98 -- cover page
325 -- cover page
99 (cpgEntry, cpicEntry) <-
326 (cpgEntry, cpicEntry) <-
100− case mbCoverImage of
327+ case epubCoverImage metadata of
101 Nothing -> return ([],[])
328 Nothing -> return ([],[])
102 Just img -> do
329 Just img -> do
103 let coverImage = "cover-image" ++ takeExtension img
330 let coverImage = "cover-image" ++ takeExtension img
@@ -179,32 +406,33 @@ writeEPUB opts doc@(Pandoc meta _) = do
179 chapToEntry num (Chapter mbnum bs) = mkEntry (showChapter num)
406 chapToEntry num (Chapter mbnum bs) = mkEntry (showChapter num)
180 $ renderHtml
407 $ renderHtml
181 $ writeHtml opts'{ writerNumberOffset =
408 $ writeHtml opts'{ writerNumberOffset =
182− maybe [] id mbnum }
409+ fromMaybe [] mbnum }
183 $ case bs of
410 $ case bs of
184 (Header _ _ xs : _) ->
411 (Header _ _ xs : _) ->
412+ -- remove notes or we get doubled footnotes
185− Pandoc (setMeta "title" (fromList xs) nullMeta) bs
413+ Pandoc (setMeta "title" (walk removeNote $ fromList xs)
187 Pandoc nullMeta bs
416 Pandoc nullMeta bs
189 let chapterEntries = zipWith chapToEntry [1..] chapters
418 let chapterEntries = zipWith chapToEntry [1..] chapters
191 -- incredibly inefficient (TODO):
420 -- incredibly inefficient (TODO):
421+ let containsMathML ent = epub3 &&
192− let containsMathML ent = "<math" `isInfixOf` (B8.unpack $ fromEntry ent)
422+ "<math" `isInfixOf` (B8.unpack $ fromEntry ent)
423+ let containsSVG ent = epub3 &&
424+ "<svg" `isInfixOf` (B8.unpack $ fromEntry ent)
425+ let props ent = ["mathml" | containsMathML ent] ++ ["svg" | containsSVG ent]
194 -- contents.opf
427 -- contents.opf
195− localeLang <- catch (liftM (map (\c -> if c == '_' then '-' else c) .
196− takeWhile (/='.')) $ getEnv "LANG")
197− (\e -> let _ = (e :: SomeException) in return "en-US")
198− let lang = case lookup "lang" (writerVariables opts') of
200− Nothing -> localeLang
201− uuid <- getRandomUUID
202 let chapterNode ent = unode "item" !
428 let chapterNode ent = unode "item" !
203 ([("id", takeBaseName $ eRelativePath ent),
429 ([("id", takeBaseName $ eRelativePath ent),
204 ("href", eRelativePath ent),
430 ("href", eRelativePath ent),
205 ("media-type", "application/xhtml+xml")]
431 ("media-type", "application/xhtml+xml")]
432+ ++ case props ent of
206− ++ [("properties","mathml") | epub3 &&
434+ xs -> [("properties", unwords xs)])
207− containsMathML ent]) $ ()
435+ $ ()
208 let chapterRefNode ent = unode "itemref" !
436 let chapterRefNode ent = unode "itemref" !
209 [("idref", takeBaseName $ eRelativePath ent)] $ ()
437 [("idref", takeBaseName $ eRelativePath ent)] $ ()
210 let pictureNode ent = unode "item" !
438 let pictureNode ent = unode "item" !
@@ -215,23 +443,23 @@ writeEPUB opts doc@(Pandoc meta _) = do
215 let fontNode ent = unode "item" !
443 let fontNode ent = unode "item" !
216 [("id", takeBaseName $ eRelativePath ent),
444 [("id", takeBaseName $ eRelativePath ent),
217 ("href", eRelativePath ent),
445 ("href", eRelativePath ent),
218− ("media-type", maybe "" id $ getMimeType $ eRelativePath ent)] $ ()
446+ ("media-type", fromMaybe "" $ getMimeType $ eRelativePath ent)] $ ()
219− let plainify t = trimr $
220− writePlain opts'{ writerStandalone = False } $
221− Pandoc meta [Plain t]
222− let plainTitle = plainify $ docTitle meta
447+ let plainTitle = case docTitle meta of
223− let plainAuthors = map plainify $ docAuthors meta
448+ [] -> case epubTitle metadata of
450+ (x:_) -> titleText x
452+ let uuid = case epubIdentifier metadata of
453+ (x:_) -> identifierText x -- use first identifier as UUID
454+ [] -> error "epubIdentifier is null" -- shouldn't happen
224 currentTime <- getCurrentTime
455 currentTime <- getCurrentTime
225− let plainDate = maybe (showDateTimeISO8601 currentTime) id
226− $ normalizeDate $ stringify $ docDate meta
227− let contentsData = fromStringLazy $ ppTopElement $
456+ let contentsData = UTF8.fromStringLazy $ ppTopElement $
228 unode "package" ! [("version", case version of
457 unode "package" ! [("version", case version of
229 EPUB2 -> "2.0"
458 EPUB2 -> "2.0"
230 EPUB3 -> "3.0")
459 EPUB3 -> "3.0")
231 ,("xmlns","http://www.idpf.org/2007/opf")
460 ,("xmlns","http://www.idpf.org/2007/opf")
232− ,("unique-identifier","BookId")] $
461+ ,("unique-identifier","epub-id-1")] $
233− [ metadataElement version (writerEpubMetadata opts')
462+ [ metadataElement version metadata currentTime
234− uuid lang plainTitle plainAuthors plainDate currentTime mbCoverImage
235 , unode "manifest" $
463 , unode "manifest" $
236 [ unode "item" ! [("id","ncx"), ("href","toc.ncx")
464 [ unode "item" ! [("id","ncx"), ("href","toc.ncx")
237 ,("media-type","application/x-dtbncx+xml")] $ ()
465 ,("media-type","application/x-dtbncx+xml")] $ ()
@@ -243,10 +471,15 @@ writeEPUB opts doc@(Pandoc meta _) = do
243 [("properties","nav") | epub3 ]) $ ()
471 [("properties","nav") | epub3 ]) $ ()
245 map chapterNode (cpgEntry ++ (tpEntry : chapterEntries)) ++
473 map chapterNode (cpgEntry ++ (tpEntry : chapterEntries)) ++
477+ [Attr (unqual "properties") "cover-image" | epub3]
478+ (pictureNode x)]) ++
246− map pictureNode (cpicEntry ++ picEntries) ++
479+ map pictureNode picEntries ++
247 map fontNode fontEntries
480 map fontNode fontEntries
248 , unode "spine" ! [("toc","ncx")] $
481 , unode "spine" ! [("toc","ncx")] $
249− case mbCoverImage of
482+ case epubCoverImage metadata of
250 Nothing -> []
483 Nothing -> []
251 Just _ -> [ unode "itemref" !
484 Just _ -> [ unode "itemref" !
252 [("idref", "cover"),("linear","no")] $ () ]
485 [("idref", "cover"),("linear","no")] $ () ]
@@ -260,8 +493,13 @@ writeEPUB opts doc@(Pandoc meta _) = do
260 else "no")] $ ()) :
493 else "no")] $ ()) :
261 map chapterRefNode chapterEntries)
494 map chapterRefNode chapterEntries)
262 , unode "guide" $
495 , unode "guide" $
263− unode "reference" !
496+ [ unode "reference" !
264− [("type","toc"),("title",plainTitle),("href","nav.xhtml")] $ ()
497+ [("type","toc"),("title",plainTitle),
498+ ("href","nav.xhtml")] $ ()
500+ [ unode "reference" !
501+ [("type","cover"),("title","Cover"),("href","cover.xhtml")] $ () | epubCoverImage metadata /= Nothing
266 let contentsEntry = mkEntry "content.opf" contentsData
504 let contentsEntry = mkEntry "content.opf" contentsData
@@ -303,19 +541,19 @@ writeEPUB opts doc@(Pandoc meta _) = do
303 [ unode "navLabel" $ unode "text" (plainify $ docTitle meta)
541 [ unode "navLabel" $ unode "text" (plainify $ docTitle meta)
304 , unode "content" ! [("src","title_page.xhtml")] $ () ]
542 , unode "content" ! [("src","title_page.xhtml")] $ () ]
306− let tocData = fromStringLazy $ ppTopElement $
544+ let tocData = UTF8.fromStringLazy $ ppTopElement $
307 unode "ncx" ! [("version","2005-1")
545 unode "ncx" ! [("version","2005-1")
308 ,("xmlns","http://www.daisy.org/z3986/2005/ncx/")] $
546 ,("xmlns","http://www.daisy.org/z3986/2005/ncx/")] $
309 [ unode "head" $
547 [ unode "head" $
310 [ unode "meta" ! [("name","dtb:uid")
548 [ unode "meta" ! [("name","dtb:uid")
311− ,("content", show uuid)] $ ()
549+ ,("content", uuid)] $ ()
312 , unode "meta" ! [("name","dtb:depth")
550 , unode "meta" ! [("name","dtb:depth")
313 ,("content", "1")] $ ()
551 ,("content", "1")] $ ()
314 , unode "meta" ! [("name","dtb:totalPageCount")
552 , unode "meta" ! [("name","dtb:totalPageCount")
315 ,("content", "0")] $ ()
553 ,("content", "0")] $ ()
316 , unode "meta" ! [("name","dtb:maxPageNumber")
554 , unode "meta" ! [("name","dtb:maxPageNumber")
317 ,("content", "0")] $ ()
555 ,("content", "0")] $ ()
318− ] ++ case mbCoverImage of
556+ ] ++ case epubCoverImage metadata of
319 Nothing -> []
557 Nothing -> []
320 Just _ -> [unode "meta" ! [("name","cover"),
558 Just _ -> [unode "meta" ! [("name","cover"),
321 ("content","cover-image")] $ ()]
559 ("content","cover-image")] $ ()]
@@ -335,7 +573,7 @@ writeEPUB opts doc@(Pandoc meta _) = do
335 (_:_) -> [unode "ol" ! [("class","toc")] $ subs]
573 (_:_) -> [unode "ol" ! [("class","toc")] $ subs]
337 let navtag = if epub3 then "nav" else "div"
575 let navtag = if epub3 then "nav" else "div"
338− let navData = fromStringLazy $ ppTopElement $
576+ let navData = UTF8.fromStringLazy $ ppTopElement $
339 unode "html" ! [("xmlns","http://www.w3.org/1999/xhtml")
577 unode "html" ! [("xmlns","http://www.w3.org/1999/xhtml")
340 ,("xmlns:epub","http://www.idpf.org/2007/ops")] $
578 ,("xmlns:epub","http://www.idpf.org/2007/ops")] $
341 [ unode "head" $
579 [ unode "head" $
@@ -349,10 +587,10 @@ writeEPUB opts doc@(Pandoc meta _) = do
349 let navEntry = mkEntry "nav.xhtml" navData
587 let navEntry = mkEntry "nav.xhtml" navData
351 -- mimetype
589 -- mimetype
352− let mimetypeEntry = mkEntry "mimetype" $ fromStringLazy "application/epub+zip"
590+ let mimetypeEntry = mkEntry "mimetype" $ UTF8.fromStringLazy "application/epub+zip"
354 -- container.xml
592 -- container.xml
355− let containerData = fromStringLazy $ ppTopElement $
593+ let containerData = UTF8.fromStringLazy $ ppTopElement $
356 unode "container" ! [("version","1.0")
594 unode "container" ! [("version","1.0")
357 ,("xmlns","urn:oasis:names:tc:opendocument:xmlns:container")] $
595 ,("xmlns","urn:oasis:names:tc:opendocument:xmlns:container")] $
358 unode "rootfiles" $
596 unode "rootfiles" $
@@ -361,18 +599,19 @@ writeEPUB opts doc@(Pandoc meta _) = do
361 let containerEntry = mkEntry "META-INF/container.xml" containerData
599 let containerEntry = mkEntry "META-INF/container.xml" containerData
363 -- com.apple.ibooks.display-options.xml
601 -- com.apple.ibooks.display-options.xml
364− let apple = fromStringLazy $ ppTopElement $
602+ let apple = UTF8.fromStringLazy $ ppTopElement $
365 unode "display_options" $
603 unode "display_options" $
366 unode "platform" ! [("name","*")] $
604 unode "platform" ! [("name","*")] $
367 unode "option" ! [("name","specified-fonts")] $ "true"
605 unode "option" ! [("name","specified-fonts")] $ "true"
368 let appleEntry = mkEntry "META-INF/com.apple.ibooks.display-options.xml" apple
606 let appleEntry = mkEntry "META-INF/com.apple.ibooks.display-options.xml" apple
370 -- stylesheet
608 -- stylesheet
371− stylesheet <- case writerEpubStylesheet opts of
609+ stylesheet <- case epubStylesheet metadata of
372− Just s -> return s
610+ Just (StylesheetPath fp) -> UTF8.readFile fp
611+ Just (StylesheetContents s) -> return s
373− Nothing -> toString `fmap`
612+ Nothing -> UTF8.toString `fmap`
374 readDataFile (writerUserDataDir opts) "epub.css"
613 readDataFile (writerUserDataDir opts) "epub.css"
375− let stylesheetEntry = mkEntry "stylesheet.css" $ fromStringLazy stylesheet
614+ let stylesheetEntry = mkEntry "stylesheet.css" $ UTF8.fromStringLazy stylesheet
377 -- construct archive
616 -- construct archive
378 let archive = foldr addEntryToArchive emptyArchive
617 let archive = foldr addEntryToArchive emptyArchive
@@ -381,33 +620,97 @@ writeEPUB opts doc@(Pandoc meta _) = do
381 (picEntries ++ cpicEntry ++ cpgEntry ++ chapterEntries ++ fontEntries))
620 (picEntries ++ cpicEntry ++ cpgEntry ++ chapterEntries ++ fontEntries))
382 return $ fromArchive archive
621 return $ fromArchive archive
384−metadataElement :: EPUBVersion -> String -> UUID -> String -> String -> [String]
623+metadataElement :: EPUBVersion -> EPUBMetadata -> UTCTime -> Element
385− -> String -> UTCTime -> Maybe a -> Element
386−metadataElement version metadataXML uuid lang title authors date currentTime mbCoverImage =
624+metadataElement version md currentTime =
387− let userNodes = parseXML metadataXML
388− elt = unode "metadata" ! [("xmlns:dc","http://purl.org/dc/elements/1.1/")
625+ unode "metadata" ! [("xmlns:dc","http://purl.org/dc/elements/1.1/")
389− ,("xmlns:opf","http://www.idpf.org/2007/opf")] $
626+ ,("xmlns:opf","http://www.idpf.org/2007/opf")] $ mdNodes
390− filter isMetadataElement $ onlyElems userNodes
627+ where mdNodes = identifierNodes ++ titleNodes ++ dateNodes ++ languageNodes
391− dublinElements = ["contributor","coverage","creator","date",
628+ ++ creatorNodes ++ contributorNodes ++ subjectNodes
392− "description","format","identifier","language","publisher",
629+ ++ descriptionNodes ++ typeNodes ++ formatNodes
393− "relation","rights","source","subject","title","type"]
630+ ++ publisherNodes ++ sourceNodes ++ relationNodes
394− isMetadataElement e = (qPrefix (elName e) == Just "dc" &&
631+ ++ coverageNodes ++ rightsNodes ++ coverImageNodes
395− qName (elName e) `elem` dublinElements) ||
632+ ++ modifiedNodes
396− (qPrefix (elName e) == Nothing &&
633+ withIds base f = concat . zipWith f (map (\x -> base ++ ('-' : show x))
397− qName (elName e) `elem` ["link","meta"])
634+ ([1..] :: [Int]))
398− contains e n = not (null (findElements (QName n Nothing (Just "dc")) e))
635+ identifierNodes = withIds "epub-id" toIdentifierNode $
399− newNodes = [ unode "dc:title" title | not (elt `contains` "title") ] ++
636+ epubIdentifier md
400− [ unode "dc:language" lang | not (elt `contains` "language") ] ++
637+ titleNodes = withIds "epub-title" toTitleNode $ epubTitle md
401− [ unode "dc:identifier" ! [("id","BookId")] $ show uuid |
638+ dateNodes = dcTag' "date" $ epubDate md
402− not (elt `contains` "identifier") ] ++
639+ languageNodes = [dcTag "language" $ epubLanguage md]
403− [ unode "dc:creator" ! [("opf:role","aut") | version == EPUB2]
640+ creatorNodes = withIds "epub-creator" (toCreatorNode "creator") $
404− $ a | a <- authors, not (elt `contains` "creator") ] ++
641+ epubCreator md
405− [ unode "dc:date" date | not (elt `contains` "date") ] ++
642+ contributorNodes = withIds "epub-contributor"
643+ (toCreatorNode "contributor") $ epubContributor md
644+ subjectNodes = map (dcTag "subject") $ epubSubject md
645+ descriptionNodes = maybe [] (dcTag' "description") $ epubDescription md
646+ typeNodes = maybe [] (dcTag' "type") $ epubType md
647+ formatNodes = maybe [] (dcTag' "format") $ epubFormat md
648+ publisherNodes = maybe [] (dcTag' "publisher") $ epubPublisher md
649+ sourceNodes = maybe [] (dcTag' "source") $ epubSource md
650+ relationNodes = maybe [] (dcTag' "relation") $ epubRelation md
651+ coverageNodes = maybe [] (dcTag' "coverage") $ epubCoverage md
652+ rightsNodes = maybe [] (dcTag' "rights") $ epubRights md
653+ coverImageNodes = maybe []
654+ (const $ [unode "meta" ! [("name","cover"),
655+ ("content","cover-image")] $ ()])
406− [ unode "meta" ! [("property", "dcterms:modified")] $
657+ modifiedNodes = [ unode "meta" ! [("property", "dcterms:modified")] $
407− (showDateTimeISO8601 currentTime) | version == EPUB3] ++
658+ (showDateTimeISO8601 currentTime) | version == EPUB3 ]
408− [ unode "meta" ! [("name","cover"), ("content","cover-image")] $ () |
659+ dcTag n s = unode ("dc:" ++ n) s
409− not (isNothing mbCoverImage) ]
660+ dcTag' n s = [dcTag n s]
410− in elt{ elContent = elContent elt ++ map Elem newNodes }
661+ toIdentifierNode id' (Identifier txt scheme)
662+ | version == EPUB2 = [dcNode "identifier" !
663+ ([("id",id')] ++ maybe [] (\x -> [("opf:scheme", x)]) scheme) $
665+ | otherwise = [dcNode "identifier" ! [("id",id')] $ txt] ++
666+ maybe [] (\x -> [unode "meta" !
667+ [("refines",'#':id'),("property","identifier-type"),
668+ ("scheme","onix:codelist5")] $ x])
669+ (schemeToOnix `fmap` scheme)
670+ toCreatorNode s id' creator
671+ | version == EPUB2 = [dcNode s !
673+ maybe [] (\x -> [("opf:file-as",x)]) (creatorFileAs creator) ++
674+ maybe [] (\x -> [("opf:role",x)])
675+ (creatorRole creator >>= toRelator)) $ creatorText creator]
676+ | otherwise = [dcNode s ! [("id",id')] $ creatorText creator] ++
677+ maybe [] (\x -> [unode "meta" !
678+ [("refines",'#':id'),("property","file-as")] $ x])
679+ (creatorFileAs creator) ++
680+ maybe [] (\x -> [unode "meta" !
681+ [("refines",'#':id'),("property","role"),
682+ ("scheme","marc:relators")] $ x])
683+ (creatorRole creator >>= toRelator)
684+ toTitleNode id' title
685+ | version == EPUB2 = [dcNode "title" !
687+ maybe [] (\x -> [("opf:file-as",x)]) (titleFileAs title) ++
688+ maybe [] (\x -> [("opf:title-type",x)]) (titleType title)) $
690+ | otherwise = [dcNode "title" ! [("id",id')] $ titleText title]
692+ maybe [] (\x -> [unode "meta" !
693+ [("refines",'#':id'),("property","file-as")] $ x])
694+ (titleFileAs title) ++
695+ maybe [] (\x -> [unode "meta" !
696+ [("refines",'#':id'),("property","title-type")] $ x])
698+ schemeToOnix "ISBN-10" = "02"
699+ schemeToOnix "GTIN-13" = "03"
700+ schemeToOnix "UPC" = "04"
701+ schemeToOnix "ISMN-10" = "05"
702+ schemeToOnix "DOI" = "06"
703+ schemeToOnix "LCCN" = "13"
704+ schemeToOnix "GTIN-14" = "14"
705+ schemeToOnix "ISBN-13" = "15"
706+ schemeToOnix "Legal deposit number" = "17"
707+ schemeToOnix "URN" = "22"
708+ schemeToOnix "OCLC" = "23"
709+ schemeToOnix "ISMN-13" = "25"
710+ schemeToOnix "ISBN-A" = "26"
711+ schemeToOnix "JP" = "27"
712+ schemeToOnix "OLCC" = "28"
713+ schemeToOnix _ = "01"
412showDateTimeISO8601 :: UTCTime -> String
715showDateTimeISO8601 :: UTCTime -> String
413showDateTimeISO8601 = formatTime defaultTimeLocale "%FT%TZ"
716showDateTimeISO8601 = formatTime defaultTimeLocale "%FT%TZ"
@@ -457,15 +760,9 @@ ppTopElement = ("<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n" ++) . unEntity .
457 unEntity (x:xs) = x : unEntity xs
760 unEntity (x:xs) = x : unEntity xs
459imageTypeOf :: FilePath -> Maybe String
762imageTypeOf :: FilePath -> Maybe String
460−imageTypeOf x = case drop 1 (map toLower (takeExtension x)) of
763+imageTypeOf x = case getMimeType x of
461− "jpg" -> Just "image/jpeg"
764+ Just y@('i':'m':'a':'g':'e':_) -> Just y
462− "jpeg" -> Just "image/jpeg"
463− "jfif" -> Just "image/jpeg"
464− "png" -> Just "image/png"
465− "gif" -> Just "image/gif"
466− "svg" -> Just "image/svg+xml"
467− _ -> Nothing
765+ _ -> Nothing
470data IdentState = IdentState{
767data IdentState = IdentState{
471 chapterNumber :: Int,
768 chapterNumber :: Int,
@@ -519,3 +816,287 @@ replaceRefs refTable = walk replaceOneRef
519 Just url -> Link lab (url,tit)
816 Just url -> Link lab (url,tit)
520 Nothing -> x
817 Nothing -> x
521 replaceOneRef x = x
818 replaceOneRef x = x
820+-- Variant of normalizeDate that allows partial dates: YYYY, YYYY-MM
821+normalizeDate' :: String -> Maybe String
823+ let xs' = trim xs in
825+ [y1,y2,y3,y4] | all isDigit [y1,y2,y3,y4] -> Just xs' -- YYYY
826+ [y1,y2,y3,y4,'-',m1,m2] | all isDigit [y1,y2,y3,y4,m1,m2] -- YYYY-MM
828+ _ -> normalizeDate xs'
830+toRelator :: String -> Maybe String
832+ | x `elem` relators = Just x
833+ | otherwise = lookup (map toLower x) relatorMap
836+relators = map snd relatorMap
838+relatorMap :: [(String, String)]
840+ [("abridger", "abr")
843+ ,("addressee", "rcp")
845+ ,("animator", "anm")
846+ ,("annotator", "ann")
847+ ,("appellant", "apl")
848+ ,("appellee", "ape")
849+ ,("applicant", "app")
850+ ,("architect", "arc")
851+ ,("arranger", "arr")
852+ ,("art copyist", "acp")
853+ ,("art director", "adi")
855+ ,("artistic director", "ard")
856+ ,("assignee", "asg")
857+ ,("associated name", "asn")
858+ ,("attributed name", "att")
859+ ,("auctioneer", "auc")
861+ ,("author in quotations or text abstracts", "aqt")
862+ ,("author of afterword, colophon, etc.", "aft")
863+ ,("author of dialog", "aud")
864+ ,("author of introduction, etc.", "aui")
865+ ,("autographer", "ato")
866+ ,("bibliographic antecedent", "ant")
868+ ,("binding designer", "bdd")
869+ ,("blurb writer", "blw")
870+ ,("book designer", "bkd")
871+ ,("book producer", "bkp")
872+ ,("bookjacket designer", "bjd")
873+ ,("bookplate designer", "bpd")
874+ ,("bookseller", "bsl")
875+ ,("braille embosser", "brl")
876+ ,("broadcaster", "brd")
877+ ,("calligrapher", "cll")
878+ ,("cartographer", "ctg")
881+ ,("choreographer", "chr")
882+ ,("cinematographer", "cng")
884+ ,("collection registrar", "cor")
885+ ,("collector", "col")
886+ ,("collotyper", "clt")
887+ ,("colorist", "clr")
888+ ,("commentator", "cmm")
889+ ,("commentator for written text", "cwt")
890+ ,("compiler", "com")
891+ ,("complainant", "cpl")
892+ ,("complainant-appellant", "cpt")
893+ ,("complainant-appellee", "cpe")
894+ ,("composer", "cmp")
895+ ,("compositor", "cmt")
896+ ,("conceptor", "ccp")
897+ ,("conductor", "cnd")
898+ ,("conservator", "con")
899+ ,("consultant", "csl")
900+ ,("consultant to a project", "csp")
901+ ,("contestant", "cos")
902+ ,("contestant-appellant", "cot")
903+ ,("contestant-appellee", "coe")
904+ ,("contestee", "cts")
905+ ,("contestee-appellant", "ctt")
906+ ,("contestee-appellee", "cte")
907+ ,("contractor", "ctr")
908+ ,("contributor", "ctb")
909+ ,("copyright claimant", "cpc")
910+ ,("copyright holder", "cph")
911+ ,("corrector", "crr")
912+ ,("correspondent", "crp")
913+ ,("costume designer", "cst")
914+ ,("court governed", "cou")
915+ ,("court reporter", "crt")
916+ ,("cover designer", "cov")
920+ ,("data contributor", "dtc")
921+ ,("data manager", "dtm")
922+ ,("dedicatee", "dte")
923+ ,("dedicator", "dto")
924+ ,("defendant", "dfd")
925+ ,("defendant-appellant", "dft")
926+ ,("defendant-appellee", "dfe")
927+ ,("degree granting institution", "dgg")
928+ ,("delineator", "dln")
929+ ,("depicted", "dpc")
930+ ,("depositor", "dpt")
931+ ,("designer", "dsr")
932+ ,("director", "drt")
933+ ,("dissertant", "dis")
934+ ,("distribution place", "dbp")
935+ ,("distributor", "dst")
937+ ,("draftsman", "drm")
938+ ,("dubious author", "dub")
940+ ,("editor of compilation", "edc")
941+ ,("editor of moving image work", "edm")
942+ ,("electrician", "elg")
943+ ,("electrotyper", "elt")
944+ ,("enacting jurisdiction", "enj")
945+ ,("engineer", "eng")
946+ ,("engraver", "egr")
948+ ,("event place", "evp")
950+ ,("facsimilist", "fac")
951+ ,("field director", "fld")
952+ ,("film director", "fmd")
953+ ,("film distributor", "fds")
954+ ,("film editor", "flm")
955+ ,("film producer", "fmp")
956+ ,("filmmaker", "fmk")
957+ ,("first party", "fpy")
959+ ,("former owner", "fmo")
961+ ,("geographic information specialist", "gis")
964+ ,("host institution", "his")
965+ ,("illuminator", "ilu")
966+ ,("illustrator", "ill")
967+ ,("inscriber", "ins")
968+ ,("instrumentalist", "itr")
969+ ,("interviewee", "ive")
970+ ,("interviewer", "ivr")
971+ ,("inventor", "inv")
972+ ,("issuing body", "isb")
974+ ,("jurisdiction governed", "jug")
975+ ,("laboratory", "lbr")
976+ ,("laboratory director", "ldr")
977+ ,("landscape architect", "lsa")
980+ ,("libelant", "lil")
981+ ,("libelant-appellant", "lit")
982+ ,("libelant-appellee", "lie")
984+ ,("libelee-appellant", "let")
985+ ,("libelee-appellee", "lee")
986+ ,("librettist", "lbt")
987+ ,("licensee", "lse")
988+ ,("licensor", "lso")
989+ ,("lighting designer", "lgd")
990+ ,("lithographer", "ltg")
991+ ,("lyricist", "lyr")
992+ ,("manufacture place", "mfp")
993+ ,("manufacturer", "mfr")
995+ ,("markup editor", "mrk")
996+ ,("metadata contact", "mdc")
997+ ,("metal-engraver", "mte")
998+ ,("moderator", "mod")
1000+ ,("music copyist", "mcp")
1001+ ,("musical director", "msd")
1002+ ,("musician", "mus")
1003+ ,("narrator", "nrt")
1004+ ,("onscreen presenter", "osp")
1005+ ,("opponent", "opn")
1006+ ,("organizer of meeting", "orm")
1007+ ,("originator", "org")
1010+ ,("panelist", "pan")
1011+ ,("papermaker", "ppm")
1012+ ,("patent applicant", "pta")
1013+ ,("patent holder", "pth")
1015+ ,("performer", "prf")
1016+ ,("permitting agency", "pma")
1017+ ,("photographer", "pht")
1018+ ,("plaintiff", "ptf")
1019+ ,("plaintiff-appellant", "ptt")
1020+ ,("plaintiff-appellee", "pte")
1021+ ,("platemaker", "plt")
1022+ ,("praeses", "pra")
1023+ ,("presenter", "pre")
1024+ ,("printer", "prt")
1025+ ,("printer of plates", "pop")
1026+ ,("printmaker", "prm")
1027+ ,("process contact", "prc")
1028+ ,("producer", "pro")
1029+ ,("production company", "prn")
1030+ ,("production designer", "prs")
1031+ ,("production manager", "pmn")
1032+ ,("production personnel", "prd")
1033+ ,("production place", "prp")
1034+ ,("programmer", "prg")
1035+ ,("project director", "pdr")
1036+ ,("proofreader", "pfr")
1037+ ,("provider", "prv")
1038+ ,("publication place", "pup")
1039+ ,("publisher", "pbl")
1040+ ,("publishing director", "pbd")
1041+ ,("puppeteer", "ppt")
1042+ ,("radio director", "rdd")
1043+ ,("radio producer", "rpc")
1044+ ,("recording engineer", "rce")
1045+ ,("recordist", "rcd")
1046+ ,("redaktor", "red")
1047+ ,("renderer", "ren")
1048+ ,("reporter", "rpt")
1049+ ,("repository", "rps")
1050+ ,("research team head", "rth")
1051+ ,("research team member", "rtm")
1052+ ,("researcher", "res")
1053+ ,("respondent", "rsp")
1054+ ,("respondent-appellant", "rst")
1055+ ,("respondent-appellee", "rse")
1056+ ,("responsible party", "rpy")
1057+ ,("restager", "rsg")
1058+ ,("restorationist", "rsr")
1059+ ,("reviewer", "rev")
1060+ ,("rubricator", "rbr")
1061+ ,("scenarist", "sce")
1062+ ,("scientific advisor", "sad")
1063+ ,("screenwriter", "aus")
1065+ ,("sculptor", "scl")
1066+ ,("second party", "spy")
1067+ ,("secretary", "sec")
1069+ ,("set designer", "std")
1070+ ,("setting", "stg")
1073+ ,("sound designer", "sds")
1074+ ,("speaker", "spk")
1075+ ,("sponsor", "spn")
1076+ ,("stage director", "sgd")
1077+ ,("stage manager", "stm")
1078+ ,("standards body", "stn")
1079+ ,("stereotyper", "str")
1080+ ,("storyteller", "stl")
1081+ ,("supporting host", "sht")
1082+ ,("surveyor", "srv")
1083+ ,("teacher", "tch")
1084+ ,("technical director", "tcd")
1085+ ,("television director", "tld")
1086+ ,("television producer", "tlp")
1087+ ,("thesis advisor", "ths")
1088+ ,("transcriber", "trc")
1089+ ,("translator", "trl")
1090+ ,("type designer", "tyd")
1091+ ,("typographer", "tyg")
1092+ ,("university place", "uvp")
1093+ ,("videographer", "vdg")
1094+ ,("witness", "wit")
1095+ ,("wood engraver", "wde")
1096+ ,("woodcutter", "wdc")
1097+ ,("writer of accompanying material", "wam")
1098+ ,("writer of added commentary", "wac")
1099+ ,("writer of added lyrics", "wal")
1100+ ,("writer of added text", "wat")