@@ -1,4 +1,4 @@
1−{-# LANGUAGE PatternGuards, CPP #-}
1+{-# LANGUAGE PatternGuards, CPP, ScopedTypeVariables #-}
22{-
33Copyright (C) 2010 John MacFarlane <jgm@berkeley.edu>
44
@@ -30,16 +30,18 @@ Conversion of 'Pandoc' documents to EPUB.
3030-}
3131module Text.Pandoc.Writers.EPUB ( writeEPUB ) where
3232import Data.IORef
33−import Data.Maybe ( fromMaybe, isNothing )
33+import qualified Data.Map as M
34+import Data.Maybe ( fromMaybe )
3435import Data.List ( isInfixOf, intercalate )
3536import System.Environment ( getEnv )
3637import Text.Printf (printf)
3738import System.FilePath ( (</>), takeBaseName, takeExtension, takeFileName )
3839import qualified Data.ByteString.Lazy as B
3940import qualified Data.ByteString.Lazy.Char8 as B8
40−import Text.Pandoc.UTF8 ( fromStringLazy, toString )
41+import qualified Text.Pandoc.UTF8 as UTF8
4142import Text.Pandoc.SelfContained ( makeSelfContained )
4243import Codec.Archive.Zip
44+import Control.Applicative ((<$>))
4345import Data.Time.Clock.POSIX
4446import Data.Time
4547import System.Locale
@@ -54,7 +56,7 @@ import Text.XML.Light hiding (ppTopElement)
5456import Text.Pandoc.UUID
5557import Text.Pandoc.Writers.HTML
5658import Text.Pandoc.Writers.Markdown ( writePlain )
57−import Data.Char ( toLower )
59+import Data.Char ( toLower, isDigit )
5860import Network.URI ( unEscapeString )
5961import Text.Pandoc.MIME (getMimeType)
6062#if MIN_VERSION_base(4,6,0)
@@ -70,12 +72,237 @@ import Text.Blaze.Html.Renderer.Utf8 (renderHtml)
7072-- in filenames, chapter0003.xhtml.
7173data Chapter = Chapter (Maybe [Int]) [Block]
7274
75+data EPUBMetadata = EPUBMetadata{
76+ epubIdentifier :: [Identifier]
77+ , epubTitle :: [Title]
78+ , epubDate :: String
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
93+ } deriving Show
94+
95+data Stylesheet = StylesheetPath FilePath
96+ | StylesheetContents String
97+ deriving Show
98+
99+data Creator = Creator{
100+ creatorText :: String
101+ , creatorRole :: Maybe String
102+ , creatorFileAs :: Maybe String
103+ } deriving Show
104+
105+data Identifier = Identifier{
106+ identifierText :: String
107+ , identifierScheme :: Maybe String
108+ } deriving Show
109+
110+data Title = Title{
111+ titleText :: String
112+ , titleFileAs :: Maybe String
113+ , titleType :: Maybe String
114+ } deriving Show
115+
116+dcName :: String -> QName
117+dcName n = QName n Nothing (Just "dc")
118+
119+dcNode :: Node t => String -> t -> Element
120+dcNode = node . dcName
121+
122+opfName :: String -> QName
123+opfName n = QName n Nothing (Just "opf")
124+
125+plainify :: [Inline] -> String
126+plainify t =
127+ trimr $ writePlain def{ writerStandalone = False }
128+ $ Pandoc nullMeta [Plain $ walk removeNote t]
129+
130+removeNote :: Inline -> Inline
131+removeNote (Note _) = Str ""
132+removeNote x = x
133+
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)
141+ then do
142+ randomId <- fmap show getRandomUUID
143+ return $ m{ epubIdentifier = [Identifier randomId Nothing] }
144+ else return m
145+ let addLanguage m =
146+ if null (epubLanguage m)
147+ then case lookup "lang" (writerVariables opts) of
148+ Just x -> return m{ epubLanguage = x }
149+ Nothing -> do
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 }
155+ else return m
156+ let fixDate m =
157+ if null (epubDate m)
158+ then do
159+ currentTime <- getCurrentTime
160+ return $ m{ epubDate = showDateTimeISO8601 currentTime }
161+ else return m
162+ let addAuthor m =
163+ if any (\c -> creatorRole c == Just "aut") $ epubCreator m
164+ then return m
165+ else do
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
172+
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"
183+ } : epubTitle md }
184+ | name == "date" = md{ epubDate = fromMaybe "" $ normalizeDate'
185+ $ strContent e }
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 }
207+ | otherwise = md
208+ where getAttr n = lookupAttr (opfName n) attrs
209+addMetadataFromXML _ md = md
210+
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 _ = ""
217+
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]
223+ Nothing -> []
224+
225+getIdentifier :: Meta -> [Identifier]
226+getIdentifier meta = getList "identifier" meta handleMetaValue
227+ where handleMetaValue (MetaMap m) =
228+ Identifier{ identifierText = maybe "" metaValueToString
229+ $ M.lookup "text" m
230+ , identifierScheme = metaValueToString <$>
231+ M.lookup "scheme" m }
232+ handleMetaValue mv = Identifier (metaValueToString mv) Nothing
233+
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
241+
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
249+
250+simpleList :: String -> Meta -> [String]
251+simpleList s meta =
252+ case lookupMeta s meta of
253+ Just (MetaList xs) -> map metaValueToString xs
254+ Just x -> [metaValueToString x]
255+ Nothing -> []
256+
257+metadataFromMeta :: WriterOptions -> Meta -> EPUBMetadata
258+metadataFromMeta opts meta = EPUBMetadata{
259+ epubIdentifier = identifiers
260+ , epubTitle = titles
261+ , epubDate = date
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
276+ }
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)
299+
73300-- | Produce an EPUB file from a Pandoc document.
74301writeEPUB :: WriterOptions -- ^ Writer options
75302 -> Pandoc -- ^ Document to convert
76303 -> IO B.ByteString
77304writeEPUB opts doc@(Pandoc meta _) = do
78− let version = maybe EPUB2 id (writerEpubVersion opts)
305+ let version = fromMaybe EPUB2 (writerEpubVersion opts)
79306 let epub3 = version == EPUB3
80307 epochtime <- floor `fmap` getPOSIXTime
81308 let mkEntry path content = toEntry path epochtime content
@@ -93,11 +320,11 @@ writeEPUB opts doc@(Pandoc meta _) = do
93320 then MathML Nothing
94321 else writerHTMLMathMethod opts
95322 , writerWrapText = False }
96− let mbCoverImage = lookup "epub-cover-image" vars
323+ metadata <- getEPUBMetadata opts' meta
97324
98325 -- cover page
99326 (cpgEntry, cpicEntry) <-
100− case mbCoverImage of
327+ case epubCoverImage metadata of
101328 Nothing -> return ([],[])
102329 Just img -> do
103330 let coverImage = "cover-image" ++ takeExtension img
@@ -179,32 +406,33 @@ writeEPUB opts doc@(Pandoc meta _) = do
179406 chapToEntry num (Chapter mbnum bs) = mkEntry (showChapter num)
180407 $ renderHtml
181408 $ writeHtml opts'{ writerNumberOffset =
182− maybe [] id mbnum }
409+ fromMaybe [] mbnum }
183410 $ case bs of
184411 (Header _ _ xs : _) ->
185− Pandoc (setMeta "title" (fromList xs) nullMeta) bs
412+ -- remove notes or we get doubled footnotes
413+ Pandoc (setMeta "title" (walk removeNote $ fromList xs)
414+ nullMeta) bs
186415 _ ->
187416 Pandoc nullMeta bs
188417
189418 let chapterEntries = zipWith chapToEntry [1..] chapters
190419
191420 -- incredibly inefficient (TODO):
192− let containsMathML ent = "<math" `isInfixOf` (B8.unpack $ fromEntry ent)
421+ let containsMathML ent = epub3 &&
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]
193426
194427 -- 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
199− Just x -> x
200− Nothing -> localeLang
201− uuid <- getRandomUUID
202428 let chapterNode ent = unode "item" !
203429 ([("id", takeBaseName $ eRelativePath ent),
204430 ("href", eRelativePath ent),
205431 ("media-type", "application/xhtml+xml")]
206− ++ [("properties","mathml") | epub3 &&
207− containsMathML ent]) $ ()
432+ ++ case props ent of
433+ [] -> []
434+ xs -> [("properties", unwords xs)])
435+ $ ()
208436 let chapterRefNode ent = unode "itemref" !
209437 [("idref", takeBaseName $ eRelativePath ent)] $ ()
210438 let pictureNode ent = unode "item" !
@@ -215,23 +443,23 @@ writeEPUB opts doc@(Pandoc meta _) = do
215443 let fontNode ent = unode "item" !
216444 [("id", takeBaseName $ eRelativePath ent),
217445 ("href", eRelativePath ent),
218− ("media-type", maybe "" id $ getMimeType $ eRelativePath ent)] $ ()
219− let plainify t = trimr $
220− writePlain opts'{ writerStandalone = False } $
221− Pandoc meta [Plain t]
222− let plainTitle = plainify $ docTitle meta
223− let plainAuthors = map plainify $ docAuthors meta
446+ ("media-type", fromMaybe "" $ getMimeType $ eRelativePath ent)] $ ()
447+ let plainTitle = case docTitle meta of
448+ [] -> case epubTitle metadata of
449+ [] -> "UNTITLED"
450+ (x:_) -> titleText x
451+ x -> plainify 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
224455 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 $
228457 unode "package" ! [("version", case version of
229458 EPUB2 -> "2.0"
230459 EPUB3 -> "3.0")
231460 ,("xmlns","http://www.idpf.org/2007/opf")
232− ,("unique-identifier","BookId")] $
233− [ metadataElement version (writerEpubMetadata opts')
234− uuid lang plainTitle plainAuthors plainDate currentTime mbCoverImage
461+ ,("unique-identifier","epub-id-1")] $
462+ [ metadataElement version metadata currentTime
235463 , unode "manifest" $
236464 [ unode "item" ! [("id","ncx"), ("href","toc.ncx")
237465 ,("media-type","application/x-dtbncx+xml")] $ ()
@@ -243,10 +471,15 @@ writeEPUB opts doc@(Pandoc meta _) = do
243471 [("properties","nav") | epub3 ]) $ ()
244472 ] ++
245473 map chapterNode (cpgEntry ++ (tpEntry : chapterEntries)) ++
246− map pictureNode (cpicEntry ++ picEntries) ++
474+ (case cpicEntry of
475+ [] -> []
476+ (x:_) -> [add_attrs
477+ [Attr (unqual "properties") "cover-image" | epub3]
478+ (pictureNode x)]) ++
479+ map pictureNode picEntries ++
247480 map fontNode fontEntries
248481 , unode "spine" ! [("toc","ncx")] $
249− case mbCoverImage of
482+ case epubCoverImage metadata of
250483 Nothing -> []
251484 Just _ -> [ unode "itemref" !
252485 [("idref", "cover"),("linear","no")] $ () ]
@@ -260,8 +493,13 @@ writeEPUB opts doc@(Pandoc meta _) = do
260493 else "no")] $ ()) :
261494 map chapterRefNode chapterEntries)
262495 , unode "guide" $
263− unode "reference" !
264− [("type","toc"),("title",plainTitle),("href","nav.xhtml")] $ ()
496+ [ unode "reference" !
497+ [("type","toc"),("title",plainTitle),
498+ ("href","nav.xhtml")] $ ()
499+ ] ++
500+ [ unode "reference" !
501+ [("type","cover"),("title","Cover"),("href","cover.xhtml")] $ () | epubCoverImage metadata /= Nothing
502+ ]
265503 ]
266504 let contentsEntry = mkEntry "content.opf" contentsData
267505
@@ -303,19 +541,19 @@ writeEPUB opts doc@(Pandoc meta _) = do
303541 [ unode "navLabel" $ unode "text" (plainify $ docTitle meta)
304542 , unode "content" ! [("src","title_page.xhtml")] $ () ]
305543
306− let tocData = fromStringLazy $ ppTopElement $
544+ let tocData = UTF8.fromStringLazy $ ppTopElement $
307545 unode "ncx" ! [("version","2005-1")
308546 ,("xmlns","http://www.daisy.org/z3986/2005/ncx/")] $
309547 [ unode "head" $
310548 [ unode "meta" ! [("name","dtb:uid")
311− ,("content", show uuid)] $ ()
549+ ,("content", uuid)] $ ()
312550 , unode "meta" ! [("name","dtb:depth")
313551 ,("content", "1")] $ ()
314552 , unode "meta" ! [("name","dtb:totalPageCount")
315553 ,("content", "0")] $ ()
316554 , unode "meta" ! [("name","dtb:maxPageNumber")
317555 ,("content", "0")] $ ()
318− ] ++ case mbCoverImage of
556+ ] ++ case epubCoverImage metadata of
319557 Nothing -> []
320558 Just _ -> [unode "meta" ! [("name","cover"),
321559 ("content","cover-image")] $ ()]
@@ -335,7 +573,7 @@ writeEPUB opts doc@(Pandoc meta _) = do
335573 (_:_) -> [unode "ol" ! [("class","toc")] $ subs]
336574
337575 let navtag = if epub3 then "nav" else "div"
338− let navData = fromStringLazy $ ppTopElement $
576+ let navData = UTF8.fromStringLazy $ ppTopElement $
339577 unode "html" ! [("xmlns","http://www.w3.org/1999/xhtml")
340578 ,("xmlns:epub","http://www.idpf.org/2007/ops")] $
341579 [ unode "head" $
@@ -349,10 +587,10 @@ writeEPUB opts doc@(Pandoc meta _) = do
349587 let navEntry = mkEntry "nav.xhtml" navData
350588
351589 -- mimetype
352− let mimetypeEntry = mkEntry "mimetype" $ fromStringLazy "application/epub+zip"
590+ let mimetypeEntry = mkEntry "mimetype" $ UTF8.fromStringLazy "application/epub+zip"
353591
354592 -- container.xml
355− let containerData = fromStringLazy $ ppTopElement $
593+ let containerData = UTF8.fromStringLazy $ ppTopElement $
356594 unode "container" ! [("version","1.0")
357595 ,("xmlns","urn:oasis:names:tc:opendocument:xmlns:container")] $
358596 unode "rootfiles" $
@@ -361,18 +599,19 @@ writeEPUB opts doc@(Pandoc meta _) = do
361599 let containerEntry = mkEntry "META-INF/container.xml" containerData
362600
363601 -- com.apple.ibooks.display-options.xml
364− let apple = fromStringLazy $ ppTopElement $
602+ let apple = UTF8.fromStringLazy $ ppTopElement $
365603 unode "display_options" $
366604 unode "platform" ! [("name","*")] $
367605 unode "option" ! [("name","specified-fonts")] $ "true"
368606 let appleEntry = mkEntry "META-INF/com.apple.ibooks.display-options.xml" apple
369607
370608 -- stylesheet
371− stylesheet <- case writerEpubStylesheet opts of
372− Just s -> return s
373− Nothing -> toString `fmap`
609+ stylesheet <- case epubStylesheet metadata of
610+ Just (StylesheetPath fp) -> UTF8.readFile fp
611+ Just (StylesheetContents s) -> return s
612+ Nothing -> UTF8.toString `fmap`
374613 readDataFile (writerUserDataDir opts) "epub.css"
375− let stylesheetEntry = mkEntry "stylesheet.css" $ fromStringLazy stylesheet
614+ let stylesheetEntry = mkEntry "stylesheet.css" $ UTF8.fromStringLazy stylesheet
376615
377616 -- construct archive
378617 let archive = foldr addEntryToArchive emptyArchive
@@ -381,33 +620,97 @@ writeEPUB opts doc@(Pandoc meta _) = do
381620 (picEntries ++ cpicEntry ++ cpgEntry ++ chapterEntries ++ fontEntries))
382621 return $ fromArchive archive
383622
384−metadataElement :: EPUBVersion -> String -> UUID -> String -> String -> [String]
385− -> String -> UTCTime -> Maybe a -> Element
386−metadataElement version metadataXML uuid lang title authors date currentTime mbCoverImage =
387− let userNodes = parseXML metadataXML
388− elt = unode "metadata" ! [("xmlns:dc","http://purl.org/dc/elements/1.1/")
389− ,("xmlns:opf","http://www.idpf.org/2007/opf")] $
390− filter isMetadataElement $ onlyElems userNodes
391− dublinElements = ["contributor","coverage","creator","date",
392− "description","format","identifier","language","publisher",
393− "relation","rights","source","subject","title","type"]
394− isMetadataElement e = (qPrefix (elName e) == Just "dc" &&
395− qName (elName e) `elem` dublinElements) ||
396− (qPrefix (elName e) == Nothing &&
397− qName (elName e) `elem` ["link","meta"])
398− contains e n = not (null (findElements (QName n Nothing (Just "dc")) e))
399− newNodes = [ unode "dc:title" title | not (elt `contains` "title") ] ++
400− [ unode "dc:language" lang | not (elt `contains` "language") ] ++
401− [ unode "dc:identifier" ! [("id","BookId")] $ show uuid |
402− not (elt `contains` "identifier") ] ++
403− [ unode "dc:creator" ! [("opf:role","aut") | version == EPUB2]
404− $ a | a <- authors, not (elt `contains` "creator") ] ++
405− [ unode "dc:date" date | not (elt `contains` "date") ] ++
406− [ unode "meta" ! [("property", "dcterms:modified")] $
407− (showDateTimeISO8601 currentTime) | version == EPUB3] ++
408− [ unode "meta" ! [("name","cover"), ("content","cover-image")] $ () |
409− not (isNothing mbCoverImage) ]
410− in elt{ elContent = elContent elt ++ map Elem newNodes }
623+metadataElement :: EPUBVersion -> EPUBMetadata -> UTCTime -> Element
624+metadataElement version md currentTime =
625+ unode "metadata" ! [("xmlns:dc","http://purl.org/dc/elements/1.1/")
626+ ,("xmlns:opf","http://www.idpf.org/2007/opf")] $ mdNodes
627+ where mdNodes = identifierNodes ++ titleNodes ++ dateNodes ++ languageNodes
628+ ++ creatorNodes ++ contributorNodes ++ subjectNodes
629+ ++ descriptionNodes ++ typeNodes ++ formatNodes
630+ ++ publisherNodes ++ sourceNodes ++ relationNodes
631+ ++ coverageNodes ++ rightsNodes ++ coverImageNodes
632+ ++ modifiedNodes
633+ withIds base f = concat . zipWith f (map (\x -> base ++ ('-' : show x))
634+ ([1..] :: [Int]))
635+ identifierNodes = withIds "epub-id" toIdentifierNode $
636+ epubIdentifier md
637+ titleNodes = withIds "epub-title" toTitleNode $ epubTitle md
638+ dateNodes = dcTag' "date" $ epubDate md
639+ languageNodes = [dcTag "language" $ epubLanguage md]
640+ creatorNodes = withIds "epub-creator" (toCreatorNode "creator") $
641+ epubCreator md
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")] $ ()])
656+ $ epubCoverImage md
657+ modifiedNodes = [ unode "meta" ! [("property", "dcterms:modified")] $
658+ (showDateTimeISO8601 currentTime) | version == EPUB3 ]
659+ dcTag n s = unode ("dc:" ++ n) s
660+ dcTag' n s = [dcTag n s]
661+ toIdentifierNode id' (Identifier txt scheme)
662+ | version == EPUB2 = [dcNode "identifier" !
663+ ([("id",id')] ++ maybe [] (\x -> [("opf:scheme", x)]) scheme) $
664+ txt]
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 !
672+ ([("id",id')] ++
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" !
686+ ([("id",id')] ++
687+ maybe [] (\x -> [("opf:file-as",x)]) (titleFileAs title) ++
688+ maybe [] (\x -> [("opf:title-type",x)]) (titleType title)) $
689+ titleText title]
690+ | otherwise = [dcNode "title" ! [("id",id')] $ titleText title]
691+ ++
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])
697+ (titleType title)
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"
411714
412715showDateTimeISO8601 :: UTCTime -> String
413716showDateTimeISO8601 = formatTime defaultTimeLocale "%FT%TZ"
@@ -457,15 +760,9 @@ ppTopElement = ("<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n" ++) . unEntity .
457760 unEntity (x:xs) = x : unEntity xs
458761
459762imageTypeOf :: FilePath -> Maybe String
460−imageTypeOf x = case drop 1 (map toLower (takeExtension x)) of
461− "jpg" -> Just "image/jpeg"
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
468−
763+imageTypeOf x = case getMimeType x of
764+ Just y@('i':'m':'a':'g':'e':_) -> Just y
765+ _ -> Nothing
469766
470767data IdentState = IdentState{
471768 chapterNumber :: Int,
@@ -519,3 +816,287 @@ replaceRefs refTable = walk replaceOneRef
519816 Just url -> Link lab (url,tit)
520817 Nothing -> x
521818 replaceOneRef x = x
819+
820+-- Variant of normalizeDate that allows partial dates: YYYY, YYYY-MM
821+normalizeDate' :: String -> Maybe String
822+normalizeDate' xs =
823+ let xs' = trim xs in
824+ case xs' of
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
827+ -> Just xs'
828+ _ -> normalizeDate xs'
829+
830+toRelator :: String -> Maybe String
831+toRelator x
832+ | x `elem` relators = Just x
833+ | otherwise = lookup (map toLower x) relatorMap
834+
835+relators :: [String]
836+relators = map snd relatorMap
837+
838+relatorMap :: [(String, String)]
839+relatorMap =
840+ [("abridger", "abr")
841+ ,("actor", "act")
842+ ,("adapter", "adp")
843+ ,("addressee", "rcp")
844+ ,("analyst", "anl")
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")
854+ ,("artist", "art")
855+ ,("artistic director", "ard")
856+ ,("assignee", "asg")
857+ ,("associated name", "asn")
858+ ,("attributed name", "att")
859+ ,("auctioneer", "auc")
860+ ,("author", "aut")
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")
867+ ,("binder", "bnd")
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")
879+ ,("caster", "cas")
880+ ,("censor", "cns")
881+ ,("choreographer", "chr")
882+ ,("cinematographer", "cng")
883+ ,("client", "cli")
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")
917+ ,("creator", "cre")
918+ ,("curator", "cur")
919+ ,("dancer", "dnc")
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")
936+ ,("donor", "dnr")
937+ ,("draftsman", "drm")
938+ ,("dubious author", "dub")
939+ ,("editor", "edt")
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")
947+ ,("etcher", "etr")
948+ ,("event place", "evp")
949+ ,("expert", "exp")
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")
958+ ,("forger", "frg")
959+ ,("former owner", "fmo")
960+ ,("funder", "fnd")
961+ ,("geographic information specialist", "gis")
962+ ,("honoree", "hnr")
963+ ,("host", "hst")
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")
973+ ,("judge", "jud")
974+ ,("jurisdiction governed", "jug")
975+ ,("laboratory", "lbr")
976+ ,("laboratory director", "ldr")
977+ ,("landscape architect", "lsa")
978+ ,("lead", "led")
979+ ,("lender", "len")
980+ ,("libelant", "lil")
981+ ,("libelant-appellant", "lit")
982+ ,("libelant-appellee", "lie")
983+ ,("libelee", "lel")
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")
994+ ,("marbler", "mrb")
995+ ,("markup editor", "mrk")
996+ ,("metadata contact", "mdc")
997+ ,("metal-engraver", "mte")
998+ ,("moderator", "mod")
999+ ,("monitor", "mon")
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")
1008+ ,("other", "oth")
1009+ ,("owner", "own")
1010+ ,("panelist", "pan")
1011+ ,("papermaker", "ppm")
1012+ ,("patent applicant", "pta")
1013+ ,("patent holder", "pth")
1014+ ,("patron", "pat")
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")
1064+ ,("scribe", "scr")
1065+ ,("sculptor", "scl")
1066+ ,("second party", "spy")
1067+ ,("secretary", "sec")
1068+ ,("seller", "sll")
1069+ ,("set designer", "std")
1070+ ,("setting", "stg")
1071+ ,("signer", "sgn")
1072+ ,("singer", "sng")
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")
1101+ ]
1102+