{-# LANGUAGE CPP                 #-}
{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE PatternGuards       #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}
{- |
   Module      : Text.Pandoc.Writers.EPUB
   Copyright   : Copyright (C) 2010-2020 John MacFarlane
   License     : GNU GPL, version 2 or above

   Maintainer  : John MacFarlane <jgm@berkeley.edu>
   Stability   : alpha
   Portability : portable

Conversion of 'Pandoc' documents to EPUB.
-}
module Text.Pandoc.Writers.EPUB ( writeEPUB2, writeEPUB3 ) where
import Codec.Archive.Zip (Entry, addEntryToArchive, eRelativePath, emptyArchive,
                          fromArchive, fromEntry, toEntry)
import Control.Applicative ( (<|>) )
import Control.Monad (mplus, unless, when, zipWithM)
import Control.Monad.Except (catchError, throwError)
import Control.Monad.State.Strict (StateT, evalState, evalStateT, get,
                                   gets, lift, modify)
import qualified Data.ByteString.Lazy as B
import qualified Data.ByteString.Lazy.Char8 as B8
import Data.Char (isAlphaNum, isAscii, isDigit, toLower)
import Data.List (isInfixOf, isPrefixOf)
import qualified Data.Map as M
import Data.Maybe (fromMaybe, isNothing, mapMaybe, isJust)
import qualified Data.Set as Set
import qualified Data.Text as TS
import qualified Data.Text.Lazy as TL
import Network.HTTP (urlEncode)
import System.FilePath (takeExtension, takeFileName, makeRelative)
import Text.HTML.TagSoup (Tag (TagOpen), fromAttrib, parseTags)
import Text.Pandoc.Builder (fromList, setMeta)
import Text.Pandoc.Class.PandocMonad (PandocMonad, report)
import qualified Text.Pandoc.Class.PandocPure as P
import qualified Text.Pandoc.Class.PandocMonad as P
import Data.Time
import Text.Pandoc.Definition
import Text.Pandoc.Error
import Text.Pandoc.ImageSize
import Text.Pandoc.Logging
import Text.Pandoc.MIME (MimeType, extensionFromMimeType, getMimeType)
import Text.Pandoc.Options (EPUBVersion (..), HTMLMathMethod (..),
                            ObfuscationMethod (NoObfuscation), WrapOption (..),
                            WriterOptions (..))
import Text.Pandoc.Shared (makeSections, normalizeDate, renderTags',
                           safeRead, stringify, trim, uniqueIdent, tshow)
import qualified Text.Pandoc.UTF8 as UTF8
import Text.Pandoc.UUID (getRandomUUID)
import Text.Pandoc.Walk (query, walk, walkM)
import Text.Pandoc.Writers.HTML (writeHtmlStringForEPUB)
import Text.Printf (printf)
import Text.XML.Light (Attr (..), Element (..), Node (..), QName (..),
                       add_attrs, lookupAttr, node, onlyElems, parseXML,
                       ppElement, showElement, strContent, unode, unqual)
import Text.Pandoc.XML (escapeStringForXML)
import Text.DocTemplates (FromContext(lookupContext), Context(..),
                          ToContext(toVal), Val(..))

-- A Chapter includes a list of blocks.
newtype Chapter = Chapter [Block]
  deriving (Int -> Chapter -> ShowS
[Chapter] -> ShowS
Chapter -> String
(Int -> Chapter -> ShowS)
-> (Chapter -> String) -> ([Chapter] -> ShowS) -> Show Chapter
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Chapter] -> ShowS
$cshowList :: [Chapter] -> ShowS
show :: Chapter -> String
$cshow :: Chapter -> String
showsPrec :: Int -> Chapter -> ShowS
$cshowsPrec :: Int -> Chapter -> ShowS
Show)

data EPUBState = EPUBState {
        EPUBState -> [(String, (String, Maybe Entry))]
stMediaPaths  :: [(FilePath, (FilePath, Maybe Entry))]
      , EPUBState -> Int
stMediaNextId :: Int
      , EPUBState -> String
stEpubSubdir  :: String
      }

type E m = StateT EPUBState m

data EPUBMetadata = EPUBMetadata{
    EPUBMetadata -> [Identifier]
epubIdentifier    :: [Identifier]
  , EPUBMetadata -> [Title]
epubTitle         :: [Title]
  , EPUBMetadata -> [Date]
epubDate          :: [Date]
  , EPUBMetadata -> String
epubLanguage      :: String
  , EPUBMetadata -> [Creator]
epubCreator       :: [Creator]
  , EPUBMetadata -> [Creator]
epubContributor   :: [Creator]
  , EPUBMetadata -> [String]
epubSubject       :: [String]
  , EPUBMetadata -> Maybe String
epubDescription   :: Maybe String
  , EPUBMetadata -> Maybe String
epubType          :: Maybe String
  , EPUBMetadata -> Maybe String
epubFormat        :: Maybe String
  , EPUBMetadata -> Maybe String
epubPublisher     :: Maybe String
  , EPUBMetadata -> Maybe String
epubSource        :: Maybe String
  , EPUBMetadata -> Maybe String
epubRelation      :: Maybe String
  , EPUBMetadata -> Maybe String
epubCoverage      :: Maybe String
  , EPUBMetadata -> Maybe String
epubRights        :: Maybe String
  , EPUBMetadata -> Maybe String
epubCoverImage    :: Maybe String
  , EPUBMetadata -> [String]
epubStylesheets   :: [FilePath]
  , EPUBMetadata -> Maybe ProgressionDirection
epubPageDirection :: Maybe ProgressionDirection
  , EPUBMetadata -> [(String, String)]
epubIbooksFields  :: [(String, String)]
  , EPUBMetadata -> [(String, String)]
epubCalibreFields :: [(String, String)]
  } deriving Int -> EPUBMetadata -> ShowS
[EPUBMetadata] -> ShowS
EPUBMetadata -> String
(Int -> EPUBMetadata -> ShowS)
-> (EPUBMetadata -> String)
-> ([EPUBMetadata] -> ShowS)
-> Show EPUBMetadata
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EPUBMetadata] -> ShowS
$cshowList :: [EPUBMetadata] -> ShowS
show :: EPUBMetadata -> String
$cshow :: EPUBMetadata -> String
showsPrec :: Int -> EPUBMetadata -> ShowS
$cshowsPrec :: Int -> EPUBMetadata -> ShowS
Show

data Date = Date{
    Date -> String
dateText  :: String
  , Date -> Maybe String
dateEvent :: Maybe String
  } deriving Int -> Date -> ShowS
[Date] -> ShowS
Date -> String
(Int -> Date -> ShowS)
-> (Date -> String) -> ([Date] -> ShowS) -> Show Date
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Date] -> ShowS
$cshowList :: [Date] -> ShowS
show :: Date -> String
$cshow :: Date -> String
showsPrec :: Int -> Date -> ShowS
$cshowsPrec :: Int -> Date -> ShowS
Show

data Creator = Creator{
    Creator -> String
creatorText   :: String
  , Creator -> Maybe String
creatorRole   :: Maybe String
  , Creator -> Maybe String
creatorFileAs :: Maybe String
  } deriving Int -> Creator -> ShowS
[Creator] -> ShowS
Creator -> String
(Int -> Creator -> ShowS)
-> (Creator -> String) -> ([Creator] -> ShowS) -> Show Creator
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Creator] -> ShowS
$cshowList :: [Creator] -> ShowS
show :: Creator -> String
$cshow :: Creator -> String
showsPrec :: Int -> Creator -> ShowS
$cshowsPrec :: Int -> Creator -> ShowS
Show

data Identifier = Identifier{
    Identifier -> String
identifierText   :: String
  , Identifier -> Maybe String
identifierScheme :: Maybe String
  } deriving Int -> Identifier -> ShowS
[Identifier] -> ShowS
Identifier -> String
(Int -> Identifier -> ShowS)
-> (Identifier -> String)
-> ([Identifier] -> ShowS)
-> Show Identifier
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Identifier] -> ShowS
$cshowList :: [Identifier] -> ShowS
show :: Identifier -> String
$cshow :: Identifier -> String
showsPrec :: Int -> Identifier -> ShowS
$cshowsPrec :: Int -> Identifier -> ShowS
Show

data Title = Title{
    Title -> String
titleText   :: String
  , Title -> Maybe String
titleFileAs :: Maybe String
  , Title -> Maybe String
titleType   :: Maybe String
  } deriving Int -> Title -> ShowS
[Title] -> ShowS
Title -> String
(Int -> Title -> ShowS)
-> (Title -> String) -> ([Title] -> ShowS) -> Show Title
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Title] -> ShowS
$cshowList :: [Title] -> ShowS
show :: Title -> String
$cshow :: Title -> String
showsPrec :: Int -> Title -> ShowS
$cshowsPrec :: Int -> Title -> ShowS
Show

data ProgressionDirection = LTR | RTL deriving Int -> ProgressionDirection -> ShowS
[ProgressionDirection] -> ShowS
ProgressionDirection -> String
(Int -> ProgressionDirection -> ShowS)
-> (ProgressionDirection -> String)
-> ([ProgressionDirection] -> ShowS)
-> Show ProgressionDirection
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProgressionDirection] -> ShowS
$cshowList :: [ProgressionDirection] -> ShowS
show :: ProgressionDirection -> String
$cshow :: ProgressionDirection -> String
showsPrec :: Int -> ProgressionDirection -> ShowS
$cshowsPrec :: Int -> ProgressionDirection -> ShowS
Show

dcName :: String -> QName
dcName :: String -> QName
dcName String
n = String -> Maybe String -> Maybe String -> QName
QName String
n Maybe String
forall a. Maybe a
Nothing (String -> Maybe String
forall a. a -> Maybe a
Just String
"dc")

dcNode :: Node t => String -> t -> Element
dcNode :: String -> t -> Element
dcNode = QName -> t -> Element
forall t. Node t => QName -> t -> Element
node (QName -> t -> Element)
-> (String -> QName) -> String -> t -> Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> QName
dcName

opfName :: String -> QName
opfName :: String -> QName
opfName String
n = String -> Maybe String -> Maybe String -> QName
QName String
n Maybe String
forall a. Maybe a
Nothing (String -> Maybe String
forall a. a -> Maybe a
Just String
"opf")

toId :: FilePath -> String
toId :: ShowS
toId = (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map (\Char
x -> if Char -> Bool
isAlphaNum Char
x Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_'
                     then Char
x
                     else Char
'_') ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
takeFileName

removeNote :: Inline -> Inline
removeNote :: Inline -> Inline
removeNote (Note [Block]
_) = Text -> Inline
Str Text
""
removeNote Inline
x        = Inline
x

toVal' :: String -> Val TS.Text
toVal' :: String -> Val Text
toVal' = Text -> Val Text
forall a b. ToContext a b => b -> Val a
toVal (Text -> Val Text) -> (String -> Text) -> String -> Val Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
TS.pack

mkEntry :: PandocMonad m => FilePath -> B.ByteString -> E m Entry
mkEntry :: String -> ByteString -> E m Entry
mkEntry String
path ByteString
content = do
  String
epubSubdir <- (EPUBState -> String) -> StateT EPUBState m String
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets EPUBState -> String
stEpubSubdir
  let addEpubSubdir :: Entry -> Entry
      addEpubSubdir :: Entry -> Entry
addEpubSubdir Entry
e = Entry
e{ eRelativePath :: String
eRelativePath =
          (if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
epubSubdir
              then String
""
              else String
epubSubdir String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"/") String -> ShowS
forall a. [a] -> [a] -> [a]
++ Entry -> String
eRelativePath Entry
e }
  Integer
epochtime <- POSIXTime -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
floor (POSIXTime -> Integer)
-> StateT EPUBState m POSIXTime -> StateT EPUBState m Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m POSIXTime -> StateT EPUBState m POSIXTime
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m POSIXTime
forall (m :: * -> *). PandocMonad m => m POSIXTime
P.getPOSIXTime
  Entry -> E m Entry
forall (m :: * -> *) a. Monad m => a -> m a
return (Entry -> E m Entry) -> Entry -> E m Entry
forall a b. (a -> b) -> a -> b
$
       (if String
path String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"mimetype" Bool -> Bool -> Bool
|| String
"META-INF" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
path
           then Entry -> Entry
forall a. a -> a
id
           else Entry -> Entry
addEpubSubdir) (Entry -> Entry) -> Entry -> Entry
forall a b. (a -> b) -> a -> b
$ String -> Integer -> ByteString -> Entry
toEntry String
path Integer
epochtime ByteString
content

getEPUBMetadata :: PandocMonad m => WriterOptions -> Meta -> E m EPUBMetadata
getEPUBMetadata :: WriterOptions -> Meta -> E m EPUBMetadata
getEPUBMetadata WriterOptions
opts Meta
meta = do
  let md :: EPUBMetadata
md = WriterOptions -> Meta -> EPUBMetadata
metadataFromMeta WriterOptions
opts Meta
meta
  let elts :: [Element]
elts = [Element] -> (Text -> [Element]) -> Maybe Text -> [Element]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ([Content] -> [Element]
onlyElems ([Content] -> [Element])
-> (Text -> [Content]) -> Text -> [Element]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Content]
forall s. XmlSource s => s -> [Content]
parseXML) (Maybe Text -> [Element]) -> Maybe Text -> [Element]
forall a b. (a -> b) -> a -> b
$ WriterOptions -> Maybe Text
writerEpubMetadata WriterOptions
opts
  let md' :: EPUBMetadata
md' = (Element -> EPUBMetadata -> EPUBMetadata)
-> EPUBMetadata -> [Element] -> EPUBMetadata
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Element -> EPUBMetadata -> EPUBMetadata
addMetadataFromXML EPUBMetadata
md [Element]
elts
  let addIdentifier :: EPUBMetadata -> m EPUBMetadata
addIdentifier EPUBMetadata
m =
       if [Identifier] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (EPUBMetadata -> [Identifier]
epubIdentifier EPUBMetadata
m)
          then do
            UUID
randomId <- m UUID
forall (m :: * -> *). PandocMonad m => m UUID
getRandomUUID
            EPUBMetadata -> m EPUBMetadata
forall (m :: * -> *) a. Monad m => a -> m a
return (EPUBMetadata -> m EPUBMetadata) -> EPUBMetadata -> m EPUBMetadata
forall a b. (a -> b) -> a -> b
$ EPUBMetadata
m{ epubIdentifier :: [Identifier]
epubIdentifier = [String -> Maybe String -> Identifier
Identifier (UUID -> String
forall a. Show a => a -> String
show UUID
randomId) Maybe String
forall a. Maybe a
Nothing] }
          else EPUBMetadata -> m EPUBMetadata
forall (m :: * -> *) a. Monad m => a -> m a
return EPUBMetadata
m
  let addLanguage :: EPUBMetadata -> t m EPUBMetadata
addLanguage EPUBMetadata
m =
       if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (EPUBMetadata -> String
epubLanguage EPUBMetadata
m)
          then case Text -> Context Text -> Maybe Text
forall a b. FromContext a b => Text -> Context a -> Maybe b
lookupContext Text
"lang" (WriterOptions -> Context Text
writerVariables WriterOptions
opts) of
                     Just Text
x  -> EPUBMetadata -> t m EPUBMetadata
forall (m :: * -> *) a. Monad m => a -> m a
return EPUBMetadata
m{ epubLanguage :: String
epubLanguage = Text -> String
TS.unpack Text
x }
                     Maybe Text
Nothing -> do
                       Maybe Text
mLang <- m (Maybe Text) -> t m (Maybe Text)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Maybe Text) -> t m (Maybe Text))
-> m (Maybe Text) -> t m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> m (Maybe Text)
forall (m :: * -> *). PandocMonad m => Text -> m (Maybe Text)
P.lookupEnv Text
"LANG"
                       let localeLang :: Text
localeLang =
                             case Maybe Text
mLang of
                               Just Text
lang ->
                                 (Char -> Char) -> Text -> Text
TS.map (\Char
c -> if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_' then Char
'-' else Char
c) (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$
                                 (Char -> Bool) -> Text -> Text
TS.takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'.') Text
lang
                               Maybe Text
Nothing -> Text
"en-US"
                       EPUBMetadata -> t m EPUBMetadata
forall (m :: * -> *) a. Monad m => a -> m a
return EPUBMetadata
m{ epubLanguage :: String
epubLanguage = Text -> String
TS.unpack Text
localeLang }
          else EPUBMetadata -> t m EPUBMetadata
forall (m :: * -> *) a. Monad m => a -> m a
return EPUBMetadata
m
  let fixDate :: EPUBMetadata -> t m EPUBMetadata
fixDate EPUBMetadata
m =
       if [Date] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (EPUBMetadata -> [Date]
epubDate EPUBMetadata
m)
          then do
            UTCTime
currentTime <- m UTCTime -> t m UTCTime
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m UTCTime
forall (m :: * -> *). PandocMonad m => m UTCTime
P.getCurrentTime
            EPUBMetadata -> t m EPUBMetadata
forall (m :: * -> *) a. Monad m => a -> m a
return (EPUBMetadata -> t m EPUBMetadata)
-> EPUBMetadata -> t m EPUBMetadata
forall a b. (a -> b) -> a -> b
$ EPUBMetadata
m{ epubDate :: [Date]
epubDate = [ Date :: String -> Maybe String -> Date
Date{
                             dateText :: String
dateText = UTCTime -> String
showDateTimeISO8601 UTCTime
currentTime
                           , dateEvent :: Maybe String
dateEvent = Maybe String
forall a. Maybe a
Nothing } ] }
          else EPUBMetadata -> t m EPUBMetadata
forall (m :: * -> *) a. Monad m => a -> m a
return EPUBMetadata
m
  let addAuthor :: EPUBMetadata -> m EPUBMetadata
addAuthor EPUBMetadata
m =
       if (Creator -> Bool) -> [Creator] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\Creator
c -> Creator -> Maybe String
creatorRole Creator
c Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Maybe String
forall a. a -> Maybe a
Just String
"aut") ([Creator] -> Bool) -> [Creator] -> Bool
forall a b. (a -> b) -> a -> b
$ EPUBMetadata -> [Creator]
epubCreator EPUBMetadata
m
          then EPUBMetadata -> m EPUBMetadata
forall (m :: * -> *) a. Monad m => a -> m a
return EPUBMetadata
m
          else do
            let authors' :: [Text]
authors' = ([Inline] -> Text) -> [[Inline]] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map [Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify ([[Inline]] -> [Text]) -> [[Inline]] -> [Text]
forall a b. (a -> b) -> a -> b
$ Meta -> [[Inline]]
docAuthors Meta
meta
            let toAuthor :: Text -> Creator
toAuthor Text
name = Creator :: String -> Maybe String -> Maybe String -> Creator
Creator{ creatorText :: String
creatorText = Text -> String
TS.unpack Text
name
                                       , creatorRole :: Maybe String
creatorRole = String -> Maybe String
forall a. a -> Maybe a
Just String
"aut"
                                       , creatorFileAs :: Maybe String
creatorFileAs = Maybe String
forall a. Maybe a
Nothing }
            EPUBMetadata -> m EPUBMetadata
forall (m :: * -> *) a. Monad m => a -> m a
return (EPUBMetadata -> m EPUBMetadata) -> EPUBMetadata -> m EPUBMetadata
forall a b. (a -> b) -> a -> b
$ EPUBMetadata
m{ epubCreator :: [Creator]
epubCreator = (Text -> Creator) -> [Text] -> [Creator]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Creator
toAuthor [Text]
authors' [Creator] -> [Creator] -> [Creator]
forall a. [a] -> [a] -> [a]
++ EPUBMetadata -> [Creator]
epubCreator EPUBMetadata
m }
  EPUBMetadata -> E m EPUBMetadata
forall (m :: * -> *).
PandocMonad m =>
EPUBMetadata -> m EPUBMetadata
addIdentifier EPUBMetadata
md' E m EPUBMetadata
-> (EPUBMetadata -> E m EPUBMetadata) -> E m EPUBMetadata
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= EPUBMetadata -> E m EPUBMetadata
forall (t :: (* -> *) -> * -> *) (m :: * -> *).
(MonadTrans t, Monad (t m), PandocMonad m) =>
EPUBMetadata -> t m EPUBMetadata
fixDate E m EPUBMetadata
-> (EPUBMetadata -> E m EPUBMetadata) -> E m EPUBMetadata
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= EPUBMetadata -> E m EPUBMetadata
forall (m :: * -> *). Monad m => EPUBMetadata -> m EPUBMetadata
addAuthor E m EPUBMetadata
-> (EPUBMetadata -> E m EPUBMetadata) -> E m EPUBMetadata
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= EPUBMetadata -> E m EPUBMetadata
forall (t :: (* -> *) -> * -> *) (m :: * -> *).
(MonadTrans t, Monad (t m), PandocMonad m) =>
EPUBMetadata -> t m EPUBMetadata
addLanguage

addMetadataFromXML :: Element -> EPUBMetadata -> EPUBMetadata
addMetadataFromXML :: Element -> EPUBMetadata -> EPUBMetadata
addMetadataFromXML e :: Element
e@(Element (QName String
name Maybe String
_ (Just String
"dc")) [Attr]
attrs [Content]
_ Maybe Integer
_) EPUBMetadata
md
  | String
name String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"identifier" = EPUBMetadata
md{ epubIdentifier :: [Identifier]
epubIdentifier =
             Identifier :: String -> Maybe String -> Identifier
Identifier{ identifierText :: String
identifierText = Element -> String
strContent Element
e
                       , identifierScheme :: Maybe String
identifierScheme = QName -> [Attr] -> Maybe String
lookupAttr (String -> QName
opfName String
"scheme") [Attr]
attrs
                       } Identifier -> [Identifier] -> [Identifier]
forall a. a -> [a] -> [a]
: EPUBMetadata -> [Identifier]
epubIdentifier EPUBMetadata
md }
  | String
name String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"title" = EPUBMetadata
md{ epubTitle :: [Title]
epubTitle =
            Title :: String -> Maybe String -> Maybe String -> Title
Title{ titleText :: String
titleText = Element -> String
strContent Element
e
                 , titleFileAs :: Maybe String
titleFileAs = String -> Maybe String
getAttr String
"file-as"
                 , titleType :: Maybe String
titleType = String -> Maybe String
getAttr String
"type"
                 } Title -> [Title] -> [Title]
forall a. a -> [a] -> [a]
: EPUBMetadata -> [Title]
epubTitle EPUBMetadata
md }
  | String
name String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"date" = EPUBMetadata
md{ epubDate :: [Date]
epubDate =
             Date :: String -> Maybe String -> Date
Date{ dateText :: String
dateText = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"" (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ String -> Maybe String
normalizeDate' (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ Element -> String
strContent Element
e
                 , dateEvent :: Maybe String
dateEvent = String -> Maybe String
getAttr String
"event"
                 } Date -> [Date] -> [Date]
forall a. a -> [a] -> [a]
: EPUBMetadata -> [Date]
epubDate EPUBMetadata
md }
  | String
name String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"language" = EPUBMetadata
md{ epubLanguage :: String
epubLanguage = Element -> String
strContent Element
e }
  | String
name String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"creator" = EPUBMetadata
md{ epubCreator :: [Creator]
epubCreator =
              Creator :: String -> Maybe String -> Maybe String -> Creator
Creator{ creatorText :: String
creatorText = Element -> String
strContent Element
e
                     , creatorRole :: Maybe String
creatorRole = String -> Maybe String
getAttr String
"role"
                     , creatorFileAs :: Maybe String
creatorFileAs = String -> Maybe String
getAttr String
"file-as"
                     } Creator -> [Creator] -> [Creator]
forall a. a -> [a] -> [a]
: EPUBMetadata -> [Creator]
epubCreator EPUBMetadata
md }
  | String
name String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"contributor" = EPUBMetadata
md{ epubContributor :: [Creator]
epubContributor =
              Creator :: String -> Maybe String -> Maybe String -> Creator
Creator  { creatorText :: String
creatorText = Element -> String
strContent Element
e
                       , creatorRole :: Maybe String
creatorRole = String -> Maybe String
getAttr String
"role"
                       , creatorFileAs :: Maybe String
creatorFileAs = String -> Maybe String
getAttr String
"file-as"
                       } Creator -> [Creator] -> [Creator]
forall a. a -> [a] -> [a]
: EPUBMetadata -> [Creator]
epubContributor EPUBMetadata
md }
  | String
name String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"subject" = EPUBMetadata
md{ epubSubject :: [String]
epubSubject = Element -> String
strContent Element
e String -> [String] -> [String]
forall a. a -> [a] -> [a]
: EPUBMetadata -> [String]
epubSubject EPUBMetadata
md }
  | String
name String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"description" = EPUBMetadata
md { epubDescription :: Maybe String
epubDescription = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ Element -> String
strContent Element
e }
  | String
name String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"type" = EPUBMetadata
md { epubType :: Maybe String
epubType = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ Element -> String
strContent Element
e }
  | String
name String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"format" = EPUBMetadata
md { epubFormat :: Maybe String
epubFormat = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ Element -> String
strContent Element
e }
  | String
name String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"type" = EPUBMetadata
md { epubType :: Maybe String
epubType = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ Element -> String
strContent Element
e }
  | String
name String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"publisher" = EPUBMetadata
md { epubPublisher :: Maybe String
epubPublisher = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ Element -> String
strContent Element
e }
  | String
name String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"source" = EPUBMetadata
md { epubSource :: Maybe String
epubSource = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ Element -> String
strContent Element
e }
  | String
name String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"relation" = EPUBMetadata
md { epubRelation :: Maybe String
epubRelation = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ Element -> String
strContent Element
e }
  | String
name String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"coverage" = EPUBMetadata
md { epubCoverage :: Maybe String
epubCoverage = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ Element -> String
strContent Element
e }
  | String
name String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"rights" = EPUBMetadata
md { epubRights :: Maybe String
epubRights = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ Element -> String
strContent Element
e }
  | Bool
otherwise = EPUBMetadata
md
  where getAttr :: String -> Maybe String
getAttr String
n = QName -> [Attr] -> Maybe String
lookupAttr (String -> QName
opfName String
n) [Attr]
attrs
addMetadataFromXML e :: Element
e@(Element (QName String
"meta" Maybe String
_ Maybe String
_) [Attr]
attrs [Content]
_ Maybe Integer
_) EPUBMetadata
md =
  case String -> Maybe String
getAttr String
"property" of
       Just String
s | String
"ibooks:" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
s ->
                EPUBMetadata
md{ epubIbooksFields :: [(String, String)]
epubIbooksFields = (Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
7 String
s, Element -> String
strContent Element
e) (String, String) -> [(String, String)] -> [(String, String)]
forall a. a -> [a] -> [a]
:
                       EPUBMetadata -> [(String, String)]
epubIbooksFields EPUBMetadata
md }
       Maybe String
_ -> case String -> Maybe String
getAttr String
"name" of
                 Just String
s | String
"calibre:" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
s ->
                   EPUBMetadata
md{ epubCalibreFields :: [(String, String)]
epubCalibreFields =
                         (Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
8 String
s, String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"" (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ String -> Maybe String
getAttr String
"content") (String, String) -> [(String, String)] -> [(String, String)]
forall a. a -> [a] -> [a]
:
                          EPUBMetadata -> [(String, String)]
epubCalibreFields EPUBMetadata
md }
                 Maybe String
_ -> EPUBMetadata
md
  where getAttr :: String -> Maybe String
getAttr String
n = QName -> [Attr] -> Maybe String
lookupAttr (String -> QName
unqual String
n) [Attr]
attrs
addMetadataFromXML Element
_ EPUBMetadata
md = EPUBMetadata
md

metaValueToString :: MetaValue -> String
metaValueToString :: MetaValue -> String
metaValueToString (MetaString Text
s)    = Text -> String
TS.unpack Text
s
metaValueToString (MetaInlines [Inline]
ils) = Text -> String
TS.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ [Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify [Inline]
ils
metaValueToString (MetaBlocks [Block]
bs)   = Text -> String
TS.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ [Block] -> Text
forall a. Walkable Inline a => a -> Text
stringify [Block]
bs
metaValueToString (MetaBool Bool
True)   = String
"true"
metaValueToString (MetaBool Bool
False)  = String
"false"
metaValueToString MetaValue
_                 = String
""

metaValueToPaths :: MetaValue -> [FilePath]
metaValueToPaths :: MetaValue -> [String]
metaValueToPaths (MetaList [MetaValue]
xs) = (MetaValue -> String) -> [MetaValue] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map MetaValue -> String
metaValueToString [MetaValue]
xs
metaValueToPaths MetaValue
x             = [MetaValue -> String
metaValueToString MetaValue
x]

getList :: TS.Text -> Meta -> (MetaValue -> a) -> [a]
getList :: Text -> Meta -> (MetaValue -> a) -> [a]
getList Text
s Meta
meta MetaValue -> a
handleMetaValue =
  case Text -> Meta -> Maybe MetaValue
lookupMeta Text
s Meta
meta of
       Just (MetaList [MetaValue]
xs) -> (MetaValue -> a) -> [MetaValue] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map MetaValue -> a
handleMetaValue [MetaValue]
xs
       Just MetaValue
mv            -> [MetaValue -> a
handleMetaValue MetaValue
mv]
       Maybe MetaValue
Nothing            -> []

getIdentifier :: Meta -> [Identifier]
getIdentifier :: Meta -> [Identifier]
getIdentifier Meta
meta = Text -> Meta -> (MetaValue -> Identifier) -> [Identifier]
forall a. Text -> Meta -> (MetaValue -> a) -> [a]
getList Text
"identifier" Meta
meta MetaValue -> Identifier
handleMetaValue
  where handleMetaValue :: MetaValue -> Identifier
handleMetaValue (MetaMap Map Text MetaValue
m) =
           Identifier :: String -> Maybe String -> Identifier
Identifier{ identifierText :: String
identifierText = String -> (MetaValue -> String) -> Maybe MetaValue -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" MetaValue -> String
metaValueToString
                                        (Maybe MetaValue -> String) -> Maybe MetaValue -> String
forall a b. (a -> b) -> a -> b
$ Text -> Map Text MetaValue -> Maybe MetaValue
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
"text" Map Text MetaValue
m
                     , identifierScheme :: Maybe String
identifierScheme = MetaValue -> String
metaValueToString (MetaValue -> String) -> Maybe MetaValue -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                                          Text -> Map Text MetaValue -> Maybe MetaValue
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
"scheme" Map Text MetaValue
m }
        handleMetaValue MetaValue
mv = String -> Maybe String -> Identifier
Identifier (MetaValue -> String
metaValueToString MetaValue
mv) Maybe String
forall a. Maybe a
Nothing

getTitle :: Meta -> [Title]
getTitle :: Meta -> [Title]
getTitle Meta
meta = Text -> Meta -> (MetaValue -> Title) -> [Title]
forall a. Text -> Meta -> (MetaValue -> a) -> [a]
getList Text
"title" Meta
meta MetaValue -> Title
handleMetaValue
  where handleMetaValue :: MetaValue -> Title
handleMetaValue (MetaMap Map Text MetaValue
m) =
           Title :: String -> Maybe String -> Maybe String -> Title
Title{ titleText :: String
titleText = String -> (MetaValue -> String) -> Maybe MetaValue -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" MetaValue -> String
metaValueToString (Maybe MetaValue -> String) -> Maybe MetaValue -> String
forall a b. (a -> b) -> a -> b
$ Text -> Map Text MetaValue -> Maybe MetaValue
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
"text" Map Text MetaValue
m
                , titleFileAs :: Maybe String
titleFileAs = MetaValue -> String
metaValueToString (MetaValue -> String) -> Maybe MetaValue -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Map Text MetaValue -> Maybe MetaValue
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
"file-as" Map Text MetaValue
m
                , titleType :: Maybe String
titleType = MetaValue -> String
metaValueToString (MetaValue -> String) -> Maybe MetaValue -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Map Text MetaValue -> Maybe MetaValue
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
"type" Map Text MetaValue
m }
        handleMetaValue MetaValue
mv = String -> Maybe String -> Maybe String -> Title
Title (MetaValue -> String
metaValueToString MetaValue
mv) Maybe String
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing

getCreator :: TS.Text -> Meta -> [Creator]
getCreator :: Text -> Meta -> [Creator]
getCreator Text
s Meta
meta = Text -> Meta -> (MetaValue -> Creator) -> [Creator]
forall a. Text -> Meta -> (MetaValue -> a) -> [a]
getList Text
s Meta
meta MetaValue -> Creator
handleMetaValue
  where handleMetaValue :: MetaValue -> Creator
handleMetaValue (MetaMap Map Text MetaValue
m) =
           Creator :: String -> Maybe String -> Maybe String -> Creator
Creator{ creatorText :: String
creatorText = String -> (MetaValue -> String) -> Maybe MetaValue -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" MetaValue -> String
metaValueToString (Maybe MetaValue -> String) -> Maybe MetaValue -> String
forall a b. (a -> b) -> a -> b
$ Text -> Map Text MetaValue -> Maybe MetaValue
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
"text" Map Text MetaValue
m
                  , creatorFileAs :: Maybe String
creatorFileAs = MetaValue -> String
metaValueToString (MetaValue -> String) -> Maybe MetaValue -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Map Text MetaValue -> Maybe MetaValue
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
"file-as" Map Text MetaValue
m
                  , creatorRole :: Maybe String
creatorRole = MetaValue -> String
metaValueToString (MetaValue -> String) -> Maybe MetaValue -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Map Text MetaValue -> Maybe MetaValue
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
"role" Map Text MetaValue
m }
        handleMetaValue MetaValue
mv = String -> Maybe String -> Maybe String -> Creator
Creator (MetaValue -> String
metaValueToString MetaValue
mv) Maybe String
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing

getDate :: TS.Text -> Meta -> [Date]
getDate :: Text -> Meta -> [Date]
getDate Text
s Meta
meta = Text -> Meta -> (MetaValue -> Date) -> [Date]
forall a. Text -> Meta -> (MetaValue -> a) -> [a]
getList Text
s Meta
meta MetaValue -> Date
handleMetaValue
  where handleMetaValue :: MetaValue -> Date
handleMetaValue (MetaMap Map Text MetaValue
m) =
           Date :: String -> Maybe String -> Date
Date{ dateText :: String
dateText = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"" (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$
                   Text -> Map Text MetaValue -> Maybe MetaValue
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
"text" Map Text MetaValue
m Maybe MetaValue -> (MetaValue -> Maybe String) -> Maybe String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Maybe String
normalizeDate' (String -> Maybe String)
-> (MetaValue -> String) -> MetaValue -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MetaValue -> String
metaValueToString
               , dateEvent :: Maybe String
dateEvent = MetaValue -> String
metaValueToString (MetaValue -> String) -> Maybe MetaValue -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Map Text MetaValue -> Maybe MetaValue
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
"event" Map Text MetaValue
m }
        handleMetaValue MetaValue
mv = Date :: String -> Maybe String -> Date
Date { dateText :: String
dateText = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"" (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ String -> Maybe String
normalizeDate' (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ MetaValue -> String
metaValueToString MetaValue
mv
                                  , dateEvent :: Maybe String
dateEvent = Maybe String
forall a. Maybe a
Nothing }

simpleList :: TS.Text -> Meta -> [String]
simpleList :: Text -> Meta -> [String]
simpleList Text
s Meta
meta =
  case Text -> Meta -> Maybe MetaValue
lookupMeta Text
s Meta
meta of
       Just (MetaList [MetaValue]
xs) -> (MetaValue -> String) -> [MetaValue] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map MetaValue -> String
metaValueToString [MetaValue]
xs
       Just MetaValue
x             -> [MetaValue -> String
metaValueToString MetaValue
x]
       Maybe MetaValue
Nothing            -> []

metadataFromMeta :: WriterOptions -> Meta -> EPUBMetadata
metadataFromMeta :: WriterOptions -> Meta -> EPUBMetadata
metadataFromMeta WriterOptions
opts Meta
meta = EPUBMetadata :: [Identifier]
-> [Title]
-> [Date]
-> String
-> [Creator]
-> [Creator]
-> [String]
-> Maybe String
-> Maybe String
-> Maybe String
-> Maybe String
-> Maybe String
-> Maybe String
-> Maybe String
-> Maybe String
-> Maybe String
-> [String]
-> Maybe ProgressionDirection
-> [(String, String)]
-> [(String, String)]
-> EPUBMetadata
EPUBMetadata{
      epubIdentifier :: [Identifier]
epubIdentifier         = [Identifier]
identifiers
    , epubTitle :: [Title]
epubTitle              = [Title]
titles
    , epubDate :: [Date]
epubDate               = [Date]
date
    , epubLanguage :: String
epubLanguage           = String
language
    , epubCreator :: [Creator]
epubCreator            = [Creator]
creators
    , epubContributor :: [Creator]
epubContributor        = [Creator]
contributors
    , epubSubject :: [String]
epubSubject            = [String]
subjects
    , epubDescription :: Maybe String
epubDescription        = Maybe String
description
    , epubType :: Maybe String
epubType               = Maybe String
epubtype
    , epubFormat :: Maybe String
epubFormat             = Maybe String
format
    , epubPublisher :: Maybe String
epubPublisher          = Maybe String
publisher
    , epubSource :: Maybe String
epubSource             = Maybe String
source
    , epubRelation :: Maybe String
epubRelation           = Maybe String
relation
    , epubCoverage :: Maybe String
epubCoverage           = Maybe String
coverage
    , epubRights :: Maybe String
epubRights             = Maybe String
rights
    , epubCoverImage :: Maybe String
epubCoverImage         = Maybe String
coverImage
    , epubStylesheets :: [String]
epubStylesheets        = [String]
stylesheets
    , epubPageDirection :: Maybe ProgressionDirection
epubPageDirection      = Maybe ProgressionDirection
pageDirection
    , epubIbooksFields :: [(String, String)]
epubIbooksFields       = [(String, String)]
ibooksFields
    , epubCalibreFields :: [(String, String)]
epubCalibreFields      = [(String, String)]
calibreFields
    }
  where identifiers :: [Identifier]
identifiers = Meta -> [Identifier]
getIdentifier Meta
meta
        titles :: [Title]
titles = Meta -> [Title]
getTitle Meta
meta
        date :: [Date]
date = Text -> Meta -> [Date]
getDate Text
"date" Meta
meta
        language :: String
language = String -> (MetaValue -> String) -> Maybe MetaValue -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" MetaValue -> String
metaValueToString (Maybe MetaValue -> String) -> Maybe MetaValue -> String
forall a b. (a -> b) -> a -> b
$
           Text -> Meta -> Maybe MetaValue
lookupMeta Text
"language" Meta
meta Maybe MetaValue -> Maybe MetaValue -> Maybe MetaValue
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Text -> Meta -> Maybe MetaValue
lookupMeta Text
"lang" Meta
meta
        creators :: [Creator]
creators = Text -> Meta -> [Creator]
getCreator Text
"creator" Meta
meta
        contributors :: [Creator]
contributors = Text -> Meta -> [Creator]
getCreator Text
"contributor" Meta
meta
        subjects :: [String]
subjects = Text -> Meta -> [String]
simpleList Text
"subject" Meta
meta
        description :: Maybe String
description = MetaValue -> String
metaValueToString (MetaValue -> String) -> Maybe MetaValue -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Meta -> Maybe MetaValue
lookupMeta Text
"description" Meta
meta
        epubtype :: Maybe String
epubtype = MetaValue -> String
metaValueToString (MetaValue -> String) -> Maybe MetaValue -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Meta -> Maybe MetaValue
lookupMeta Text
"type" Meta
meta
        format :: Maybe String
format = MetaValue -> String
metaValueToString (MetaValue -> String) -> Maybe MetaValue -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Meta -> Maybe MetaValue
lookupMeta Text
"format" Meta
meta
        publisher :: Maybe String
publisher = MetaValue -> String
metaValueToString (MetaValue -> String) -> Maybe MetaValue -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Meta -> Maybe MetaValue
lookupMeta Text
"publisher" Meta
meta
        source :: Maybe String
source = MetaValue -> String
metaValueToString (MetaValue -> String) -> Maybe MetaValue -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Meta -> Maybe MetaValue
lookupMeta Text
"source" Meta
meta
        relation :: Maybe String
relation = MetaValue -> String
metaValueToString (MetaValue -> String) -> Maybe MetaValue -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Meta -> Maybe MetaValue
lookupMeta Text
"relation" Meta
meta
        coverage :: Maybe String
coverage = MetaValue -> String
metaValueToString (MetaValue -> String) -> Maybe MetaValue -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Meta -> Maybe MetaValue
lookupMeta Text
"coverage" Meta
meta
        rights :: Maybe String
rights = MetaValue -> String
metaValueToString (MetaValue -> String) -> Maybe MetaValue -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Meta -> Maybe MetaValue
lookupMeta Text
"rights" Meta
meta
        coverImage :: Maybe String
coverImage =
            (Text -> String
TS.unpack (Text -> String) -> Maybe Text -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Context Text -> Maybe Text
forall a b. FromContext a b => Text -> Context a -> Maybe b
lookupContext Text
"epub-cover-image"
                              (WriterOptions -> Context Text
writerVariables WriterOptions
opts))
            Maybe String -> Maybe String -> Maybe String
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` (MetaValue -> String
metaValueToString (MetaValue -> String) -> Maybe MetaValue -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Meta -> Maybe MetaValue
lookupMeta Text
"cover-image" Meta
meta)
        mCss :: Maybe MetaValue
mCss = Text -> Meta -> Maybe MetaValue
lookupMeta Text
"css" Meta
meta Maybe MetaValue -> Maybe MetaValue -> Maybe MetaValue
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Meta -> Maybe MetaValue
lookupMeta Text
"stylesheet" Meta
meta
        stylesheets :: [String]
stylesheets = [String] -> (MetaValue -> [String]) -> Maybe MetaValue -> [String]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] MetaValue -> [String]
metaValueToPaths Maybe MetaValue
mCss [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
                      case Text -> Context Text -> Maybe [Text]
forall a b. FromContext a b => Text -> Context a -> Maybe b
lookupContext Text
"css" (WriterOptions -> Context Text
writerVariables WriterOptions
opts) of
                         Just [Text]
xs -> (Text -> String) -> [Text] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Text -> String
TS.unpack [Text]
xs
                         Maybe [Text]
Nothing ->
                           case Text -> Context Text -> Maybe Text
forall a b. FromContext a b => Text -> Context a -> Maybe b
lookupContext Text
"css" (WriterOptions -> Context Text
writerVariables WriterOptions
opts) of
                             Just Text
x  -> [Text -> String
TS.unpack Text
x]
                             Maybe Text
Nothing -> []
        pageDirection :: Maybe ProgressionDirection
pageDirection = case (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower ShowS -> (MetaValue -> String) -> MetaValue -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MetaValue -> String
metaValueToString (MetaValue -> String) -> Maybe MetaValue -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                             Text -> Meta -> Maybe MetaValue
lookupMeta Text
"page-progression-direction" Meta
meta of
                              Just String
"ltr" -> ProgressionDirection -> Maybe ProgressionDirection
forall a. a -> Maybe a
Just ProgressionDirection
LTR
                              Just String
"rtl" -> ProgressionDirection -> Maybe ProgressionDirection
forall a. a -> Maybe a
Just ProgressionDirection
RTL
                              Maybe String
_          -> Maybe ProgressionDirection
forall a. Maybe a
Nothing
        ibooksFields :: [(String, String)]
ibooksFields = case Text -> Meta -> Maybe MetaValue
lookupMeta Text
"ibooks" Meta
meta of
                            Just (MetaMap Map Text MetaValue
mp)
                               -> Map String String -> [(String, String)]
forall k a. Map k a -> [(k, a)]
M.toList (Map String String -> [(String, String)])
-> Map String String -> [(String, String)]
forall a b. (a -> b) -> a -> b
$ (Text -> String) -> Map Text String -> Map String String
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
M.mapKeys Text -> String
TS.unpack (Map Text String -> Map String String)
-> Map Text String -> Map String String
forall a b. (a -> b) -> a -> b
$ (MetaValue -> String) -> Map Text MetaValue -> Map Text String
forall a b k. (a -> b) -> Map k a -> Map k b
M.map MetaValue -> String
metaValueToString Map Text MetaValue
mp
                            Maybe MetaValue
_  -> []
        calibreFields :: [(String, String)]
calibreFields = case Text -> Meta -> Maybe MetaValue
lookupMeta Text
"calibre" Meta
meta of
                            Just (MetaMap Map Text MetaValue
mp)
                               -> Map String String -> [(String, String)]
forall k a. Map k a -> [(k, a)]
M.toList (Map String String -> [(String, String)])
-> Map String String -> [(String, String)]
forall a b. (a -> b) -> a -> b
$ (Text -> String) -> Map Text String -> Map String String
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
M.mapKeys Text -> String
TS.unpack (Map Text String -> Map String String)
-> Map Text String -> Map String String
forall a b. (a -> b) -> a -> b
$ (MetaValue -> String) -> Map Text MetaValue -> Map Text String
forall a b k. (a -> b) -> Map k a -> Map k b
M.map MetaValue -> String
metaValueToString Map Text MetaValue
mp
                            Maybe MetaValue
_  -> []

-- | Produce an EPUB2 file from a Pandoc document.
writeEPUB2 :: PandocMonad m
          => WriterOptions  -- ^ Writer options
          -> Pandoc         -- ^ Document to convert
          -> m B.ByteString
writeEPUB2 :: WriterOptions -> Pandoc -> m ByteString
writeEPUB2 = EPUBVersion -> WriterOptions -> Pandoc -> m ByteString
forall (m :: * -> *).
PandocMonad m =>
EPUBVersion -> WriterOptions -> Pandoc -> m ByteString
writeEPUB EPUBVersion
EPUB2

-- | Produce an EPUB3 file from a Pandoc document.
writeEPUB3 :: PandocMonad m
          => WriterOptions  -- ^ Writer options
          -> Pandoc         -- ^ Document to convert
          -> m B.ByteString
writeEPUB3 :: WriterOptions -> Pandoc -> m ByteString
writeEPUB3 = EPUBVersion -> WriterOptions -> Pandoc -> m ByteString
forall (m :: * -> *).
PandocMonad m =>
EPUBVersion -> WriterOptions -> Pandoc -> m ByteString
writeEPUB EPUBVersion
EPUB3

-- | Produce an EPUB file from a Pandoc document.
writeEPUB :: PandocMonad m
          => EPUBVersion
          -> WriterOptions  -- ^ Writer options
          -> Pandoc         -- ^ Document to convert
          -> m B.ByteString
writeEPUB :: EPUBVersion -> WriterOptions -> Pandoc -> m ByteString
writeEPUB EPUBVersion
epubVersion WriterOptions
opts Pandoc
doc = do
  let epubSubdir :: Text
epubSubdir = WriterOptions -> Text
writerEpubSubdirectory WriterOptions
opts
  -- sanity check on epubSubdir
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ((Char -> Bool) -> Text -> Bool
TS.all (\Char
c -> Char -> Bool
isAscii Char
c Bool -> Bool -> Bool
&& Char -> Bool
isAlphaNum Char
c) Text
epubSubdir) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
    PandocError -> m ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError -> m ()) -> PandocError -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> PandocError
PandocEpubSubdirectoryError Text
epubSubdir
  let initState :: EPUBState
initState = EPUBState :: [(String, (String, Maybe Entry))] -> Int -> String -> EPUBState
EPUBState { stMediaPaths :: [(String, (String, Maybe Entry))]
stMediaPaths = [], stMediaNextId :: Int
stMediaNextId = Int
0, stEpubSubdir :: String
stEpubSubdir = Text -> String
TS.unpack Text
epubSubdir }
  StateT EPUBState m ByteString -> EPUBState -> m ByteString
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (EPUBVersion
-> WriterOptions -> Pandoc -> StateT EPUBState m ByteString
forall (m :: * -> *).
PandocMonad m =>
EPUBVersion -> WriterOptions -> Pandoc -> E m ByteString
pandocToEPUB EPUBVersion
epubVersion WriterOptions
opts Pandoc
doc) EPUBState
initState

pandocToEPUB :: PandocMonad m
             => EPUBVersion
             -> WriterOptions
             -> Pandoc
             -> E m B.ByteString
pandocToEPUB :: EPUBVersion -> WriterOptions -> Pandoc -> E m ByteString
pandocToEPUB EPUBVersion
version WriterOptions
opts Pandoc
doc = do
  -- handle pictures
  Pandoc Meta
meta [Block]
blocks <- (Inline -> StateT EPUBState m Inline)
-> Pandoc -> StateT EPUBState m Pandoc
forall a b (m :: * -> *).
(Walkable a b, Monad m, Applicative m, Functor m) =>
(a -> m a) -> b -> m b
walkM (WriterOptions -> Inline -> StateT EPUBState m Inline
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> E m Inline
transformInline WriterOptions
opts) Pandoc
doc StateT EPUBState m Pandoc
-> (Pandoc -> StateT EPUBState m Pandoc)
-> StateT EPUBState m Pandoc
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                        (Block -> StateT EPUBState m Block)
-> Pandoc -> StateT EPUBState m Pandoc
forall a b (m :: * -> *).
(Walkable a b, Monad m, Applicative m, Functor m) =>
(a -> m a) -> b -> m b
walkM Block -> StateT EPUBState m Block
forall (m :: * -> *). PandocMonad m => Block -> E m Block
transformBlock
  [Entry]
picEntries <- ((String, (String, Maybe Entry)) -> Maybe Entry)
-> [(String, (String, Maybe Entry))] -> [Entry]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ((String, Maybe Entry) -> Maybe Entry
forall a b. (a, b) -> b
snd ((String, Maybe Entry) -> Maybe Entry)
-> ((String, (String, Maybe Entry)) -> (String, Maybe Entry))
-> (String, (String, Maybe Entry))
-> Maybe Entry
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, (String, Maybe Entry)) -> (String, Maybe Entry)
forall a b. (a, b) -> b
snd) ([(String, (String, Maybe Entry))] -> [Entry])
-> StateT EPUBState m [(String, (String, Maybe Entry))]
-> StateT EPUBState m [Entry]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (EPUBState -> [(String, (String, Maybe Entry))])
-> StateT EPUBState m [(String, (String, Maybe Entry))]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets EPUBState -> [(String, (String, Maybe Entry))]
stMediaPaths

  String
epubSubdir <- (EPUBState -> String) -> StateT EPUBState m String
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets EPUBState -> String
stEpubSubdir
  let epub3 :: Bool
epub3 = EPUBVersion
version EPUBVersion -> EPUBVersion -> Bool
forall a. Eq a => a -> a -> Bool
== EPUBVersion
EPUB3
  let writeHtml :: WriterOptions -> Pandoc -> f ByteString
writeHtml WriterOptions
o = (Text -> ByteString) -> f Text -> f ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> ByteString
UTF8.fromTextLazy (Text -> ByteString) -> (Text -> Text) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
TL.fromStrict) (f Text -> f ByteString)
-> (Pandoc -> f Text) -> Pandoc -> f ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                      EPUBVersion -> WriterOptions -> Pandoc -> f Text
forall (m :: * -> *).
PandocMonad m =>
EPUBVersion -> WriterOptions -> Pandoc -> m Text
writeHtmlStringForEPUB EPUBVersion
version WriterOptions
o
  EPUBMetadata
metadata <- WriterOptions -> Meta -> E m EPUBMetadata
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Meta -> E m EPUBMetadata
getEPUBMetadata WriterOptions
opts Meta
meta

  let plainTitle :: String
plainTitle = case Meta -> [Inline]
docTitle' Meta
meta of
                        [] -> case EPUBMetadata -> [Title]
epubTitle EPUBMetadata
metadata of
                                   []    -> String
"UNTITLED"
                                   (Title
x:[Title]
_) -> Title -> String
titleText Title
x
                        [Inline]
x  -> Text -> String
TS.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ [Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify [Inline]
x

  -- stylesheet
  [ByteString]
stylesheets <- case EPUBMetadata -> [String]
epubStylesheets EPUBMetadata
metadata of
                      [] -> (\ByteString
x -> [[ByteString] -> ByteString
B.fromChunks [ByteString
x]]) (ByteString -> [ByteString])
-> StateT EPUBState m ByteString -> StateT EPUBState m [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                             String -> StateT EPUBState m ByteString
forall (m :: * -> *). PandocMonad m => String -> m ByteString
P.readDataFile String
"epub.css"
                      [String]
fs -> (String -> E m ByteString)
-> [String] -> StateT EPUBState m [ByteString]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> E m ByteString
forall (m :: * -> *). PandocMonad m => String -> m ByteString
P.readFileLazy [String]
fs
  [Entry]
stylesheetEntries <- (ByteString -> Int -> StateT EPUBState m Entry)
-> [ByteString] -> [Int] -> StateT EPUBState m [Entry]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM
        (\ByteString
bs Int
n -> String -> ByteString -> StateT EPUBState m Entry
forall (m :: * -> *).
PandocMonad m =>
String -> ByteString -> E m Entry
mkEntry (String
"styles/stylesheet" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
".css") ByteString
bs)
        [ByteString]
stylesheets [(Int
1 :: Int)..]

  let vars :: Context Text
vars = Map Text (Val Text) -> Context Text
forall a. Map Text (Val a) -> Context a
Context (Map Text (Val Text) -> Context Text)
-> Map Text (Val Text) -> Context Text
forall a b. (a -> b) -> a -> b
$
               Text -> Map Text (Val Text) -> Map Text (Val Text)
forall k a. Ord k => k -> Map k a -> Map k a
M.delete Text
"css" (Map Text (Val Text) -> Map Text (Val Text))
-> (Map Text (Val Text) -> Map Text (Val Text))
-> Map Text (Val Text)
-> Map Text (Val Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
               Text -> Val Text -> Map Text (Val Text) -> Map Text (Val Text)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Text
"epub3"
                 (String -> Val Text
toVal' (String -> Val Text) -> String -> Val Text
forall a b. (a -> b) -> a -> b
$ if Bool
epub3 then String
"true" else String
"false") (Map Text (Val Text) -> Map Text (Val Text))
-> (Map Text (Val Text) -> Map Text (Val Text))
-> Map Text (Val Text)
-> Map Text (Val Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
               Text -> Val Text -> Map Text (Val Text) -> Map Text (Val Text)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Text
"lang" (String -> Val Text
toVal' (String -> Val Text) -> String -> Val Text
forall a b. (a -> b) -> a -> b
$ EPUBMetadata -> String
epubLanguage EPUBMetadata
metadata)
             (Map Text (Val Text) -> Map Text (Val Text))
-> Map Text (Val Text) -> Map Text (Val Text)
forall a b. (a -> b) -> a -> b
$ Context Text -> Map Text (Val Text)
forall a. Context a -> Map Text (Val a)
unContext (Context Text -> Map Text (Val Text))
-> Context Text -> Map Text (Val Text)
forall a b. (a -> b) -> a -> b
$ WriterOptions -> Context Text
writerVariables WriterOptions
opts

  let cssvars :: Bool -> Context Text
cssvars Bool
useprefix = Map Text (Val Text) -> Context Text
forall a. Map Text (Val a) -> Context a
Context (Map Text (Val Text) -> Context Text)
-> Map Text (Val Text) -> Context Text
forall a b. (a -> b) -> a -> b
$ Text -> Val Text -> Map Text (Val Text) -> Map Text (Val Text)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Text
"css"
                           ([Val Text] -> Val Text
forall a. [Val a] -> Val a
ListVal ([Val Text] -> Val Text) -> [Val Text] -> Val Text
forall a b. (a -> b) -> a -> b
$ (Entry -> Val Text) -> [Entry] -> [Val Text]
forall a b. (a -> b) -> [a] -> [b]
map
                             (\Entry
e -> String -> Val Text
toVal' (String -> Val Text) -> String -> Val Text
forall a b. (a -> b) -> a -> b
$
                                (if Bool
useprefix then String
"../" else String
"") String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
                                String -> ShowS
makeRelative String
epubSubdir (Entry -> String
eRelativePath Entry
e))
                             [Entry]
stylesheetEntries)
                             Map Text (Val Text)
forall a. Monoid a => a
mempty

  let opts' :: WriterOptions
opts' = WriterOptions
opts{ writerEmailObfuscation :: ObfuscationMethod
writerEmailObfuscation = ObfuscationMethod
NoObfuscation
                  , writerSectionDivs :: Bool
writerSectionDivs = Bool
True
                  , writerVariables :: Context Text
writerVariables = Context Text
vars
                  , writerHTMLMathMethod :: HTMLMathMethod
writerHTMLMathMethod =
                       if Bool
epub3
                          then HTMLMathMethod
MathML
                          else WriterOptions -> HTMLMathMethod
writerHTMLMathMethod WriterOptions
opts
                  , writerWrapText :: WrapOption
writerWrapText = WrapOption
WrapAuto }

  -- cover page
  ([Entry]
cpgEntry, [Entry]
cpicEntry) <-
                case EPUBMetadata -> Maybe String
epubCoverImage EPUBMetadata
metadata of
                     Maybe String
Nothing   -> ([Entry], [Entry]) -> StateT EPUBState m ([Entry], [Entry])
forall (m :: * -> *) a. Monad m => a -> m a
return ([],[])
                     Just String
img  -> do
                       let coverImage :: String
coverImage = ShowS
takeFileName String
img
                       ByteString
imgContent <- m ByteString -> E m ByteString
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ByteString -> E m ByteString) -> m ByteString -> E m ByteString
forall a b. (a -> b) -> a -> b
$ String -> m ByteString
forall (m :: * -> *). PandocMonad m => String -> m ByteString
P.readFileLazy String
img
                       (Integer
coverImageWidth, Integer
coverImageHeight) <-
                             case WriterOptions -> ByteString -> Either Text ImageSize
imageSize WriterOptions
opts' (ByteString -> ByteString
B.toStrict ByteString
imgContent) of
                               Right ImageSize
sz  -> (Integer, Integer) -> StateT EPUBState m (Integer, Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Integer, Integer) -> StateT EPUBState m (Integer, Integer))
-> (Integer, Integer) -> StateT EPUBState m (Integer, Integer)
forall a b. (a -> b) -> a -> b
$ ImageSize -> (Integer, Integer)
sizeInPixels ImageSize
sz
                               Left Text
err' -> (Integer
0, Integer
0) (Integer, Integer)
-> StateT EPUBState m () -> StateT EPUBState m (Integer, Integer)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ LogMessage -> StateT EPUBState m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report
                                 (Text -> Text -> LogMessage
CouldNotDetermineImageSize (String -> Text
TS.pack String
img) Text
err')
                       ByteString
cpContent <- m ByteString -> E m ByteString
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ByteString -> E m ByteString) -> m ByteString -> E m ByteString
forall a b. (a -> b) -> a -> b
$ WriterOptions -> Pandoc -> m ByteString
forall (f :: * -> *).
PandocMonad f =>
WriterOptions -> Pandoc -> f ByteString
writeHtml
                            WriterOptions
opts'{ writerVariables :: Context Text
writerVariables =
                                   Map Text (Val Text) -> Context Text
forall a. Map Text (Val a) -> Context a
Context ([(Text, Val Text)] -> Map Text (Val Text)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [
                                    (Text
"coverpage", String -> Val Text
toVal' String
"true"),
                                    (Text
"pagetitle", Text -> Val Text
forall a b. ToContext a b => b -> Val a
toVal (Text -> Val Text) -> Text -> Val Text
forall a b. (a -> b) -> a -> b
$
                                      Text -> Text
escapeStringForXML (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ String -> Text
TS.pack String
plainTitle),
                                    (Text
"cover-image", String -> Val Text
toVal' String
coverImage),
                                    (Text
"cover-image-width", String -> Val Text
toVal' (String -> Val Text) -> String -> Val Text
forall a b. (a -> b) -> a -> b
$
                                       Integer -> String
forall a. Show a => a -> String
show Integer
coverImageWidth),
                                    (Text
"cover-image-height", String -> Val Text
toVal' (String -> Val Text) -> String -> Val Text
forall a b. (a -> b) -> a -> b
$
                                       Integer -> String
forall a. Show a => a -> String
show Integer
coverImageHeight)]) Context Text -> Context Text -> Context Text
forall a. Semigroup a => a -> a -> a
<>
                                     Bool -> Context Text
cssvars Bool
True Context Text -> Context Text -> Context Text
forall a. Semigroup a => a -> a -> a
<> Context Text
vars }
                            (Meta -> [Block] -> Pandoc
Pandoc Meta
meta [])
                       Entry
coverEntry <- String -> ByteString -> StateT EPUBState m Entry
forall (m :: * -> *).
PandocMonad m =>
String -> ByteString -> E m Entry
mkEntry String
"text/cover.xhtml" ByteString
cpContent
                       Entry
coverImageEntry <- String -> ByteString -> StateT EPUBState m Entry
forall (m :: * -> *).
PandocMonad m =>
String -> ByteString -> E m Entry
mkEntry (String
"media/" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
coverImage)
                                             ByteString
imgContent
                       ([Entry], [Entry]) -> StateT EPUBState m ([Entry], [Entry])
forall (m :: * -> *) a. Monad m => a -> m a
return ( [ Entry
coverEntry ]
                              , [ Entry
coverImageEntry ] )

  -- title page
  ByteString
tpContent <- m ByteString -> E m ByteString
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ByteString -> E m ByteString) -> m ByteString -> E m ByteString
forall a b. (a -> b) -> a -> b
$ WriterOptions -> Pandoc -> m ByteString
forall (f :: * -> *).
PandocMonad f =>
WriterOptions -> Pandoc -> f ByteString
writeHtml WriterOptions
opts'{
                                  writerVariables :: Context Text
writerVariables =
                                      Map Text (Val Text) -> Context Text
forall a. Map Text (Val a) -> Context a
Context ([(Text, Val Text)] -> Map Text (Val Text)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [
                                        (Text
"titlepage", String -> Val Text
toVal' String
"true"),
                                        (Text
"body-type",  String -> Val Text
toVal' String
"frontmatter"),
                                        (Text
"pagetitle", Text -> Val Text
forall a b. ToContext a b => b -> Val a
toVal (Text -> Val Text) -> Text -> Val Text
forall a b. (a -> b) -> a -> b
$
                                            Text -> Text
escapeStringForXML (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ String -> Text
TS.pack String
plainTitle)])
                                      Context Text -> Context Text -> Context Text
forall a. Semigroup a => a -> a -> a
<> Bool -> Context Text
cssvars Bool
True Context Text -> Context Text -> Context Text
forall a. Semigroup a => a -> a -> a
<> Context Text
vars }
                               (Meta -> [Block] -> Pandoc
Pandoc Meta
meta [])
  Entry
tpEntry <- String -> ByteString -> StateT EPUBState m Entry
forall (m :: * -> *).
PandocMonad m =>
String -> ByteString -> E m Entry
mkEntry String
"text/title_page.xhtml" ByteString
tpContent

  -- handle fonts
  let matchingGlob :: String -> t m [String]
matchingGlob String
f = do
        [String]
xs <- m [String] -> t m [String]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [String] -> t m [String]) -> m [String] -> t m [String]
forall a b. (a -> b) -> a -> b
$ String -> m [String]
forall (m :: * -> *). PandocMonad m => String -> m [String]
P.glob String
f
        Bool -> t m () -> t m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
xs) (t m () -> t m ()) -> t m () -> t m ()
forall a b. (a -> b) -> a -> b
$
          LogMessage -> t m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> t m ()) -> LogMessage -> t m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> LogMessage
CouldNotFetchResource (String -> Text
TS.pack String
f) Text
"glob did not match any font files"
        [String] -> t m [String]
forall (m :: * -> *) a. Monad m => a -> m a
return [String]
xs
  let mkFontEntry :: String -> StateT EPUBState m Entry
mkFontEntry String
f = String -> ByteString -> StateT EPUBState m Entry
forall (m :: * -> *).
PandocMonad m =>
String -> ByteString -> E m Entry
mkEntry (String
"fonts/" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
takeFileName String
f) (ByteString -> StateT EPUBState m Entry)
-> StateT EPUBState m ByteString -> StateT EPUBState m Entry
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
                        m ByteString -> StateT EPUBState m ByteString
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (String -> m ByteString
forall (m :: * -> *). PandocMonad m => String -> m ByteString
P.readFileLazy String
f)
  [String]
fontFiles <- [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[String]] -> [String])
-> StateT EPUBState m [[String]] -> StateT EPUBState m [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> StateT EPUBState m [String])
-> [String] -> StateT EPUBState m [[String]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> StateT EPUBState m [String]
forall (t :: (* -> *) -> * -> *) (m :: * -> *).
(MonadTrans t, PandocMonad m, PandocMonad (t m)) =>
String -> t m [String]
matchingGlob (WriterOptions -> [String]
writerEpubFonts WriterOptions
opts')
  [Entry]
fontEntries <- (String -> StateT EPUBState m Entry)
-> [String] -> StateT EPUBState m [Entry]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> StateT EPUBState m Entry
forall (m :: * -> *).
PandocMonad m =>
String -> StateT EPUBState m Entry
mkFontEntry [String]
fontFiles

  -- set page progression direction attribution
  let progressionDirection :: [(String, String)]
progressionDirection = case EPUBMetadata -> Maybe ProgressionDirection
epubPageDirection EPUBMetadata
metadata of
                                  Just ProgressionDirection
LTR | Bool
epub3 ->
                                    [(String
"page-progression-direction", String
"ltr")]
                                  Just ProgressionDirection
RTL | Bool
epub3 ->
                                    [(String
"page-progression-direction", String
"rtl")]
                                  Maybe ProgressionDirection
_  -> []

  -- body pages

  let chapterHeaderLevel :: Int
chapterHeaderLevel = WriterOptions -> Int
writerEpubChapterLevel WriterOptions
opts

  let isChapterHeader :: Block -> Bool
isChapterHeader (Div Attr
_ (Header Int
n Attr
_ [Inline]
_:[Block]
_)) = Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
chapterHeaderLevel
      isChapterHeader Block
_ = Bool
False

  let secsToChapters :: [Block] -> [Chapter]
      secsToChapters :: [Block] -> [Chapter]
secsToChapters [] = []
      secsToChapters (d :: Block
d@(Div Attr
attr (h :: Block
h@(Header Int
lvl Attr
_ [Inline]
_) : [Block]
bs)) : [Block]
rest)
        | Int
chapterHeaderLevel Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
lvl =
           [Block] -> Chapter
Chapter [Block
d] Chapter -> [Chapter] -> [Chapter]
forall a. a -> [a] -> [a]
: [Block] -> [Chapter]
secsToChapters [Block]
rest
        | Int
chapterHeaderLevel Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
lvl =
           [Block] -> Chapter
Chapter [Attr -> [Block] -> Block
Div Attr
attr (Block
hBlock -> [Block] -> [Block]
forall a. a -> [a] -> [a]
:[Block]
xs)] Chapter -> [Chapter] -> [Chapter]
forall a. a -> [a] -> [a]
:
           [Block] -> [Chapter]
secsToChapters [Block]
ys [Chapter] -> [Chapter] -> [Chapter]
forall a. [a] -> [a] -> [a]
++ [Block] -> [Chapter]
secsToChapters [Block]
rest
             where ([Block]
xs, [Block]
ys) = (Block -> Bool) -> [Block] -> ([Block], [Block])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Block -> Bool
isChapterHeader [Block]
bs
      secsToChapters [Block]
bs =
          (if [Block] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Block]
xs then [Chapter] -> [Chapter]
forall a. a -> a
id else ([Block] -> Chapter
Chapter [Block]
xs Chapter -> [Chapter] -> [Chapter]
forall a. a -> [a] -> [a]
:)) ([Chapter] -> [Chapter]) -> [Chapter] -> [Chapter]
forall a b. (a -> b) -> a -> b
$ [Block] -> [Chapter]
secsToChapters [Block]
ys
            where ([Block]
xs, [Block]
ys) = (Block -> Bool) -> [Block] -> ([Block], [Block])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Block -> Bool
isChapterHeader [Block]
bs

  -- add level 1 header to beginning if none there
  let secs :: [Block]
secs = Bool -> Maybe Int -> [Block] -> [Block]
makeSections Bool
True Maybe Int
forall a. Maybe a
Nothing
              ([Block] -> [Block]) -> [Block] -> [Block]
forall a b. (a -> b) -> a -> b
$ WriterOptions -> [Block] -> [Block]
addIdentifiers WriterOptions
opts
              ([Block] -> [Block]) -> [Block] -> [Block]
forall a b. (a -> b) -> a -> b
$ case [Block]
blocks of
                  (Div Attr
_
                    (Header{}:[Block]
_) : [Block]
_) -> [Block]
blocks
                  (Header Int
1 Attr
_ [Inline]
_ : [Block]
_)  -> [Block]
blocks
                  [Block]
_                   -> Int -> Attr -> [Inline] -> Block
Header Int
1 (Text
"",[Text
"unnumbered"],[])
                                             (Meta -> [Inline]
docTitle' Meta
meta) Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
blocks

  let chapters' :: [Chapter]
chapters' = [Block] -> [Chapter]
secsToChapters [Block]
secs

  let extractLinkURL' :: Int -> Inline -> [(TS.Text, TS.Text)]
      extractLinkURL' :: Int -> Inline -> [(Text, Text)]
extractLinkURL' Int
num (Span (Text
ident, [Text]
_, [(Text, Text)]
_) [Inline]
_)
        | Bool -> Bool
not (Text -> Bool
TS.null Text
ident) = [(Text
ident, String -> Text
TS.pack (Int -> String
showChapter Int
num) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
ident)]
      extractLinkURL' Int
_ Inline
_ = []

  let extractLinkURL :: Int -> Block -> [(TS.Text, TS.Text)]
      extractLinkURL :: Int -> Block -> [(Text, Text)]
extractLinkURL Int
num (Div (Text
ident, [Text]
_, [(Text, Text)]
_) [Block]
_)
        | Bool -> Bool
not (Text -> Bool
TS.null Text
ident) = [(Text
ident, String -> Text
TS.pack (Int -> String
showChapter Int
num) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
ident)]
      extractLinkURL Int
num (Header Int
_ (Text
ident, [Text]
_, [(Text, Text)]
_) [Inline]
_)
        | Bool -> Bool
not (Text -> Bool
TS.null Text
ident) = [(Text
ident, String -> Text
TS.pack (Int -> String
showChapter Int
num) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
ident)]
      extractLinkURL Int
num Block
b = (Inline -> [(Text, Text)]) -> Block -> [(Text, Text)]
forall a b c. (Walkable a b, Monoid c) => (a -> c) -> b -> c
query (Int -> Inline -> [(Text, Text)]
extractLinkURL' Int
num) Block
b

  let reftable :: [(Text, Text)]
reftable = [[(Text, Text)]] -> [(Text, Text)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[(Text, Text)]] -> [(Text, Text)])
-> [[(Text, Text)]] -> [(Text, Text)]
forall a b. (a -> b) -> a -> b
$ (Chapter -> Int -> [(Text, Text)])
-> [Chapter] -> [Int] -> [[(Text, Text)]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\(Chapter [Block]
bs) Int
num ->
                                    (Block -> [(Text, Text)]) -> [Block] -> [(Text, Text)]
forall a b c. (Walkable a b, Monoid c) => (a -> c) -> b -> c
query (Int -> Block -> [(Text, Text)]
extractLinkURL Int
num) [Block]
bs)
                          [Chapter]
chapters' [Int
1..]

  let fixInternalReferences :: Inline -> Inline
      fixInternalReferences :: Inline -> Inline
fixInternalReferences (Link Attr
attr [Inline]
lab (Text
src, Text
tit))
        | Just (Char
'#', Text
xs) <- Text -> Maybe (Char, Text)
TS.uncons Text
src = case Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
xs [(Text, Text)]
reftable of
             Just Text
ys -> Attr -> [Inline] -> (Text, Text) -> Inline
Link Attr
attr [Inline]
lab (Text
ys, Text
tit)
             Maybe Text
Nothing -> Attr -> [Inline] -> (Text, Text) -> Inline
Link Attr
attr [Inline]
lab (Text
src, Text
tit)
      fixInternalReferences Inline
x = Inline
x

  -- internal reference IDs change when we chunk the file,
  -- so that '#my-header-1' might turn into 'chap004.xhtml#my-header'.
  -- this fixes that:
  let chapters :: [Chapter]
chapters = (Chapter -> Chapter) -> [Chapter] -> [Chapter]
forall a b. (a -> b) -> [a] -> [b]
map (\(Chapter [Block]
bs) ->
                         [Block] -> Chapter
Chapter ([Block] -> Chapter) -> [Block] -> Chapter
forall a b. (a -> b) -> a -> b
$ (Inline -> Inline) -> [Block] -> [Block]
forall a b. Walkable a b => (a -> a) -> b -> b
walk Inline -> Inline
fixInternalReferences [Block]
bs)
                 [Chapter]
chapters'

  let chapToEntry :: Int -> Chapter -> StateT EPUBState m Entry
chapToEntry Int
num (Chapter [Block]
bs) =
        String -> ByteString -> StateT EPUBState m Entry
forall (m :: * -> *).
PandocMonad m =>
String -> ByteString -> E m Entry
mkEntry (String
"text/" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
showChapter Int
num) (ByteString -> StateT EPUBState m Entry)
-> StateT EPUBState m ByteString -> StateT EPUBState m Entry
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
        WriterOptions -> Pandoc -> StateT EPUBState m ByteString
forall (f :: * -> *).
PandocMonad f =>
WriterOptions -> Pandoc -> f ByteString
writeHtml WriterOptions
opts'{ writerVariables :: Context Text
writerVariables =
                            Map Text (Val Text) -> Context Text
forall a. Map Text (Val a) -> Context a
Context ([(Text, Val Text)] -> Map Text (Val Text)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
                                     [(Text
"body-type", String -> Val Text
toVal' String
bodyType),
                                      (Text
"pagetitle", String -> Val Text
toVal' (String -> Val Text) -> String -> Val Text
forall a b. (a -> b) -> a -> b
$
                                           Int -> String
showChapter Int
num)])
                            Context Text -> Context Text -> Context Text
forall a. Semigroup a => a -> a -> a
<> Bool -> Context Text
cssvars Bool
True Context Text -> Context Text -> Context Text
forall a. Semigroup a => a -> a -> a
<> Context Text
vars } Pandoc
pdoc
         where (Pandoc
pdoc, String
bodyType) =
                 case [Block]
bs of
                     (Div (Text
_,Text
"section":[Text]
_,[(Text, Text)]
kvs)
                       (Header Int
_ Attr
_ [Inline]
xs : [Block]
_) : [Block]
_) ->
                       -- remove notes or we get doubled footnotes
                       (Meta -> [Block] -> Pandoc
Pandoc (Text -> Many Inline -> Meta -> Meta
forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
setMeta Text
"title"
                           ((Inline -> Inline) -> Many Inline -> Many Inline
forall a b. Walkable a b => (a -> a) -> b -> b
walk Inline -> Inline
removeNote (Many Inline -> Many Inline) -> Many Inline -> Many Inline
forall a b. (a -> b) -> a -> b
$ [Inline] -> Many Inline
forall a. [a] -> Many a
fromList [Inline]
xs) Meta
nullMeta) [Block]
bs,
                        case Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"epub:type" [(Text, Text)]
kvs of
                             Maybe Text
Nothing -> String
"bodymatter"
                             Just Text
x
                               | Text
x Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
frontMatterTypes -> String
"frontmatter"
                               | Text
x Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
backMatterTypes  -> String
"backmatter"
                               | Bool
otherwise                 -> String
"bodymatter")
                     [Block]
_                   -> (Meta -> [Block] -> Pandoc
Pandoc Meta
nullMeta [Block]
bs, String
"bodymatter")
               frontMatterTypes :: [Text]
frontMatterTypes = [Text
"prologue", Text
"abstract", Text
"acknowledgments",
                                   Text
"copyright-page", Text
"dedication",
                                   Text
"credits", Text
"keywords", Text
"imprint",
                                   Text
"contributors", Text
"other-credits",
                                   Text
"errata", Text
"revision-history",
                                   Text
"titlepage", Text
"halftitlepage", Text
"seriespage",
                                   Text
"foreword", Text
"preface",
                                   Text
"seriespage", Text
"titlepage"]
               backMatterTypes :: [Text]
backMatterTypes = [Text
"appendix", Text
"colophon", Text
"bibliography",
                                  Text
"index"]

  [Entry]
chapterEntries <- (Int -> Chapter -> StateT EPUBState m Entry)
-> [Int] -> [Chapter] -> StateT EPUBState m [Entry]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM Int -> Chapter -> StateT EPUBState m Entry
forall (m :: * -> *).
PandocMonad m =>
Int -> Chapter -> StateT EPUBState m Entry
chapToEntry [Int
1..] [Chapter]
chapters

  -- incredibly inefficient (TODO):
  let containsMathML :: Entry -> Bool
containsMathML Entry
ent = Bool
epub3 Bool -> Bool -> Bool
&&
                           String
"<math" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf`
        ByteString -> String
B8.unpack (Entry -> ByteString
fromEntry Entry
ent)
  let containsSVG :: Entry -> Bool
containsSVG Entry
ent    = Bool
epub3 Bool -> Bool -> Bool
&&
                           String
"<svg" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf`
        ByteString -> String
B8.unpack (Entry -> ByteString
fromEntry Entry
ent)
  let props :: Entry -> [a]
props Entry
ent = [a
"mathml" | Entry -> Bool
containsMathML Entry
ent] [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a
"svg" | Entry -> Bool
containsSVG Entry
ent]

  -- contents.opf
  let chapterNode :: Entry -> Element
chapterNode Entry
ent = String -> () -> Element
forall t. Node t => String -> t -> Element
unode String
"item" (() -> Element) -> [(String, String)] -> () -> Element
forall t. (t -> Element) -> [(String, String)] -> t -> Element
!
                           ([(String
"id", ShowS
toId ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
makeRelative String
epubSubdir
                                         ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Entry -> String
eRelativePath Entry
ent),
                             (String
"href", String -> ShowS
makeRelative String
epubSubdir
                                      ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Entry -> String
eRelativePath Entry
ent),
                             (String
"media-type", String
"application/xhtml+xml")]
                            [(String, String)] -> [(String, String)] -> [(String, String)]
forall a. [a] -> [a] -> [a]
++ case Entry -> [String]
forall a. IsString a => Entry -> [a]
props Entry
ent of
                                    [] -> []
                                    [String]
xs -> [(String
"properties", [String] -> String
unwords [String]
xs)])
                        (() -> Element) -> () -> Element
forall a b. (a -> b) -> a -> b
$ ()

  let chapterRefNode :: Entry -> Element
chapterRefNode Entry
ent = String -> () -> Element
forall t. Node t => String -> t -> Element
unode String
"itemref" (() -> Element) -> [(String, String)] -> () -> Element
forall t. (t -> Element) -> [(String, String)] -> t -> Element
!
                             [(String
"idref", ShowS
toId ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
makeRelative String
epubSubdir
                                             ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Entry -> String
eRelativePath Entry
ent)] (() -> Element) -> () -> Element
forall a b. (a -> b) -> a -> b
$ ()
  let pictureNode :: Entry -> Element
pictureNode Entry
ent = String -> () -> Element
forall t. Node t => String -> t -> Element
unode String
"item" (() -> Element) -> [(String, String)] -> () -> Element
forall t. (t -> Element) -> [(String, String)] -> t -> Element
!
                           [(String
"id", ShowS
toId ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
makeRelative String
epubSubdir
                                        ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Entry -> String
eRelativePath Entry
ent),
                            (String
"href", String -> ShowS
makeRelative String
epubSubdir
                                     ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Entry -> String
eRelativePath Entry
ent),
                            (String
"media-type",
                               String -> (Text -> String) -> Maybe Text -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"application/octet-stream" Text -> String
TS.unpack
                               (Maybe Text -> String) -> Maybe Text -> String
forall a b. (a -> b) -> a -> b
$ String -> Maybe Text
mediaTypeOf (String -> Maybe Text) -> String -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Entry -> String
eRelativePath Entry
ent)] (() -> Element) -> () -> Element
forall a b. (a -> b) -> a -> b
$ ()
  let fontNode :: Entry -> Element
fontNode Entry
ent = String -> () -> Element
forall t. Node t => String -> t -> Element
unode String
"item" (() -> Element) -> [(String, String)] -> () -> Element
forall t. (t -> Element) -> [(String, String)] -> t -> Element
!
                           [(String
"id", ShowS
toId ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
makeRelative String
epubSubdir
                                        ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Entry -> String
eRelativePath Entry
ent),
                            (String
"href", String -> ShowS
makeRelative String
epubSubdir
                                     ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Entry -> String
eRelativePath Entry
ent),
                            (String
"media-type", String -> (Text -> String) -> Maybe Text -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" Text -> String
TS.unpack (Maybe Text -> String) -> Maybe Text -> String
forall a b. (a -> b) -> a -> b
$
                                  String -> Maybe Text
getMimeType (String -> Maybe Text) -> String -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Entry -> String
eRelativePath Entry
ent)] (() -> Element) -> () -> Element
forall a b. (a -> b) -> a -> b
$ ()

  let tocTitle :: String
tocTitle = String -> (MetaValue -> String) -> Maybe MetaValue -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
plainTitle
                   MetaValue -> String
metaValueToString (Maybe MetaValue -> String) -> Maybe MetaValue -> String
forall a b. (a -> b) -> a -> b
$ Text -> Meta -> Maybe MetaValue
lookupMeta Text
"toc-title" Meta
meta
  String
uuid <- case EPUBMetadata -> [Identifier]
epubIdentifier EPUBMetadata
metadata of
            (Identifier
x:[Identifier]
_) -> String -> StateT EPUBState m String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> StateT EPUBState m String)
-> String -> StateT EPUBState m String
forall a b. (a -> b) -> a -> b
$ Identifier -> String
identifierText Identifier
x  -- use first identifier as UUID
            []    -> PandocError -> StateT EPUBState m String
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError -> StateT EPUBState m String)
-> PandocError -> StateT EPUBState m String
forall a b. (a -> b) -> a -> b
$ Text -> PandocError
PandocShouldNeverHappenError Text
"epubIdentifier is null"  -- shouldn't happen
  UTCTime
currentTime <- m UTCTime -> StateT EPUBState m UTCTime
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m UTCTime
forall (m :: * -> *). PandocMonad m => m UTCTime
P.getCurrentTime
  let contentsData :: ByteString
contentsData = String -> ByteString
UTF8.fromStringLazy (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ Element -> String
ppTopElement (Element -> String) -> Element -> String
forall a b. (a -> b) -> a -> b
$
        String -> [Element] -> Element
forall t. Node t => String -> t -> Element
unode String
"package" ([Element] -> Element)
-> [(String, String)] -> [Element] -> Element
forall t. (t -> Element) -> [(String, String)] -> t -> Element
!
          ([(String
"version", case EPUBVersion
version of
                             EPUBVersion
EPUB2 -> String
"2.0"
                             EPUBVersion
EPUB3 -> String
"3.0")
           ,(String
"xmlns",String
"http://www.idpf.org/2007/opf")
           ,(String
"unique-identifier",String
"epub-id-1")
           ] [(String, String)] -> [(String, String)] -> [(String, String)]
forall a. [a] -> [a] -> [a]
++
           [(String
"prefix",String
"ibooks: http://vocabulary.itunes.apple.com/rdf/ibooks/vocabulary-extensions-1.0/") | EPUBVersion
version EPUBVersion -> EPUBVersion -> Bool
forall a. Eq a => a -> a -> Bool
== EPUBVersion
EPUB3]) ([Element] -> Element) -> [Element] -> Element
forall a b. (a -> b) -> a -> b
$
          [ EPUBVersion -> EPUBMetadata -> UTCTime -> Element
metadataElement EPUBVersion
version EPUBMetadata
metadata UTCTime
currentTime
          , String -> [Element] -> Element
forall t. Node t => String -> t -> Element
unode String
"manifest" ([Element] -> Element) -> [Element] -> Element
forall a b. (a -> b) -> a -> b
$
             [ String -> () -> Element
forall t. Node t => String -> t -> Element
unode String
"item" (() -> Element) -> [(String, String)] -> () -> Element
forall t. (t -> Element) -> [(String, String)] -> t -> Element
! [(String
"id",String
"ncx"), (String
"href",String
"toc.ncx")
                              ,(String
"media-type",String
"application/x-dtbncx+xml")] (() -> Element) -> () -> Element
forall a b. (a -> b) -> a -> b
$ ()
             , String -> () -> Element
forall t. Node t => String -> t -> Element
unode String
"item" (() -> Element) -> [(String, String)] -> () -> Element
forall t. (t -> Element) -> [(String, String)] -> t -> Element
! ([(String
"id",String
"nav")
                               ,(String
"href",String
"nav.xhtml")
                               ,(String
"media-type",String
"application/xhtml+xml")] [(String, String)] -> [(String, String)] -> [(String, String)]
forall a. [a] -> [a] -> [a]
++
                               [(String
"properties",String
"nav") | Bool
epub3 ]) (() -> Element) -> () -> Element
forall a b. (a -> b) -> a -> b
$ ()
             ] [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++
             [ String -> () -> Element
forall t. Node t => String -> t -> Element
unode String
"item" (() -> Element) -> [(String, String)] -> () -> Element
forall t. (t -> Element) -> [(String, String)] -> t -> Element
! [(String
"id",String
"stylesheet" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n), (String
"href",String
fp)
                              ,(String
"media-type",String
"text/css")] (() -> Element) -> () -> Element
forall a b. (a -> b) -> a -> b
$ () |
                             (Int
n :: Int, String
fp) <- [Int] -> [String] -> [(Int, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1..] ((Entry -> String) -> [Entry] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map
                               (String -> ShowS
makeRelative String
epubSubdir ShowS -> (Entry -> String) -> Entry -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Entry -> String
eRelativePath)
                               [Entry]
stylesheetEntries) ] [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++
             (Entry -> Element) -> [Entry] -> [Element]
forall a b. (a -> b) -> [a] -> [b]
map Entry -> Element
chapterNode ([Entry]
cpgEntry [Entry] -> [Entry] -> [Entry]
forall a. [a] -> [a] -> [a]
++ (Entry
tpEntry Entry -> [Entry] -> [Entry]
forall a. a -> [a] -> [a]
: [Entry]
chapterEntries)) [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++
             (case [Entry]
cpicEntry of
                    []    -> []
                    (Entry
x:[Entry]
_) -> [[Attr] -> Element -> Element
add_attrs
                              [QName -> String -> Attr
Attr (String -> QName
unqual String
"properties") String
"cover-image" | Bool
epub3]
                              (Entry -> Element
pictureNode Entry
x)]) [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++
             (Entry -> Element) -> [Entry] -> [Element]
forall a b. (a -> b) -> [a] -> [b]
map Entry -> Element
pictureNode [Entry]
picEntries [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++
             (Entry -> Element) -> [Entry] -> [Element]
forall a b. (a -> b) -> [a] -> [b]
map Entry -> Element
fontNode [Entry]
fontEntries
          , String -> [Element] -> Element
forall t. Node t => String -> t -> Element
unode String
"spine" ([Element] -> Element)
-> [(String, String)] -> [Element] -> Element
forall t. (t -> Element) -> [(String, String)] -> t -> Element
! (
             (String
"toc",String
"ncx") (String, String) -> [(String, String)] -> [(String, String)]
forall a. a -> [a] -> [a]
: [(String, String)]
progressionDirection) ([Element] -> Element) -> [Element] -> Element
forall a b. (a -> b) -> a -> b
$
              case EPUBMetadata -> Maybe String
epubCoverImage EPUBMetadata
metadata of
                    Maybe String
Nothing -> []
                    Just String
_ -> [ String -> () -> Element
forall t. Node t => String -> t -> Element
unode String
"itemref" (() -> Element) -> [(String, String)] -> () -> Element
forall t. (t -> Element) -> [(String, String)] -> t -> Element
!
                                [(String
"idref", String
"cover_xhtml")] (() -> Element) -> () -> Element
forall a b. (a -> b) -> a -> b
$ () ]
              [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++ ((String -> () -> Element
forall t. Node t => String -> t -> Element
unode String
"itemref" (() -> Element) -> [(String, String)] -> () -> Element
forall t. (t -> Element) -> [(String, String)] -> t -> Element
! [(String
"idref", String
"title_page_xhtml")
                                     ,(String
"linear",
                                         case Text -> Meta -> Maybe MetaValue
lookupMeta Text
"title" Meta
meta of
                                               Just MetaValue
_  -> String
"yes"
                                               Maybe MetaValue
Nothing -> String
"no")] (() -> Element) -> () -> Element
forall a b. (a -> b) -> a -> b
$ ()) Element -> [Element] -> [Element]
forall a. a -> [a] -> [a]
:
                  [String -> () -> Element
forall t. Node t => String -> t -> Element
unode String
"itemref" (() -> Element) -> [(String, String)] -> () -> Element
forall t. (t -> Element) -> [(String, String)] -> t -> Element
! [(String
"idref", String
"nav")] (() -> Element) -> () -> Element
forall a b. (a -> b) -> a -> b
$ ()
                         | WriterOptions -> Bool
writerTableOfContents WriterOptions
opts ] [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++
                  (Entry -> Element) -> [Entry] -> [Element]
forall a b. (a -> b) -> [a] -> [b]
map Entry -> Element
chapterRefNode [Entry]
chapterEntries)
          , String -> [Element] -> Element
forall t. Node t => String -> t -> Element
unode String
"guide" ([Element] -> Element) -> [Element] -> Element
forall a b. (a -> b) -> a -> b
$
             (String -> () -> Element
forall t. Node t => String -> t -> Element
unode String
"reference" (() -> Element) -> [(String, String)] -> () -> Element
forall t. (t -> Element) -> [(String, String)] -> t -> Element
!
                 [(String
"type",String
"toc"),(String
"title", String
tocTitle),
                  (String
"href",String
"nav.xhtml")] (() -> Element) -> () -> Element
forall a b. (a -> b) -> a -> b
$ ()
             ) Element -> [Element] -> [Element]
forall a. a -> [a] -> [a]
:
             [ String -> () -> Element
forall t. Node t => String -> t -> Element
unode String
"reference" (() -> Element) -> [(String, String)] -> () -> Element
forall t. (t -> Element) -> [(String, String)] -> t -> Element
!
                   [(String
"type",String
"cover")
                   ,(String
"title",String
"Cover")
                   ,(String
"href",String
"text/cover.xhtml")] (() -> Element) -> () -> Element
forall a b. (a -> b) -> a -> b
$ ()
               | Maybe String -> Bool
forall a. Maybe a -> Bool
isJust (EPUBMetadata -> Maybe String
epubCoverImage EPUBMetadata
metadata)
             ]
          ]
  Entry
contentsEntry <- String -> ByteString -> StateT EPUBState m Entry
forall (m :: * -> *).
PandocMonad m =>
String -> ByteString -> E m Entry
mkEntry String
"content.opf" ByteString
contentsData

  -- toc.ncx
  let tocLevel :: Int
tocLevel = WriterOptions -> Int
writerTOCDepth WriterOptions
opts

  let navPointNode :: PandocMonad m
                   => (Int -> [Inline] -> TS.Text -> [Element] -> Element)
                   -> Block -> StateT Int m [Element]
      navPointNode :: (Int -> [Inline] -> Text -> [Element] -> Element)
-> Block -> StateT Int m [Element]
navPointNode Int -> [Inline] -> Text -> [Element] -> Element
formatter (Div (Text
ident,[Text]
_,[(Text, Text)]
_)
                                (Header Int
lvl (Text
_,[Text]
_,[(Text, Text)]
kvs) [Inline]
ils : [Block]
children)) =
        if Int
lvl Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
tocLevel
           then [Element] -> StateT Int m [Element]
forall (m :: * -> *) a. Monad m => a -> m a
return []
           else do
             Int
n <- StateT Int m Int
forall s (m :: * -> *). MonadState s m => m s
get
             (Int -> Int) -> StateT Int m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
             let num :: Text
num = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"number" [(Text, Text)]
kvs
             let tit :: [Inline]
tit = if WriterOptions -> Bool
writerNumberSections WriterOptions
opts Bool -> Bool -> Bool
&& Bool -> Bool
not (Text -> Bool
TS.null Text
num)
                          then Attr -> [Inline] -> Inline
Span (Text
"", [Text
"section-header-number"], [])
                                [Text -> Inline
Str Text
num] Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Inline
Space Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
ils
                          else [Inline]
ils
             Text
src <- case Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
ident [(Text, Text)]
reftable of
                      Just Text
x  -> Text -> StateT Int m Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
x
                      Maybe Text
Nothing -> PandocError -> StateT Int m Text
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError -> StateT Int m Text)
-> PandocError -> StateT Int m Text
forall a b. (a -> b) -> a -> b
$ Text -> PandocError
PandocSomeError (Text -> PandocError) -> Text -> PandocError
forall a b. (a -> b) -> a -> b
$
                                    Text
ident Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" not found in reftable"
             [Element]
subs <- [[Element]] -> [Element]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Element]] -> [Element])
-> StateT Int m [[Element]] -> StateT Int m [Element]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Block -> StateT Int m [Element])
-> [Block] -> StateT Int m [[Element]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((Int -> [Inline] -> Text -> [Element] -> Element)
-> Block -> StateT Int m [Element]
forall (m :: * -> *).
PandocMonad m =>
(Int -> [Inline] -> Text -> [Element] -> Element)
-> Block -> StateT Int m [Element]
navPointNode Int -> [Inline] -> Text -> [Element] -> Element
formatter) [Block]
children
             [Element] -> StateT Int m [Element]
forall (m :: * -> *) a. Monad m => a -> m a
return [Int -> [Inline] -> Text -> [Element] -> Element
formatter Int
n [Inline]
tit Text
src [Element]
subs]
      navPointNode Int -> [Inline] -> Text -> [Element] -> Element
formatter (Div Attr
_ [Block]
bs) =
        [[Element]] -> [Element]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Element]] -> [Element])
-> StateT Int m [[Element]] -> StateT Int m [Element]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Block -> StateT Int m [Element])
-> [Block] -> StateT Int m [[Element]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((Int -> [Inline] -> Text -> [Element] -> Element)
-> Block -> StateT Int m [Element]
forall (m :: * -> *).
PandocMonad m =>
(Int -> [Inline] -> Text -> [Element] -> Element)
-> Block -> StateT Int m [Element]
navPointNode Int -> [Inline] -> Text -> [Element] -> Element
formatter) [Block]
bs
      navPointNode Int -> [Inline] -> Text -> [Element] -> Element
_ Block
_ = [Element] -> StateT Int m [Element]
forall (m :: * -> *) a. Monad m => a -> m a
return []

  let navMapFormatter :: Int -> [Inline] -> TS.Text -> [Element] -> Element
      navMapFormatter :: Int -> [Inline] -> Text -> [Element] -> Element
navMapFormatter Int
n [Inline]
tit Text
src [Element]
subs = String -> [Element] -> Element
forall t. Node t => String -> t -> Element
unode String
"navPoint" ([Element] -> Element)
-> [(String, String)] -> [Element] -> Element
forall t. (t -> Element) -> [(String, String)] -> t -> Element
!
               [(String
"id", String
"navPoint-" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n)] ([Element] -> Element) -> [Element] -> Element
forall a b. (a -> b) -> a -> b
$
                  [ String -> Element -> Element
forall t. Node t => String -> t -> Element
unode String
"navLabel" (Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$ String -> String -> Element
forall t. Node t => String -> t -> Element
unode String
"text" (String -> Element) -> String -> Element
forall a b. (a -> b) -> a -> b
$ Text -> String
TS.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ [Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify [Inline]
tit
                  , String -> () -> Element
forall t. Node t => String -> t -> Element
unode String
"content" (() -> Element) -> [(String, String)] -> () -> Element
forall t. (t -> Element) -> [(String, String)] -> t -> Element
! [(String
"src", String
"text/" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
TS.unpack Text
src)] (() -> Element) -> () -> Element
forall a b. (a -> b) -> a -> b
$ ()
                  ] [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++ [Element]
subs

  let tpNode :: Element
tpNode = String -> [Element] -> Element
forall t. Node t => String -> t -> Element
unode String
"navPoint" ([Element] -> Element)
-> [(String, String)] -> [Element] -> Element
forall t. (t -> Element) -> [(String, String)] -> t -> Element
!  [(String
"id", String
"navPoint-0")] ([Element] -> Element) -> [Element] -> Element
forall a b. (a -> b) -> a -> b
$
                  [ String -> Element -> Element
forall t. Node t => String -> t -> Element
unode String
"navLabel" (Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$ String -> String -> Element
forall t. Node t => String -> t -> Element
unode String
"text" (Text -> String
TS.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ [Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify ([Inline] -> Text) -> [Inline] -> Text
forall a b. (a -> b) -> a -> b
$ Meta -> [Inline]
docTitle' Meta
meta)
                  , String -> () -> Element
forall t. Node t => String -> t -> Element
unode String
"content" (() -> Element) -> [(String, String)] -> () -> Element
forall t. (t -> Element) -> [(String, String)] -> t -> Element
! [(String
"src", String
"text/title_page.xhtml")]
                  (() -> Element) -> () -> Element
forall a b. (a -> b) -> a -> b
$ () ]

  [Element]
navMap <- m [Element] -> StateT EPUBState m [Element]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [Element] -> StateT EPUBState m [Element])
-> m [Element] -> StateT EPUBState m [Element]
forall a b. (a -> b) -> a -> b
$ StateT Int m [Element] -> Int -> m [Element]
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT
             ([[Element]] -> [Element]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Element]] -> [Element])
-> StateT Int m [[Element]] -> StateT Int m [Element]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Block -> StateT Int m [Element])
-> [Block] -> StateT Int m [[Element]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((Int -> [Inline] -> Text -> [Element] -> Element)
-> Block -> StateT Int m [Element]
forall (m :: * -> *).
PandocMonad m =>
(Int -> [Inline] -> Text -> [Element] -> Element)
-> Block -> StateT Int m [Element]
navPointNode Int -> [Inline] -> Text -> [Element] -> Element
navMapFormatter) [Block]
secs) Int
1
  let tocData :: ByteString
tocData = String -> ByteString
UTF8.fromStringLazy (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ Element -> String
ppTopElement (Element -> String) -> Element -> String
forall a b. (a -> b) -> a -> b
$
        String -> [Element] -> Element
forall t. Node t => String -> t -> Element
unode String
"ncx" ([Element] -> Element)
-> [(String, String)] -> [Element] -> Element
forall t. (t -> Element) -> [(String, String)] -> t -> Element
! [(String
"version",String
"2005-1")
                       ,(String
"xmlns",String
"http://www.daisy.org/z3986/2005/ncx/")] ([Element] -> Element) -> [Element] -> Element
forall a b. (a -> b) -> a -> b
$
          [ String -> [Element] -> Element
forall t. Node t => String -> t -> Element
unode String
"head" ([Element] -> Element) -> [Element] -> Element
forall a b. (a -> b) -> a -> b
$
             [ String -> () -> Element
forall t. Node t => String -> t -> Element
unode String
"meta" (() -> Element) -> [(String, String)] -> () -> Element
forall t. (t -> Element) -> [(String, String)] -> t -> Element
! [(String
"name",String
"dtb:uid")
                              ,(String
"content", String
uuid)] (() -> Element) -> () -> Element
forall a b. (a -> b) -> a -> b
$ ()
             , String -> () -> Element
forall t. Node t => String -> t -> Element
unode String
"meta" (() -> Element) -> [(String, String)] -> () -> Element
forall t. (t -> Element) -> [(String, String)] -> t -> Element
! [(String
"name",String
"dtb:depth")
                              ,(String
"content", String
"1")] (() -> Element) -> () -> Element
forall a b. (a -> b) -> a -> b
$ ()
             , String -> () -> Element
forall t. Node t => String -> t -> Element
unode String
"meta" (() -> Element) -> [(String, String)] -> () -> Element
forall t. (t -> Element) -> [(String, String)] -> t -> Element
! [(String
"name",String
"dtb:totalPageCount")
                              ,(String
"content", String
"0")] (() -> Element) -> () -> Element
forall a b. (a -> b) -> a -> b
$ ()
             , String -> () -> Element
forall t. Node t => String -> t -> Element
unode String
"meta" (() -> Element) -> [(String, String)] -> () -> Element
forall t. (t -> Element) -> [(String, String)] -> t -> Element
! [(String
"name",String
"dtb:maxPageNumber")
                              ,(String
"content", String
"0")] (() -> Element) -> () -> Element
forall a b. (a -> b) -> a -> b
$ ()
             ] [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++ case EPUBMetadata -> Maybe String
epubCoverImage EPUBMetadata
metadata of
                        Maybe String
Nothing  -> []
                        Just String
img -> [String -> () -> Element
forall t. Node t => String -> t -> Element
unode String
"meta" (() -> Element) -> [(String, String)] -> () -> Element
forall t. (t -> Element) -> [(String, String)] -> t -> Element
! [(String
"name",String
"cover"),
                                            (String
"content", ShowS
toId String
img)] (() -> Element) -> () -> Element
forall a b. (a -> b) -> a -> b
$ ()]
          , String -> Element -> Element
forall t. Node t => String -> t -> Element
unode String
"docTitle" (Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$ String -> String -> Element
forall t. Node t => String -> t -> Element
unode String
"text" String
plainTitle
          , String -> [Element] -> Element
forall t. Node t => String -> t -> Element
unode String
"navMap" ([Element] -> Element) -> [Element] -> Element
forall a b. (a -> b) -> a -> b
$
              Element
tpNode Element -> [Element] -> [Element]
forall a. a -> [a] -> [a]
: [Element]
navMap
          ]
  Entry
tocEntry <- String -> ByteString -> StateT EPUBState m Entry
forall (m :: * -> *).
PandocMonad m =>
String -> ByteString -> E m Entry
mkEntry String
"toc.ncx" ByteString
tocData

  let navXhtmlFormatter :: Int -> [Inline] -> TS.Text -> [Element] -> Element
      navXhtmlFormatter :: Int -> [Inline] -> Text -> [Element] -> Element
navXhtmlFormatter Int
n [Inline]
tit Text
src [Element]
subs = String -> [Element] -> Element
forall t. Node t => String -> t -> Element
unode String
"li" ([Element] -> Element)
-> [(String, String)] -> [Element] -> Element
forall t. (t -> Element) -> [(String, String)] -> t -> Element
!
                                       [(String
"id", String
"toc-li-" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n)] ([Element] -> Element) -> [Element] -> Element
forall a b. (a -> b) -> a -> b
$
                                            (String -> [Content] -> Element
forall t. Node t => String -> t -> Element
unode String
"a" ([Content] -> Element)
-> [(String, String)] -> [Content] -> Element
forall t. (t -> Element) -> [(String, String)] -> t -> Element
!
                                                [(String
"href", String
"text/" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
TS.unpack Text
src)]
                                             ([Content] -> Element) -> [Content] -> Element
forall a b. (a -> b) -> a -> b
$ [Content]
titElements)
                                            Element -> [Element] -> [Element]
forall a. a -> [a] -> [a]
: case [Element]
subs of
                                                 []    -> []
                                                 (Element
_:[Element]
_) -> [String -> [Element] -> Element
forall t. Node t => String -> t -> Element
unode String
"ol" ([Element] -> Element)
-> [(String, String)] -> [Element] -> Element
forall t. (t -> Element) -> [(String, String)] -> t -> Element
! [(String
"class",String
"toc")] ([Element] -> Element) -> [Element] -> Element
forall a b. (a -> b) -> a -> b
$ [Element]
subs]
          where titElements :: [Content]
titElements = Text -> [Content]
forall s. XmlSource s => s -> [Content]
parseXML Text
titRendered
                titRendered :: Text
titRendered = case PandocPure Text -> Either PandocError Text
forall a. PandocPure a -> Either PandocError a
P.runPure
                               (EPUBVersion -> WriterOptions -> Pandoc -> PandocPure Text
forall (m :: * -> *).
PandocMonad m =>
EPUBVersion -> WriterOptions -> Pandoc -> m Text
writeHtmlStringForEPUB EPUBVersion
version
                                 WriterOptions
opts{ writerTemplate :: Maybe (Template Text)
writerTemplate = Maybe (Template Text)
forall a. Maybe a
Nothing
                                     , writerVariables :: Context Text
writerVariables =
                                         Map Text (Val Text) -> Context Text
forall a. Map Text (Val a) -> Context a
Context ([(Text, Val Text)] -> Map Text (Val Text)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
                                           [(Text
"pagetitle", Text -> Val Text
forall a b. ToContext a b => b -> Val a
toVal (Text -> Val Text) -> Text -> Val Text
forall a b. (a -> b) -> a -> b
$
                                             Text -> Text
escapeStringForXML (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ String -> Text
TS.pack String
plainTitle)])
                                       Context Text -> Context Text -> Context Text
forall a. Semigroup a => a -> a -> a
<> WriterOptions -> Context Text
writerVariables WriterOptions
opts}
                                 (Meta -> [Block] -> Pandoc
Pandoc Meta
nullMeta
                                   [[Inline] -> Block
Plain ([Inline] -> Block) -> [Inline] -> Block
forall a b. (a -> b) -> a -> b
$ (Inline -> Inline) -> [Inline] -> [Inline]
forall a b. Walkable a b => (a -> a) -> b -> b
walk Inline -> Inline
clean [Inline]
tit])) of
                                Left PandocError
_  -> [Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify [Inline]
tit
                                Right Text
x -> Text
x
                -- can't have <a> elements inside generated links...
                clean :: Inline -> Inline
clean (Link Attr
_ [Inline]
ils (Text, Text)
_) = Attr -> [Inline] -> Inline
Span (Text
"", [], []) [Inline]
ils
                clean (Note [Block]
_)       = Text -> Inline
Str Text
""
                clean Inline
x              = Inline
x

  let navtag :: String
navtag = if Bool
epub3 then String
"nav" else String
"div"
  [Element]
tocBlocks <- m [Element] -> StateT EPUBState m [Element]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [Element] -> StateT EPUBState m [Element])
-> m [Element] -> StateT EPUBState m [Element]
forall a b. (a -> b) -> a -> b
$ StateT Int m [Element] -> Int -> m [Element]
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT
                 ([[Element]] -> [Element]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Element]] -> [Element])
-> StateT Int m [[Element]] -> StateT Int m [Element]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Block -> StateT Int m [Element])
-> [Block] -> StateT Int m [[Element]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((Int -> [Inline] -> Text -> [Element] -> Element)
-> Block -> StateT Int m [Element]
forall (m :: * -> *).
PandocMonad m =>
(Int -> [Inline] -> Text -> [Element] -> Element)
-> Block -> StateT Int m [Element]
navPointNode Int -> [Inline] -> Text -> [Element] -> Element
navXhtmlFormatter) [Block]
secs) Int
1
  let navBlocks :: [Block]
navBlocks = [Format -> Text -> Block
RawBlock (Text -> Format
Format Text
"html")
                  (Text -> Block) -> Text -> Block
forall a b. (a -> b) -> a -> b
$ String -> Text
TS.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Element -> String
showElement (Element -> String) -> Element -> String
forall a b. (a -> b) -> a -> b
$ -- prettyprinting introduces bad spaces
                   String -> [Element] -> Element
forall t. Node t => String -> t -> Element
unode String
navtag ([Element] -> Element)
-> [(String, String)] -> [Element] -> Element
forall t. (t -> Element) -> [(String, String)] -> t -> Element
! ([(String
"epub:type",String
"toc") | Bool
epub3] [(String, String)] -> [(String, String)] -> [(String, String)]
forall a. [a] -> [a] -> [a]
++
                                   [(String
"id",String
"toc")]) ([Element] -> Element) -> [Element] -> Element
forall a b. (a -> b) -> a -> b
$
                    [ String -> String -> Element
forall t. Node t => String -> t -> Element
unode String
"h1" (String -> Element) -> [(String, String)] -> String -> Element
forall t. (t -> Element) -> [(String, String)] -> t -> Element
! [(String
"id",String
"toc-title")] (String -> Element) -> String -> Element
forall a b. (a -> b) -> a -> b
$ String
tocTitle
                    , String -> [Element] -> Element
forall t. Node t => String -> t -> Element
unode String
"ol" ([Element] -> Element)
-> [(String, String)] -> [Element] -> Element
forall t. (t -> Element) -> [(String, String)] -> t -> Element
! [(String
"class",String
"toc")] ([Element] -> Element) -> [Element] -> Element
forall a b. (a -> b) -> a -> b
$ [Element]
tocBlocks ]]
  let landmarkItems :: [Element]
landmarkItems = if Bool
epub3
                         then String -> [Element] -> Element
forall t. Node t => String -> t -> Element
unode String
"li"
                                [ String -> String -> Element
forall t. Node t => String -> t -> Element
unode String
"a" (String -> Element) -> [(String, String)] -> String -> Element
forall t. (t -> Element) -> [(String, String)] -> t -> Element
! [(String
"href",
                                                  String
"text/title_page.xhtml")
                                               ,(String
"epub:type", String
"titlepage")] (String -> Element) -> String -> Element
forall a b. (a -> b) -> a -> b
$
                                  (String
"Title Page" :: String) ] Element -> [Element] -> [Element]
forall a. a -> [a] -> [a]
:
                              [ String -> [Element] -> Element
forall t. Node t => String -> t -> Element
unode String
"li"
                                [ String -> String -> Element
forall t. Node t => String -> t -> Element
unode String
"a" (String -> Element) -> [(String, String)] -> String -> Element
forall t. (t -> Element) -> [(String, String)] -> t -> Element
! [(String
"href", String
"text/cover.xhtml")
                                              ,(String
"epub:type", String
"cover")] (String -> Element) -> String -> Element
forall a b. (a -> b) -> a -> b
$
                                  (String
"Cover" :: String)] |
                                  Maybe String -> Bool
forall a. Maybe a -> Bool
isJust (EPUBMetadata -> Maybe String
epubCoverImage EPUBMetadata
metadata)
                              ] [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++
                              [ String -> [Element] -> Element
forall t. Node t => String -> t -> Element
unode String
"li"
                                [ String -> String -> Element
forall t. Node t => String -> t -> Element
unode String
"a" (String -> Element) -> [(String, String)] -> String -> Element
forall t. (t -> Element) -> [(String, String)] -> t -> Element
! [(String
"href", String
"#toc")
                                              ,(String
"epub:type", String
"toc")] (String -> Element) -> String -> Element
forall a b. (a -> b) -> a -> b
$
                                    (String
"Table of Contents" :: String)
                                ] | WriterOptions -> Bool
writerTableOfContents WriterOptions
opts
                              ]
                         else []
  let landmarks :: [Block]
landmarks = [Format -> Text -> Block
RawBlock (Text -> Format
Format Text
"html") (Text -> Block) -> Text -> Block
forall a b. (a -> b) -> a -> b
$ String -> Text
TS.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Element -> String
ppElement (Element -> String) -> Element -> String
forall a b. (a -> b) -> a -> b
$
                    String -> [Element] -> Element
forall t. Node t => String -> t -> Element
unode String
"nav" ([Element] -> Element)
-> [(String, String)] -> [Element] -> Element
forall t. (t -> Element) -> [(String, String)] -> t -> Element
! [(String
"epub:type",String
"landmarks")
                                  ,(String
"id",String
"landmarks")
                                  ,(String
"hidden",String
"hidden")] ([Element] -> Element) -> [Element] -> Element
forall a b. (a -> b) -> a -> b
$
                    [ String -> [Element] -> Element
forall t. Node t => String -> t -> Element
unode String
"ol" [Element]
landmarkItems ]
                  | Bool -> Bool
not ([Element] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Element]
landmarkItems)]
  ByteString
navData <- m ByteString -> E m ByteString
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ByteString -> E m ByteString) -> m ByteString -> E m ByteString
forall a b. (a -> b) -> a -> b
$ WriterOptions -> Pandoc -> m ByteString
forall (f :: * -> *).
PandocMonad f =>
WriterOptions -> Pandoc -> f ByteString
writeHtml WriterOptions
opts'{ writerVariables :: Context Text
writerVariables =
                     Map Text (Val Text) -> Context Text
forall a. Map Text (Val a) -> Context a
Context ([(Text, Val Text)] -> Map Text (Val Text)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(Text
"navpage", String -> Val Text
toVal' String
"true")
                                         ,(Text
"body-type",  String -> Val Text
toVal' String
"frontmatter")
                                         ])
                     Context Text -> Context Text -> Context Text
forall a. Semigroup a => a -> a -> a
<> Bool -> Context Text
cssvars Bool
False Context Text -> Context Text -> Context Text
forall a. Semigroup a => a -> a -> a
<> Context Text
vars }
            (Meta -> [Block] -> Pandoc
Pandoc (Text -> Many Inline -> Meta -> Meta
forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
setMeta Text
"title"
                     ((Inline -> Inline) -> Many Inline -> Many Inline
forall a b. Walkable a b => (a -> a) -> b -> b
walk Inline -> Inline
removeNote (Many Inline -> Many Inline) -> Many Inline -> Many Inline
forall a b. (a -> b) -> a -> b
$ [Inline] -> Many Inline
forall a. [a] -> Many a
fromList ([Inline] -> Many Inline) -> [Inline] -> Many Inline
forall a b. (a -> b) -> a -> b
$ Meta -> [Inline]
docTitle' Meta
meta) Meta
nullMeta)
               ([Block]
navBlocks [Block] -> [Block] -> [Block]
forall a. [a] -> [a] -> [a]
++ [Block]
landmarks))
  Entry
navEntry <- String -> ByteString -> StateT EPUBState m Entry
forall (m :: * -> *).
PandocMonad m =>
String -> ByteString -> E m Entry
mkEntry String
"nav.xhtml" ByteString
navData

  -- mimetype
  Entry
mimetypeEntry <- String -> ByteString -> StateT EPUBState m Entry
forall (m :: * -> *).
PandocMonad m =>
String -> ByteString -> E m Entry
mkEntry String
"mimetype" (ByteString -> StateT EPUBState m Entry)
-> ByteString -> StateT EPUBState m Entry
forall a b. (a -> b) -> a -> b
$
                        String -> ByteString
UTF8.fromStringLazy String
"application/epub+zip"

  -- container.xml
  let containerData :: ByteString
containerData = String -> ByteString
UTF8.fromStringLazy (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ Element -> String
ppTopElement (Element -> String) -> Element -> String
forall a b. (a -> b) -> a -> b
$
       String -> Element -> Element
forall t. Node t => String -> t -> Element
unode String
"container" (Element -> Element) -> [(String, String)] -> Element -> Element
forall t. (t -> Element) -> [(String, String)] -> t -> Element
! [(String
"version",String
"1.0")
              ,(String
"xmlns",String
"urn:oasis:names:tc:opendocument:xmlns:container")] (Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$
         String -> Element -> Element
forall t. Node t => String -> t -> Element
unode String
"rootfiles" (Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$
           String -> () -> Element
forall t. Node t => String -> t -> Element
unode String
"rootfile" (() -> Element) -> [(String, String)] -> () -> Element
forall t. (t -> Element) -> [(String, String)] -> t -> Element
! [(String
"full-path",
                    (if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
epubSubdir
                        then String
""
                        else String
epubSubdir String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"/") String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"content.opf")
               ,(String
"media-type",String
"application/oebps-package+xml")] (() -> Element) -> () -> Element
forall a b. (a -> b) -> a -> b
$ ()
  Entry
containerEntry <- String -> ByteString -> StateT EPUBState m Entry
forall (m :: * -> *).
PandocMonad m =>
String -> ByteString -> E m Entry
mkEntry String
"META-INF/container.xml" ByteString
containerData

  -- com.apple.ibooks.display-options.xml
  let apple :: ByteString
apple = String -> ByteString
UTF8.fromStringLazy (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ Element -> String
ppTopElement (Element -> String) -> Element -> String
forall a b. (a -> b) -> a -> b
$
        String -> Element -> Element
forall t. Node t => String -> t -> Element
unode String
"display_options" (Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$
          String -> Element -> Element
forall t. Node t => String -> t -> Element
unode String
"platform" (Element -> Element) -> [(String, String)] -> Element -> Element
forall t. (t -> Element) -> [(String, String)] -> t -> Element
! [(String
"name",String
"*")] (Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$
            String -> String -> Element
forall t. Node t => String -> t -> Element
unode String
"option" (String -> Element) -> [(String, String)] -> String -> Element
forall t. (t -> Element) -> [(String, String)] -> t -> Element
! [(String
"name",String
"specified-fonts")] (String -> Element) -> String -> Element
forall a b. (a -> b) -> a -> b
$ (String
"true" :: String)
  Entry
appleEntry <- String -> ByteString -> StateT EPUBState m Entry
forall (m :: * -> *).
PandocMonad m =>
String -> ByteString -> E m Entry
mkEntry String
"META-INF/com.apple.ibooks.display-options.xml" ByteString
apple

  -- construct archive
  let archive :: Archive
archive = (Entry -> Archive -> Archive) -> Archive -> [Entry] -> Archive
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Entry -> Archive -> Archive
addEntryToArchive Archive
emptyArchive ([Entry] -> Archive) -> [Entry] -> Archive
forall a b. (a -> b) -> a -> b
$
                 [Entry
mimetypeEntry, Entry
containerEntry, Entry
appleEntry,
                  Entry
contentsEntry, Entry
tocEntry, Entry
navEntry, Entry
tpEntry] [Entry] -> [Entry] -> [Entry]
forall a. [a] -> [a] -> [a]
++
                  [Entry]
stylesheetEntries [Entry] -> [Entry] -> [Entry]
forall a. [a] -> [a] -> [a]
++ [Entry]
picEntries [Entry] -> [Entry] -> [Entry]
forall a. [a] -> [a] -> [a]
++ [Entry]
cpicEntry [Entry] -> [Entry] -> [Entry]
forall a. [a] -> [a] -> [a]
++
                  [Entry]
cpgEntry [Entry] -> [Entry] -> [Entry]
forall a. [a] -> [a] -> [a]
++ [Entry]
chapterEntries [Entry] -> [Entry] -> [Entry]
forall a. [a] -> [a] -> [a]
++ [Entry]
fontEntries
  ByteString -> E m ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> E m ByteString) -> ByteString -> E m ByteString
forall a b. (a -> b) -> a -> b
$ Archive -> ByteString
fromArchive Archive
archive

metadataElement :: EPUBVersion -> EPUBMetadata -> UTCTime -> Element
metadataElement :: EPUBVersion -> EPUBMetadata -> UTCTime -> Element
metadataElement EPUBVersion
version EPUBMetadata
md UTCTime
currentTime =
  String -> [Element] -> Element
forall t. Node t => String -> t -> Element
unode String
"metadata" ([Element] -> Element)
-> [(String, String)] -> [Element] -> Element
forall t. (t -> Element) -> [(String, String)] -> t -> Element
! [(String
"xmlns:dc",String
"http://purl.org/dc/elements/1.1/")
                     ,(String
"xmlns:opf",String
"http://www.idpf.org/2007/opf")] ([Element] -> Element) -> [Element] -> Element
forall a b. (a -> b) -> a -> b
$ [Element]
mdNodes
  where mdNodes :: [Element]
mdNodes = [Element]
identifierNodes [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++ [Element]
titleNodes [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++ [Element]
dateNodes
                  [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++ [Element]
languageNodes [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++ [Element]
ibooksNodes [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++ [Element]
calibreNodes
                  [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++ [Element]
creatorNodes [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++ [Element]
contributorNodes [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++ [Element]
subjectNodes
                  [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++ [Element]
descriptionNodes [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++ [Element]
typeNodes [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++ [Element]
formatNodes
                  [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++ [Element]
publisherNodes [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++ [Element]
sourceNodes [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++ [Element]
relationNodes
                  [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++ [Element]
coverageNodes [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++ [Element]
rightsNodes [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++ [Element]
coverImageNodes
                  [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++ [Element]
modifiedNodes
        withIds :: String -> (String -> b -> [a]) -> [b] -> [a]
withIds String
base String -> b -> [a]
f = [[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[a]] -> [a]) -> ([b] -> [[a]]) -> [b] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> b -> [a]) -> [String] -> [b] -> [[a]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith String -> b -> [a]
f ((Int -> String) -> [Int] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
x -> String
base String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Char
'-' Char -> ShowS
forall a. a -> [a] -> [a]
: Int -> String
forall a. Show a => a -> String
show Int
x))
                         ([Int
1..] :: [Int]))
        identifierNodes :: [Element]
identifierNodes = String
-> (String -> Identifier -> [Element]) -> [Identifier] -> [Element]
forall b a. String -> (String -> b -> [a]) -> [b] -> [a]
withIds String
"epub-id" String -> Identifier -> [Element]
toIdentifierNode ([Identifier] -> [Element]) -> [Identifier] -> [Element]
forall a b. (a -> b) -> a -> b
$
                          EPUBMetadata -> [Identifier]
epubIdentifier EPUBMetadata
md
        titleNodes :: [Element]
titleNodes = String -> (String -> Title -> [Element]) -> [Title] -> [Element]
forall b a. String -> (String -> b -> [a]) -> [b] -> [a]
withIds String
"epub-title" String -> Title -> [Element]
toTitleNode ([Title] -> [Element]) -> [Title] -> [Element]
forall a b. (a -> b) -> a -> b
$ EPUBMetadata -> [Title]
epubTitle EPUBMetadata
md
        dateNodes :: [Element]
dateNodes = if EPUBVersion
version EPUBVersion -> EPUBVersion -> Bool
forall a. Eq a => a -> a -> Bool
== EPUBVersion
EPUB2
                       then String -> (String -> Date -> [Element]) -> [Date] -> [Element]
forall b a. String -> (String -> b -> [a]) -> [b] -> [a]
withIds String
"epub-date" String -> Date -> [Element]
toDateNode ([Date] -> [Element]) -> [Date] -> [Element]
forall a b. (a -> b) -> a -> b
$ EPUBMetadata -> [Date]
epubDate EPUBMetadata
md
                       else -- epub3 allows only one dc:date
                            -- http://www.idpf.org/epub/30/spec/epub30-publications.html#sec-opf-dcdate
                            case EPUBMetadata -> [Date]
epubDate EPUBMetadata
md of
                                 [] -> []
                                 (Date
x:[Date]
_) -> [String -> String -> Element
forall t. Node t => String -> t -> Element
dcNode String
"date" (String -> Element) -> [(String, String)] -> String -> Element
forall t. (t -> Element) -> [(String, String)] -> t -> Element
! [(String
"id",String
"epub-date")]
                                            (String -> Element) -> String -> Element
forall a b. (a -> b) -> a -> b
$ Date -> String
dateText Date
x]
        ibooksNodes :: [Element]
ibooksNodes = ((String, String) -> Element) -> [(String, String)] -> [Element]
forall a b. (a -> b) -> [a] -> [b]
map (String, String) -> Element
forall t. Node t => (String, t) -> Element
ibooksNode (EPUBMetadata -> [(String, String)]
epubIbooksFields EPUBMetadata
md)
        ibooksNode :: (String, t) -> Element
ibooksNode (String
k, t
v) = String -> t -> Element
forall t. Node t => String -> t -> Element
unode String
"meta" (t -> Element) -> [(String, String)] -> t -> Element
forall t. (t -> Element) -> [(String, String)] -> t -> Element
! [(String
"property", String
"ibooks:" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
k)] (t -> Element) -> t -> Element
forall a b. (a -> b) -> a -> b
$ t
v
        calibreNodes :: [Element]
calibreNodes = ((String, String) -> Element) -> [(String, String)] -> [Element]
forall a b. (a -> b) -> [a] -> [b]
map (String, String) -> Element
calibreNode (EPUBMetadata -> [(String, String)]
epubCalibreFields EPUBMetadata
md)
        calibreNode :: (String, String) -> Element
calibreNode (String
k, String
v) = String -> () -> Element
forall t. Node t => String -> t -> Element
unode String
"meta" (() -> Element) -> [(String, String)] -> () -> Element
forall t. (t -> Element) -> [(String, String)] -> t -> Element
! [(String
"name", String
"calibre:" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
k),
                                             (String
"content", String
v)] (() -> Element) -> () -> Element
forall a b. (a -> b) -> a -> b
$ ()
        languageNodes :: [Element]
languageNodes = [String -> String -> Element
forall t. Node t => String -> t -> Element
dcTag String
"language" (String -> Element) -> String -> Element
forall a b. (a -> b) -> a -> b
$ EPUBMetadata -> String
epubLanguage EPUBMetadata
md]
        creatorNodes :: [Element]
creatorNodes = String
-> (String -> Creator -> [Element]) -> [Creator] -> [Element]
forall b a. String -> (String -> b -> [a]) -> [b] -> [a]
withIds String
"epub-creator" (String -> String -> Creator -> [Element]
toCreatorNode String
"creator") ([Creator] -> [Element]) -> [Creator] -> [Element]
forall a b. (a -> b) -> a -> b
$
                       EPUBMetadata -> [Creator]
epubCreator EPUBMetadata
md
        contributorNodes :: [Element]
contributorNodes = String
-> (String -> Creator -> [Element]) -> [Creator] -> [Element]
forall b a. String -> (String -> b -> [a]) -> [b] -> [a]
withIds String
"epub-contributor"
                           (String -> String -> Creator -> [Element]
toCreatorNode String
"contributor") ([Creator] -> [Element]) -> [Creator] -> [Element]
forall a b. (a -> b) -> a -> b
$ EPUBMetadata -> [Creator]
epubContributor EPUBMetadata
md
        subjectNodes :: [Element]
subjectNodes = (String -> Element) -> [String] -> [Element]
forall a b. (a -> b) -> [a] -> [b]
map (String -> String -> Element
forall t. Node t => String -> t -> Element
dcTag String
"subject") ([String] -> [Element]) -> [String] -> [Element]
forall a b. (a -> b) -> a -> b
$ EPUBMetadata -> [String]
epubSubject EPUBMetadata
md
        descriptionNodes :: [Element]
descriptionNodes = [Element] -> (String -> [Element]) -> Maybe String -> [Element]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (String -> String -> [Element]
forall t. Node t => String -> t -> [Element]
dcTag' String
"description") (Maybe String -> [Element]) -> Maybe String -> [Element]
forall a b. (a -> b) -> a -> b
$ EPUBMetadata -> Maybe String
epubDescription EPUBMetadata
md
        typeNodes :: [Element]
typeNodes = [Element] -> (String -> [Element]) -> Maybe String -> [Element]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (String -> String -> [Element]
forall t. Node t => String -> t -> [Element]
dcTag' String
"type") (Maybe String -> [Element]) -> Maybe String -> [Element]
forall a b. (a -> b) -> a -> b
$ EPUBMetadata -> Maybe String
epubType EPUBMetadata
md
        formatNodes :: [Element]
formatNodes = [Element] -> (String -> [Element]) -> Maybe String -> [Element]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (String -> String -> [Element]
forall t. Node t => String -> t -> [Element]
dcTag' String
"format") (Maybe String -> [Element]) -> Maybe String -> [Element]
forall a b. (a -> b) -> a -> b
$ EPUBMetadata -> Maybe String
epubFormat EPUBMetadata
md
        publisherNodes :: [Element]
publisherNodes = [Element] -> (String -> [Element]) -> Maybe String -> [Element]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (String -> String -> [Element]
forall t. Node t => String -> t -> [Element]
dcTag' String
"publisher") (Maybe String -> [Element]) -> Maybe String -> [Element]
forall a b. (a -> b) -> a -> b
$ EPUBMetadata -> Maybe String
epubPublisher EPUBMetadata
md
        sourceNodes :: [Element]
sourceNodes = [Element] -> (String -> [Element]) -> Maybe String -> [Element]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (String -> String -> [Element]
forall t. Node t => String -> t -> [Element]
dcTag' String
"source") (Maybe String -> [Element]) -> Maybe String -> [Element]
forall a b. (a -> b) -> a -> b
$ EPUBMetadata -> Maybe String
epubSource EPUBMetadata
md
        relationNodes :: [Element]
relationNodes = [Element] -> (String -> [Element]) -> Maybe String -> [Element]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (String -> String -> [Element]
forall t. Node t => String -> t -> [Element]
dcTag' String
"relation") (Maybe String -> [Element]) -> Maybe String -> [Element]
forall a b. (a -> b) -> a -> b
$ EPUBMetadata -> Maybe String
epubRelation EPUBMetadata
md
        coverageNodes :: [Element]
coverageNodes = [Element] -> (String -> [Element]) -> Maybe String -> [Element]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (String -> String -> [Element]
forall t. Node t => String -> t -> [Element]
dcTag' String
"coverage") (Maybe String -> [Element]) -> Maybe String -> [Element]
forall a b. (a -> b) -> a -> b
$ EPUBMetadata -> Maybe String
epubCoverage EPUBMetadata
md
        rightsNodes :: [Element]
rightsNodes = [Element] -> (String -> [Element]) -> Maybe String -> [Element]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (String -> String -> [Element]
forall t. Node t => String -> t -> [Element]
dcTag' String
"rights") (Maybe String -> [Element]) -> Maybe String -> [Element]
forall a b. (a -> b) -> a -> b
$ EPUBMetadata -> Maybe String
epubRights EPUBMetadata
md
        coverImageNodes :: [Element]
coverImageNodes = [Element] -> (String -> [Element]) -> Maybe String -> [Element]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe []
            (\String
img -> [String -> () -> Element
forall t. Node t => String -> t -> Element
unode String
"meta" (() -> Element) -> [(String, String)] -> () -> Element
forall t. (t -> Element) -> [(String, String)] -> t -> Element
!  [(String
"name",String
"cover"),
                                       (String
"content",ShowS
toId String
img)] (() -> Element) -> () -> Element
forall a b. (a -> b) -> a -> b
$ ()])
            (Maybe String -> [Element]) -> Maybe String -> [Element]
forall a b. (a -> b) -> a -> b
$ EPUBMetadata -> Maybe String
epubCoverImage EPUBMetadata
md
        modifiedNodes :: [Element]
modifiedNodes = [ String -> String -> Element
forall t. Node t => String -> t -> Element
unode String
"meta" (String -> Element) -> [(String, String)] -> String -> Element
forall t. (t -> Element) -> [(String, String)] -> t -> Element
! [(String
"property", String
"dcterms:modified")] (String -> Element) -> String -> Element
forall a b. (a -> b) -> a -> b
$
               UTCTime -> String
showDateTimeISO8601 UTCTime
currentTime | EPUBVersion
version EPUBVersion -> EPUBVersion -> Bool
forall a. Eq a => a -> a -> Bool
== EPUBVersion
EPUB3 ]
        dcTag :: String -> t -> Element
dcTag String
n t
s = String -> t -> Element
forall t. Node t => String -> t -> Element
unode (String
"dc:" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
n) t
s
        dcTag' :: String -> t -> [Element]
dcTag' String
n t
s = [String -> t -> Element
forall t. Node t => String -> t -> Element
dcTag String
n t
s]
        toIdentifierNode :: String -> Identifier -> [Element]
toIdentifierNode String
id' (Identifier String
txt Maybe String
scheme)
          | EPUBVersion
version EPUBVersion -> EPUBVersion -> Bool
forall a. Eq a => a -> a -> Bool
== EPUBVersion
EPUB2 = [String -> String -> Element
forall t. Node t => String -> t -> Element
dcNode String
"identifier" (String -> Element) -> [(String, String)] -> String -> Element
forall t. (t -> Element) -> [(String, String)] -> t -> Element
!
              ((String
"id",String
id') (String, String) -> [(String, String)] -> [(String, String)]
forall a. a -> [a] -> [a]
: [(String, String)]
-> (String -> [(String, String)])
-> Maybe String
-> [(String, String)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\String
x -> [(String
"opf:scheme", String
x)]) Maybe String
scheme) (String -> Element) -> String -> Element
forall a b. (a -> b) -> a -> b
$
              String
txt]
          | Bool
otherwise = (String -> String -> Element
forall t. Node t => String -> t -> Element
dcNode String
"identifier" (String -> Element) -> [(String, String)] -> String -> Element
forall t. (t -> Element) -> [(String, String)] -> t -> Element
! [(String
"id",String
id')] (String -> Element) -> String -> Element
forall a b. (a -> b) -> a -> b
$ String
txt) Element -> [Element] -> [Element]
forall a. a -> [a] -> [a]
:
              [Element] -> (String -> [Element]) -> Maybe String -> [Element]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ((\String
x -> [String -> String -> Element
forall t. Node t => String -> t -> Element
unode String
"meta" (String -> Element) -> [(String, String)] -> String -> Element
forall t. (t -> Element) -> [(String, String)] -> t -> Element
!
                                [ (String
"refines",Char
'#'Char -> ShowS
forall a. a -> [a] -> [a]
:String
id')
                                , (String
"property",String
"identifier-type")
                                , (String
"scheme",String
"onix:codelist5")
                                ]
                                (String -> Element) -> String -> Element
forall a b. (a -> b) -> a -> b
$ String
x
                               ])
                        (String -> [Element]) -> ShowS -> String -> [Element]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
schemeToOnix)
                    Maybe String
scheme
        toCreatorNode :: String -> String -> Creator -> [Element]
toCreatorNode String
s String
id' Creator
creator
          | EPUBVersion
version EPUBVersion -> EPUBVersion -> Bool
forall a. Eq a => a -> a -> Bool
== EPUBVersion
EPUB2 = [String -> String -> Element
forall t. Node t => String -> t -> Element
dcNode String
s (String -> Element) -> [(String, String)] -> String -> Element
forall t. (t -> Element) -> [(String, String)] -> t -> Element
!
             ((String
"id",String
id') (String, String) -> [(String, String)] -> [(String, String)]
forall a. a -> [a] -> [a]
:
              [(String, String)]
-> (String -> [(String, String)])
-> Maybe String
-> [(String, String)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\String
x -> [(String
"opf:file-as",String
x)]) (Creator -> Maybe String
creatorFileAs Creator
creator) [(String, String)] -> [(String, String)] -> [(String, String)]
forall a. [a] -> [a] -> [a]
++
              [(String, String)]
-> (String -> [(String, String)])
-> Maybe String
-> [(String, String)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\String
x -> [(String
"opf:role",String
x)])
               (Creator -> Maybe String
creatorRole Creator
creator Maybe String -> (String -> Maybe String) -> Maybe String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Maybe String
toRelator)) (String -> Element) -> String -> Element
forall a b. (a -> b) -> a -> b
$ Creator -> String
creatorText Creator
creator]
          | Bool
otherwise = [String -> String -> Element
forall t. Node t => String -> t -> Element
dcNode String
s (String -> Element) -> [(String, String)] -> String -> Element
forall t. (t -> Element) -> [(String, String)] -> t -> Element
! [(String
"id",String
id')] (String -> Element) -> String -> Element
forall a b. (a -> b) -> a -> b
$ Creator -> String
creatorText Creator
creator] [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++
              [Element] -> (String -> [Element]) -> Maybe String -> [Element]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\String
x -> [String -> String -> Element
forall t. Node t => String -> t -> Element
unode String
"meta" (String -> Element) -> [(String, String)] -> String -> Element
forall t. (t -> Element) -> [(String, String)] -> t -> Element
!
                   [(String
"refines",Char
'#'Char -> ShowS
forall a. a -> [a] -> [a]
:String
id'),(String
"property",String
"file-as")] (String -> Element) -> String -> Element
forall a b. (a -> b) -> a -> b
$ String
x])
                   (Creator -> Maybe String
creatorFileAs Creator
creator) [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++
              [Element] -> (String -> [Element]) -> Maybe String -> [Element]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\String
x -> [String -> String -> Element
forall t. Node t => String -> t -> Element
unode String
"meta" (String -> Element) -> [(String, String)] -> String -> Element
forall t. (t -> Element) -> [(String, String)] -> t -> Element
!
                   [(String
"refines",Char
'#'Char -> ShowS
forall a. a -> [a] -> [a]
:String
id'),(String
"property",String
"role"),
                     (String
"scheme",String
"marc:relators")] (String -> Element) -> String -> Element
forall a b. (a -> b) -> a -> b
$ String
x])
                   (Creator -> Maybe String
creatorRole Creator
creator Maybe String -> (String -> Maybe String) -> Maybe String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Maybe String
toRelator)
        toTitleNode :: String -> Title -> [Element]
toTitleNode String
id' Title
title
          | EPUBVersion
version EPUBVersion -> EPUBVersion -> Bool
forall a. Eq a => a -> a -> Bool
== EPUBVersion
EPUB2 = [String -> String -> Element
forall t. Node t => String -> t -> Element
dcNode String
"title" (String -> Element) -> [(String, String)] -> String -> Element
forall t. (t -> Element) -> [(String, String)] -> t -> Element
!
             ((String
"id",String
id') (String, String) -> [(String, String)] -> [(String, String)]
forall a. a -> [a] -> [a]
:
              -- note: EPUB2 doesn't accept opf:title-type
              [(String, String)]
-> (String -> [(String, String)])
-> Maybe String
-> [(String, String)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\String
x -> [(String
"opf:file-as",String
x)]) (Title -> Maybe String
titleFileAs Title
title)) (String -> Element) -> String -> Element
forall a b. (a -> b) -> a -> b
$
              Title -> String
titleText Title
title]
          | Bool
otherwise = [String -> String -> Element
forall t. Node t => String -> t -> Element
dcNode String
"title" (String -> Element) -> [(String, String)] -> String -> Element
forall t. (t -> Element) -> [(String, String)] -> t -> Element
! [(String
"id",String
id')] (String -> Element) -> String -> Element
forall a b. (a -> b) -> a -> b
$ Title -> String
titleText Title
title]
              [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++
              [Element] -> (String -> [Element]) -> Maybe String -> [Element]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\String
x -> [String -> String -> Element
forall t. Node t => String -> t -> Element
unode String
"meta" (String -> Element) -> [(String, String)] -> String -> Element
forall t. (t -> Element) -> [(String, String)] -> t -> Element
!
                   [(String
"refines",Char
'#'Char -> ShowS
forall a. a -> [a] -> [a]
:String
id'),(String
"property",String
"file-as")] (String -> Element) -> String -> Element
forall a b. (a -> b) -> a -> b
$ String
x])
                   (Title -> Maybe String
titleFileAs Title
title) [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++
              [Element] -> (String -> [Element]) -> Maybe String -> [Element]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\String
x -> [String -> String -> Element
forall t. Node t => String -> t -> Element
unode String
"meta" (String -> Element) -> [(String, String)] -> String -> Element
forall t. (t -> Element) -> [(String, String)] -> t -> Element
!
                   [(String
"refines",Char
'#'Char -> ShowS
forall a. a -> [a] -> [a]
:String
id'),(String
"property",String
"title-type")] (String -> Element) -> String -> Element
forall a b. (a -> b) -> a -> b
$ String
x])
                   (Title -> Maybe String
titleType Title
title)
        toDateNode :: String -> Date -> [Element]
toDateNode String
id' Date
date = [String -> String -> Element
forall t. Node t => String -> t -> Element
dcNode String
"date" (String -> Element) -> [(String, String)] -> String -> Element
forall t. (t -> Element) -> [(String, String)] -> t -> Element
!
             ((String
"id",String
id') (String, String) -> [(String, String)] -> [(String, String)]
forall a. a -> [a] -> [a]
:
                [(String, String)]
-> (String -> [(String, String)])
-> Maybe String
-> [(String, String)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\String
x -> [(String
"opf:event",String
x)]) (Date -> Maybe String
dateEvent Date
date)) (String -> Element) -> String -> Element
forall a b. (a -> b) -> a -> b
$
                 Date -> String
dateText Date
date]
        schemeToOnix :: String -> String
        schemeToOnix :: ShowS
schemeToOnix String
"ISBN-10"              = String
"02"
        schemeToOnix String
"GTIN-13"              = String
"03"
        schemeToOnix String
"UPC"                  = String
"04"
        schemeToOnix String
"ISMN-10"              = String
"05"
        schemeToOnix String
"DOI"                  = String
"06"
        schemeToOnix String
"LCCN"                 = String
"13"
        schemeToOnix String
"GTIN-14"              = String
"14"
        schemeToOnix String
"ISBN-13"              = String
"15"
        schemeToOnix String
"Legal deposit number" = String
"17"
        schemeToOnix String
"URN"                  = String
"22"
        schemeToOnix String
"OCLC"                 = String
"23"
        schemeToOnix String
"ISMN-13"              = String
"25"
        schemeToOnix String
"ISBN-A"               = String
"26"
        schemeToOnix String
"JP"                   = String
"27"
        schemeToOnix String
"OLCC"                 = String
"28"
        schemeToOnix String
_                      = String
"01"

showDateTimeISO8601 :: UTCTime -> String
showDateTimeISO8601 :: UTCTime -> String
showDateTimeISO8601 = TimeLocale -> String -> UTCTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%FT%TZ"

transformTag :: PandocMonad m
             => Tag TS.Text
             -> E m (Tag TS.Text)
transformTag :: Tag Text -> E m (Tag Text)
transformTag tag :: Tag Text
tag@(TagOpen Text
name [(Text, Text)]
attr)
  | Text
name Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"video", Text
"source", Text
"img", Text
"audio"] Bool -> Bool -> Bool
&&
    Maybe Text -> Bool
forall a. Maybe a -> Bool
isNothing (Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"data-external" [(Text, Text)]
attr) = do
  let src :: Text
src = Text -> Tag Text -> Text
forall str.
(Show str, Eq str, StringLike str) =>
str -> Tag str -> str
fromAttrib Text
"src" Tag Text
tag
  let poster :: Text
poster = Text -> Tag Text -> Text
forall str.
(Show str, Eq str, StringLike str) =>
str -> Tag str -> str
fromAttrib Text
"poster" Tag Text
tag
  Text
newsrc <- String -> E m Text
forall (m :: * -> *). PandocMonad m => String -> E m Text
modifyMediaRef (String -> E m Text) -> String -> E m Text
forall a b. (a -> b) -> a -> b
$ Text -> String
TS.unpack Text
src
  Text
newposter <- String -> E m Text
forall (m :: * -> *). PandocMonad m => String -> E m Text
modifyMediaRef (String -> E m Text) -> String -> E m Text
forall a b. (a -> b) -> a -> b
$ Text -> String
TS.unpack Text
poster
  let attr' :: [(Text, Text)]
attr' = ((Text, Text) -> Bool) -> [(Text, Text)] -> [(Text, Text)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Text
x,Text
_) -> Text
x Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"src" Bool -> Bool -> Bool
&& Text
x Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"poster") [(Text, Text)]
attr [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++
              [(Text
"src", Text
"../" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
newsrc) | Bool -> Bool
not (Text -> Bool
TS.null Text
newsrc)] [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++
              [(Text
"poster", Text
"../" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
newposter) | Bool -> Bool
not (Text -> Bool
TS.null Text
newposter)]
  Tag Text -> E m (Tag Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Tag Text -> E m (Tag Text)) -> Tag Text -> E m (Tag Text)
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)] -> Tag Text
forall str. str -> [Attribute str] -> Tag str
TagOpen Text
name [(Text, Text)]
attr'
transformTag Tag Text
tag = Tag Text -> E m (Tag Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Tag Text
tag

modifyMediaRef :: PandocMonad m
               => FilePath
               -> E m TS.Text
modifyMediaRef :: String -> E m Text
modifyMediaRef String
"" = Text -> E m Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
""
modifyMediaRef String
oldsrc = do
  [(String, (String, Maybe Entry))]
media <- (EPUBState -> [(String, (String, Maybe Entry))])
-> StateT EPUBState m [(String, (String, Maybe Entry))]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets EPUBState -> [(String, (String, Maybe Entry))]
stMediaPaths
  case String
-> [(String, (String, Maybe Entry))] -> Maybe (String, Maybe Entry)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
oldsrc [(String, (String, Maybe Entry))]
media of
         Just (String
n,Maybe Entry
_) -> Text -> E m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> E m Text) -> Text -> E m Text
forall a b. (a -> b) -> a -> b
$ String -> Text
TS.pack String
n
         Maybe (String, Maybe Entry)
Nothing    -> E m Text -> (PandocError -> E m Text) -> E m Text
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError
           (do (ByteString
img, Maybe Text
mbMime) <- Text -> StateT EPUBState m (ByteString, Maybe Text)
forall (m :: * -> *).
PandocMonad m =>
Text -> m (ByteString, Maybe Text)
P.fetchItem (Text -> StateT EPUBState m (ByteString, Maybe Text))
-> Text -> StateT EPUBState m (ByteString, Maybe Text)
forall a b. (a -> b) -> a -> b
$ String -> Text
TS.pack String
oldsrc
               let ext :: String
ext = String -> (Text -> String) -> Maybe Text -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ShowS
takeExtension ((Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'?') String
oldsrc)) Text -> String
TS.unpack
                         ((Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> Maybe Text -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Maybe Text
mbMime Maybe Text -> (Text -> Maybe Text) -> Maybe Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe Text
extensionFromMimeType))
               String
newName <- String -> E m String
forall (m :: * -> *). PandocMonad m => String -> E m String
getMediaNextNewName String
ext
               let newPath :: String
newPath = String
"media/" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
newName
               Entry
entry <- String -> ByteString -> E m Entry
forall (m :: * -> *).
PandocMonad m =>
String -> ByteString -> E m Entry
mkEntry String
newPath ([ByteString] -> ByteString
B.fromChunks ([ByteString] -> ByteString)
-> (ByteString -> [ByteString]) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:[]) (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString
img)
               (EPUBState -> EPUBState) -> StateT EPUBState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((EPUBState -> EPUBState) -> StateT EPUBState m ())
-> (EPUBState -> EPUBState) -> StateT EPUBState m ()
forall a b. (a -> b) -> a -> b
$ \EPUBState
st -> EPUBState
st{ stMediaPaths :: [(String, (String, Maybe Entry))]
stMediaPaths =
                            (String
oldsrc, (String
newPath, Entry -> Maybe Entry
forall a. a -> Maybe a
Just Entry
entry))(String, (String, Maybe Entry))
-> [(String, (String, Maybe Entry))]
-> [(String, (String, Maybe Entry))]
forall a. a -> [a] -> [a]
:[(String, (String, Maybe Entry))]
media}
               Text -> E m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> E m Text) -> Text -> E m Text
forall a b. (a -> b) -> a -> b
$ String -> Text
TS.pack String
newPath)
           (\PandocError
e -> do
                LogMessage -> StateT EPUBState m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> StateT EPUBState m ())
-> LogMessage -> StateT EPUBState m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> LogMessage
CouldNotFetchResource (String -> Text
TS.pack String
oldsrc) (PandocError -> Text
forall a. Show a => a -> Text
tshow PandocError
e)
                Text -> E m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> E m Text) -> Text -> E m Text
forall a b. (a -> b) -> a -> b
$ String -> Text
TS.pack String
oldsrc)

getMediaNextNewName :: PandocMonad m => String -> E m String
getMediaNextNewName :: String -> E m String
getMediaNextNewName String
ext = do
  Int
nextId <- (EPUBState -> Int) -> StateT EPUBState m Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets EPUBState -> Int
stMediaNextId
  (EPUBState -> EPUBState) -> StateT EPUBState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((EPUBState -> EPUBState) -> StateT EPUBState m ())
-> (EPUBState -> EPUBState) -> StateT EPUBState m ()
forall a b. (a -> b) -> a -> b
$ \EPUBState
st -> EPUBState
st { stMediaNextId :: Int
stMediaNextId = Int
nextId Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 }
  let nextName :: String
nextName = String
"file" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
nextId String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
ext
  (Text -> StateT EPUBState m (ByteString, Maybe Text)
forall (m :: * -> *).
PandocMonad m =>
Text -> m (ByteString, Maybe Text)
P.fetchItem (String -> Text
TS.pack String
nextName) StateT EPUBState m (ByteString, Maybe Text)
-> E m String -> E m String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> E m String
forall (m :: * -> *). PandocMonad m => String -> E m String
getMediaNextNewName String
ext) E m String -> (PandocError -> E m String) -> E m String
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` E m String -> PandocError -> E m String
forall a b. a -> b -> a
const (String -> E m String
forall (m :: * -> *) a. Monad m => a -> m a
return String
nextName)

transformBlock  :: PandocMonad m
                => Block
                -> E m Block
transformBlock :: Block -> E m Block
transformBlock (RawBlock Format
fmt Text
raw)
  | Format
fmt Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Format
Format Text
"html" = do
  let tags :: [Tag Text]
tags = Text -> [Tag Text]
forall str. StringLike str => str -> [Tag str]
parseTags Text
raw
  [Tag Text]
tags' <- (Tag Text -> StateT EPUBState m (Tag Text))
-> [Tag Text] -> StateT EPUBState m [Tag Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Tag Text -> StateT EPUBState m (Tag Text)
forall (m :: * -> *). PandocMonad m => Tag Text -> E m (Tag Text)
transformTag [Tag Text]
tags
  Block -> E m Block
forall (m :: * -> *) a. Monad m => a -> m a
return (Block -> E m Block) -> Block -> E m Block
forall a b. (a -> b) -> a -> b
$ Format -> Text -> Block
RawBlock Format
fmt ([Tag Text] -> Text
renderTags' [Tag Text]
tags')
transformBlock Block
b = Block -> E m Block
forall (m :: * -> *) a. Monad m => a -> m a
return Block
b

transformInline  :: PandocMonad m
                 => WriterOptions
                 -> Inline
                 -> E m Inline
transformInline :: WriterOptions -> Inline -> E m Inline
transformInline WriterOptions
_opts (Image Attr
attr [Inline]
lab (Text
src,Text
tit)) = do
    Text
newsrc <- String -> E m Text
forall (m :: * -> *). PandocMonad m => String -> E m Text
modifyMediaRef (String -> E m Text) -> String -> E m Text
forall a b. (a -> b) -> a -> b
$ Text -> String
TS.unpack Text
src
    Inline -> E m Inline
forall (m :: * -> *) a. Monad m => a -> m a
return (Inline -> E m Inline) -> Inline -> E m Inline
forall a b. (a -> b) -> a -> b
$ Attr -> [Inline] -> (Text, Text) -> Inline
Image Attr
attr [Inline]
lab (Text
"../" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
newsrc, Text
tit)
transformInline WriterOptions
opts x :: Inline
x@(Math MathType
t Text
m)
  | WebTeX Text
url <- WriterOptions -> HTMLMathMethod
writerHTMLMathMethod WriterOptions
opts = do
    Text
newsrc <- String -> E m Text
forall (m :: * -> *). PandocMonad m => String -> E m Text
modifyMediaRef (Text -> String
TS.unpack Text
url String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
urlEncode (Text -> String
TS.unpack Text
m))
    let mathclass :: Text
mathclass = if MathType
t MathType -> MathType -> Bool
forall a. Eq a => a -> a -> Bool
== MathType
DisplayMath then Text
"display" else Text
"inline"
    Inline -> E m Inline
forall (m :: * -> *) a. Monad m => a -> m a
return (Inline -> E m Inline) -> Inline -> E m Inline
forall a b. (a -> b) -> a -> b
$ Attr -> [Inline] -> Inline
Span (Text
"",[Text
"math",Text
mathclass],[])
                [Attr -> [Inline] -> (Text, Text) -> Inline
Image Attr
nullAttr [Inline
x] (Text
"../" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
newsrc, Text
"")]
transformInline WriterOptions
_opts (RawInline Format
fmt Text
raw)
  | Format
fmt Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Format
Format Text
"html" = do
  let tags :: [Tag Text]
tags = Text -> [Tag Text]
forall str. StringLike str => str -> [Tag str]
parseTags Text
raw
  [Tag Text]
tags' <- (Tag Text -> StateT EPUBState m (Tag Text))
-> [Tag Text] -> StateT EPUBState m [Tag Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Tag Text -> StateT EPUBState m (Tag Text)
forall (m :: * -> *). PandocMonad m => Tag Text -> E m (Tag Text)
transformTag [Tag Text]
tags
  Inline -> E m Inline
forall (m :: * -> *) a. Monad m => a -> m a
return (Inline -> E m Inline) -> Inline -> E m Inline
forall a b. (a -> b) -> a -> b
$ Format -> Text -> Inline
RawInline Format
fmt ([Tag Text] -> Text
renderTags' [Tag Text]
tags')
transformInline WriterOptions
_ Inline
x = Inline -> E m Inline
forall (m :: * -> *) a. Monad m => a -> m a
return Inline
x

(!) :: (t -> Element) -> [(String, String)] -> t -> Element
(!) t -> Element
f [(String, String)]
attrs t
n = [Attr] -> Element -> Element
add_attrs (((String, String) -> Attr) -> [(String, String)] -> [Attr]
forall a b. (a -> b) -> [a] -> [b]
map (\(String
k,String
v) -> QName -> String -> Attr
Attr (String -> QName
unqual String
k) String
v) [(String, String)]
attrs) (t -> Element
f t
n)

-- | Version of 'ppTopElement' that specifies UTF-8 encoding.
ppTopElement :: Element -> String
ppTopElement :: Element -> String
ppTopElement = (String
"<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> (Element -> String) -> Element -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
unEntity ShowS -> (Element -> String) -> Element -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> String
ppElement
  -- unEntity removes numeric  entities introduced by ppElement
  -- (kindlegen seems to choke on these).
  where unEntity :: ShowS
unEntity [] = String
""
        unEntity (Char
'&':Char
'#':String
xs) =
                   let (String
ds,String
ys) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
';') String
xs
                       rest :: String
rest = Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
1 String
ys
                   in  case Text -> Maybe Char
forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead (String -> Text
TS.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"'\\" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
ds String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"'") of
                          Just Char
x  -> Char
x Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
unEntity String
rest
                          Maybe Char
Nothing -> Char
'&'Char -> ShowS
forall a. a -> [a] -> [a]
:Char
'#'Char -> ShowS
forall a. a -> [a] -> [a]
:ShowS
unEntity String
xs
        unEntity (Char
x:String
xs) = Char
x Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
unEntity String
xs

mediaTypeOf :: FilePath -> Maybe MimeType
mediaTypeOf :: String -> Maybe Text
mediaTypeOf String
x =
  let mediaPrefixes :: [Text]
mediaPrefixes = [Text
"image", Text
"video", Text
"audio"] in
  case String -> Maybe Text
getMimeType String
x of
    Just Text
y | (Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Text -> Text -> Bool
`TS.isPrefixOf` Text
y) [Text]
mediaPrefixes -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
y
    Maybe Text
_      -> Maybe Text
forall a. Maybe a
Nothing

-- Returns filename for chapter number.
showChapter :: Int -> String
showChapter :: Int -> String
showChapter = String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"ch%03d.xhtml"

-- Add identifiers to any headers without them.
addIdentifiers :: WriterOptions -> [Block] -> [Block]
addIdentifiers :: WriterOptions -> [Block] -> [Block]
addIdentifiers WriterOptions
opts [Block]
bs = State (Set Text) [Block] -> Set Text -> [Block]
forall s a. State s a -> s -> a
evalState ((Block -> StateT (Set Text) Identity Block)
-> [Block] -> State (Set Text) [Block]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Block -> StateT (Set Text) Identity Block
forall (m :: * -> *). MonadState (Set Text) m => Block -> m Block
go [Block]
bs) Set Text
forall a. Set a
Set.empty
 where go :: Block -> m Block
go (Header Int
n (Text
ident,[Text]
classes,[(Text, Text)]
kvs) [Inline]
ils) = do
         Set Text
ids <- m (Set Text)
forall s (m :: * -> *). MonadState s m => m s
get
         let ident' :: Text
ident' = if Text -> Bool
TS.null Text
ident
                         then Extensions -> [Inline] -> Set Text -> Text
uniqueIdent (WriterOptions -> Extensions
writerExtensions WriterOptions
opts) [Inline]
ils Set Text
ids
                         else Text
ident
         (Set Text -> Set Text) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((Set Text -> Set Text) -> m ()) -> (Set Text -> Set Text) -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Set Text -> Set Text
forall a. Ord a => a -> Set a -> Set a
Set.insert Text
ident'
         Block -> m Block
forall (m :: * -> *) a. Monad m => a -> m a
return (Block -> m Block) -> Block -> m Block
forall a b. (a -> b) -> a -> b
$ Int -> Attr -> [Inline] -> Block
Header Int
n (Text
ident',[Text]
classes,[(Text, Text)]
kvs) [Inline]
ils
       go Block
x = Block -> m Block
forall (m :: * -> *) a. Monad m => a -> m a
return Block
x

-- Variant of normalizeDate that allows partial dates: YYYY, YYYY-MM
normalizeDate' :: String -> Maybe String
normalizeDate' :: String -> Maybe String
normalizeDate' = (Text -> String) -> Maybe Text -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> String
TS.unpack (Maybe Text -> Maybe String)
-> (String -> Maybe Text) -> String -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Text
go (Text -> Maybe Text) -> (String -> Text) -> String -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
trim (Text -> Text) -> (String -> Text) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
TS.pack
  where
    go :: Text -> Maybe Text
go Text
xs
      | Text -> Int
TS.length Text
xs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
4            -- YYY
      , (Char -> Bool) -> Text -> Bool
TS.all Char -> Bool
isDigit Text
xs = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
xs
      | (Text
y, Text
s) <- Int -> Text -> (Text, Text)
TS.splitAt Int
4 Text
xs    -- YYY-MM
      , Just (Char
'-', Text
m) <- Text -> Maybe (Char, Text)
TS.uncons Text
s
      , Text -> Int
TS.length Text
m Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2
      , (Char -> Bool) -> Text -> Bool
TS.all Char -> Bool
isDigit Text
y Bool -> Bool -> Bool
&& (Char -> Bool) -> Text -> Bool
TS.all Char -> Bool
isDigit Text
m = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
xs
      | Bool
otherwise = Text -> Maybe Text
normalizeDate Text
xs

toRelator :: String -> Maybe String
toRelator :: String -> Maybe String
toRelator String
x
  | String
x String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
relators = String -> Maybe String
forall a. a -> Maybe a
Just String
x
  | Bool
otherwise         = String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup ((Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
x) [(String, String)]
relatorMap

relators :: [String]
relators :: [String]
relators = ((String, String) -> String) -> [(String, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, String) -> String
forall a b. (a, b) -> b
snd [(String, String)]
relatorMap

relatorMap :: [(String, String)]
relatorMap :: [(String, String)]
relatorMap =
           [(String
"abridger", String
"abr")
           ,(String
"actor", String
"act")
           ,(String
"adapter", String
"adp")
           ,(String
"addressee", String
"rcp")
           ,(String
"analyst", String
"anl")
           ,(String
"animator", String
"anm")
           ,(String
"annotator", String
"ann")
           ,(String
"appellant", String
"apl")
           ,(String
"appellee", String
"ape")
           ,(String
"applicant", String
"app")
           ,(String
"architect", String
"arc")
           ,(String
"arranger", String
"arr")
           ,(String
"art copyist", String
"acp")
           ,(String
"art director", String
"adi")
           ,(String
"artist", String
"art")
           ,(String
"artistic director", String
"ard")
           ,(String
"assignee", String
"asg")
           ,(String
"associated name", String
"asn")
           ,(String
"attributed name", String
"att")
           ,(String
"auctioneer", String
"auc")
           ,(String
"author", String
"aut")
           ,(String
"author in quotations or text abstracts", String
"aqt")
           ,(String
"author of afterword, colophon, etc.", String
"aft")
           ,(String
"author of dialog", String
"aud")
           ,(String
"author of introduction, etc.", String
"aui")
           ,(String
"autographer", String
"ato")
           ,(String
"bibliographic antecedent", String
"ant")
           ,(String
"binder", String
"bnd")
           ,(String
"binding designer", String
"bdd")
           ,(String
"blurb writer", String
"blw")
           ,(String
"book designer", String
"bkd")
           ,(String
"book producer", String
"bkp")
           ,(String
"bookjacket designer", String
"bjd")
           ,(String
"bookplate designer", String
"bpd")
           ,(String
"bookseller", String
"bsl")
           ,(String
"braille embosser", String
"brl")
           ,(String
"broadcaster", String
"brd")
           ,(String
"calligrapher", String
"cll")
           ,(String
"cartographer", String
"ctg")
           ,(String
"caster", String
"cas")
           ,(String
"censor", String
"cns")
           ,(String
"choreographer", String
"chr")
           ,(String
"cinematographer", String
"cng")
           ,(String
"client", String
"cli")
           ,(String
"collection registrar", String
"cor")
           ,(String
"collector", String
"col")
           ,(String
"collotyper", String
"clt")
           ,(String
"colorist", String
"clr")
           ,(String
"commentator", String
"cmm")
           ,(String
"commentator for written text", String
"cwt")
           ,(String
"compiler", String
"com")
           ,(String
"complainant", String
"cpl")
           ,(String
"complainant-appellant", String
"cpt")
           ,(String
"complainant-appellee", String
"cpe")
           ,(String
"composer", String
"cmp")
           ,(String
"compositor", String
"cmt")
           ,(String
"conceptor", String
"ccp")
           ,(String
"conductor", String
"cnd")
           ,(String
"conservator", String
"con")
           ,(String
"consultant", String
"csl")
           ,(String
"consultant to a project", String
"csp")
           ,(String
"contestant", String
"cos")
           ,(String
"contestant-appellant", String
"cot")
           ,(String
"contestant-appellee", String
"coe")
           ,(String
"contestee", String
"cts")
           ,(String
"contestee-appellant", String
"ctt")
           ,(String
"contestee-appellee", String
"cte")
           ,(String
"contractor", String
"ctr")
           ,(String
"contributor", String
"ctb")
           ,(String
"copyright claimant", String
"cpc")
           ,(String
"copyright holder", String
"cph")
           ,(String
"corrector", String
"crr")
           ,(String
"correspondent", String
"crp")
           ,(String
"costume designer", String
"cst")
           ,(String
"court governed", String
"cou")
           ,(String
"court reporter", String
"crt")
           ,(String
"cover designer", String
"cov")
           ,(String
"creator", String
"cre")
           ,(String
"curator", String
"cur")
           ,(String
"dancer", String
"dnc")
           ,(String
"data contributor", String
"dtc")
           ,(String
"data manager", String
"dtm")
           ,(String
"dedicatee", String
"dte")
           ,(String
"dedicator", String
"dto")
           ,(String
"defendant", String
"dfd")
           ,(String
"defendant-appellant", String
"dft")
           ,(String
"defendant-appellee", String
"dfe")
           ,(String
"degree granting institution", String
"dgg")
           ,(String
"delineator", String
"dln")
           ,(String
"depicted", String
"dpc")
           ,(String
"depositor", String
"dpt")
           ,(String
"designer", String
"dsr")
           ,(String
"director", String
"drt")
           ,(String
"dissertant", String
"dis")
           ,(String
"distribution place", String
"dbp")
           ,(String
"distributor", String
"dst")
           ,(String
"donor", String
"dnr")
           ,(String
"draftsman", String
"drm")
           ,(String
"dubious author", String
"dub")
           ,(String
"editor", String
"edt")
           ,(String
"editor of compilation", String
"edc")
           ,(String
"editor of moving image work", String
"edm")
           ,(String
"electrician", String
"elg")
           ,(String
"electrotyper", String
"elt")
           ,(String
"enacting jurisdiction", String
"enj")
           ,(String
"engineer", String
"eng")
           ,(String
"engraver", String
"egr")
           ,(String
"etcher", String
"etr")
           ,(String
"event place", String
"evp")
           ,(String
"expert", String
"exp")
           ,(String
"facsimilist", String
"fac")
           ,(String
"field director", String
"fld")
           ,(String
"film director", String
"fmd")
           ,(String
"film distributor", String
"fds")
           ,(String
"film editor", String
"flm")
           ,(String
"film producer", String
"fmp")
           ,(String
"filmmaker", String
"fmk")
           ,(String
"first party", String
"fpy")
           ,(String
"forger", String
"frg")
           ,(String
"former owner", String
"fmo")
           ,(String
"funder", String
"fnd")
           ,(String
"geographic information specialist", String
"gis")
           ,(String
"honoree", String
"hnr")
           ,(String
"host", String
"hst")
           ,(String
"host institution", String
"his")
           ,(String
"illuminator", String
"ilu")
           ,(String
"illustrator", String
"ill")
           ,(String
"inscriber", String
"ins")
           ,(String
"instrumentalist", String
"itr")
           ,(String
"interviewee", String
"ive")
           ,(String
"interviewer", String
"ivr")
           ,(String
"inventor", String
"inv")
           ,(String
"issuing body", String
"isb")
           ,(String
"judge", String
"jud")
           ,(String
"jurisdiction governed", String
"jug")
           ,(String
"laboratory", String
"lbr")
           ,(String
"laboratory director", String
"ldr")
           ,(String
"landscape architect", String
"lsa")
           ,(String
"lead", String
"led")
           ,(String
"lender", String
"len")
           ,(String
"libelant", String
"lil")
           ,(String
"libelant-appellant", String
"lit")
           ,(String
"libelant-appellee", String
"lie")
           ,(String
"libelee", String
"lel")
           ,(String
"libelee-appellant", String
"let")
           ,(String
"libelee-appellee", String
"lee")
           ,(String
"librettist", String
"lbt")
           ,(String
"licensee", String
"lse")
           ,(String
"licensor", String
"lso")
           ,(String
"lighting designer", String
"lgd")
           ,(String
"lithographer", String
"ltg")
           ,(String
"lyricist", String
"lyr")
           ,(String
"manufacture place", String
"mfp")
           ,(String
"manufacturer", String
"mfr")
           ,(String
"marbler", String
"mrb")
           ,(String
"markup editor", String
"mrk")
           ,(String
"metadata contact", String
"mdc")
           ,(String
"metal-engraver", String
"mte")
           ,(String
"moderator", String
"mod")
           ,(String
"monitor", String
"mon")
           ,(String
"music copyist", String
"mcp")
           ,(String
"musical director", String
"msd")
           ,(String
"musician", String
"mus")
           ,(String
"narrator", String
"nrt")
           ,(String
"onscreen presenter", String
"osp")
           ,(String
"opponent", String
"opn")
           ,(String
"organizer of meeting", String
"orm")
           ,(String
"originator", String
"org")
           ,(String
"other", String
"oth")
           ,(String
"owner", String
"own")
           ,(String
"panelist", String
"pan")
           ,(String
"papermaker", String
"ppm")
           ,(String
"patent applicant", String
"pta")
           ,(String
"patent holder", String
"pth")
           ,(String
"patron", String
"pat")
           ,(String
"performer", String
"prf")
           ,(String
"permitting agency", String
"pma")
           ,(String
"photographer", String
"pht")
           ,(String
"plaintiff", String
"ptf")
           ,(String
"plaintiff-appellant", String
"ptt")
           ,(String
"plaintiff-appellee", String
"pte")
           ,(String
"platemaker", String
"plt")
           ,(String
"praeses", String
"pra")
           ,(String
"presenter", String
"pre")
           ,(String
"printer", String
"prt")
           ,(String
"printer of plates", String
"pop")
           ,(String
"printmaker", String
"prm")
           ,(String
"process contact", String
"prc")
           ,(String
"producer", String
"pro")
           ,(String
"production company", String
"prn")
           ,(String
"production designer", String
"prs")
           ,(String
"production manager", String
"pmn")
           ,(String
"production personnel", String
"prd")
           ,(String
"production place", String
"prp")
           ,(String
"programmer", String
"prg")
           ,(String
"project director", String
"pdr")
           ,(String
"proofreader", String
"pfr")
           ,(String
"provider", String
"prv")
           ,(String
"publication place", String
"pup")
           ,(String
"publisher", String
"pbl")
           ,(String
"publishing director", String
"pbd")
           ,(String
"puppeteer", String
"ppt")
           ,(String
"radio director", String
"rdd")
           ,(String
"radio producer", String
"rpc")
           ,(String
"recording engineer", String
"rce")
           ,(String
"recordist", String
"rcd")
           ,(String
"redaktor", String
"red")
           ,(String
"renderer", String
"ren")
           ,(String
"reporter", String
"rpt")
           ,(String
"repository", String
"rps")
           ,(String
"research team head", String
"rth")
           ,(String
"research team member", String
"rtm")
           ,(String
"researcher", String
"res")
           ,(String
"respondent", String
"rsp")
           ,(String
"respondent-appellant", String
"rst")
           ,(String
"respondent-appellee", String
"rse")
           ,(String
"responsible party", String
"rpy")
           ,(String
"restager", String
"rsg")
           ,(String
"restorationist", String
"rsr")
           ,(String
"reviewer", String
"rev")
           ,(String
"rubricator", String
"rbr")
           ,(String
"scenarist", String
"sce")
           ,(String
"scientific advisor", String
"sad")
           ,(String
"screenwriter", String
"aus")
           ,(String
"scribe", String
"scr")
           ,(String
"sculptor", String
"scl")
           ,(String
"second party", String
"spy")
           ,(String
"secretary", String
"sec")
           ,(String
"seller", String
"sll")
           ,(String
"set designer", String
"std")
           ,(String
"setting", String
"stg")
           ,(String
"signer", String
"sgn")
           ,(String
"singer", String
"sng")
           ,(String
"sound designer", String
"sds")
           ,(String
"speaker", String
"spk")
           ,(String
"sponsor", String
"spn")
           ,(String
"stage director", String
"sgd")
           ,(String
"stage manager", String
"stm")
           ,(String
"standards body", String
"stn")
           ,(String
"stereotyper", String
"str")
           ,(String
"storyteller", String
"stl")
           ,(String
"supporting host", String
"sht")
           ,(String
"surveyor", String
"srv")
           ,(String
"teacher", String
"tch")
           ,(String
"technical director", String
"tcd")
           ,(String
"television director", String
"tld")
           ,(String
"television producer", String
"tlp")
           ,(String
"thesis advisor", String
"ths")
           ,(String
"transcriber", String
"trc")
           ,(String
"translator", String
"trl")
           ,(String
"type designer", String
"tyd")
           ,(String
"typographer", String
"tyg")
           ,(String
"university place", String
"uvp")
           ,(String
"videographer", String
"vdg")
           ,(String
"witness", String
"wit")
           ,(String
"wood engraver", String
"wde")
           ,(String
"woodcutter", String
"wdc")
           ,(String
"writer of accompanying material", String
"wam")
           ,(String
"writer of added commentary", String
"wac")
           ,(String
"writer of added lyrics", String
"wal")
           ,(String
"writer of added text", String
"wat")
           ]

docTitle' :: Meta -> [Inline]
docTitle' :: Meta -> [Inline]
docTitle' Meta
meta = [Inline] -> (MetaValue -> [Inline]) -> Maybe MetaValue -> [Inline]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] MetaValue -> [Inline]
go (Maybe MetaValue -> [Inline]) -> Maybe MetaValue -> [Inline]
forall a b. (a -> b) -> a -> b
$ Text -> Meta -> Maybe MetaValue
lookupMeta Text
"title" Meta
meta
  where go :: MetaValue -> [Inline]
go (MetaString Text
s) = [Text -> Inline
Str Text
s]
        go (MetaInlines [Inline]
xs) = [Inline]
xs
        go (MetaBlocks [Para [Inline]
xs]) = [Inline]
xs
        go (MetaBlocks [Plain [Inline]
xs]) = [Inline]
xs
        go (MetaMap Map Text MetaValue
m) =
              case Text -> Map Text MetaValue -> Maybe MetaValue
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
"type" Map Text MetaValue
m of
                   Just MetaValue
x | MetaValue -> Text
forall a. Walkable Inline a => a -> Text
stringify MetaValue
x Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"main" ->
                              [Inline] -> (MetaValue -> [Inline]) -> Maybe MetaValue -> [Inline]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] MetaValue -> [Inline]
go (Maybe MetaValue -> [Inline]) -> Maybe MetaValue -> [Inline]
forall a b. (a -> b) -> a -> b
$ Text -> Map Text MetaValue -> Maybe MetaValue
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
"text" Map Text MetaValue
m
                   Maybe MetaValue
_ -> []
        go (MetaList [MetaValue]
xs) = (MetaValue -> [Inline]) -> [MetaValue] -> [Inline]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap MetaValue -> [Inline]
go [MetaValue]
xs
        go MetaValue
_ = []