{-# LANGUAGE CPP                 #-}
{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE PatternGuards       #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}
{- |
   Module      : Text.Pandoc.Writers.EPUB
   Copyright   : Copyright (C) 2010-2023 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 (State, 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)
import Data.List (isInfixOf, isPrefixOf)
import qualified Data.Map as M
import Data.Maybe (fromMaybe, isNothing, mapMaybe, isJust, catMaybes)
import qualified Data.Set as Set
import qualified Data.Text as T
import Data.Text (Text)
import qualified Data.Text.Lazy as TL
import System.FilePath (takeExtension, takeFileName, makeRelative)
import Text.HTML.TagSoup (Tag (TagOpen), fromAttrib, parseTags)
import Text.Pandoc.Builder (fromList, setMeta)
import Text.Pandoc.Writers.Shared (ensureValidXmlIdentifiers)
import Data.Tree (Tree(..))
import Text.Pandoc.Class (PandocMonad, report)
import qualified Text.Pandoc.Class.PandocPure as P
import Text.Pandoc.Data (readDataFile)
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.URI (urlEncode)
import Text.Pandoc.Options (EPUBVersion (..), HTMLMathMethod (..),
                            ObfuscationMethod (NoObfuscation), WrapOption (..),
                            WriterOptions (..))
import Text.Pandoc.Shared (normalizeDate, renderTags',
                           stringify, uniqueIdent, tshow)
import qualified Text.Pandoc.UTF8 as UTF8
import Text.Pandoc.UUID (getRandomUUID)
import Text.Pandoc.Walk (walk, walkM)
import Text.Pandoc.Writers.HTML (writeHtmlStringForEPUB)
import Text.Printf (printf)
import Text.Pandoc.XML.Light
import Text.Pandoc.XML (escapeStringForXML)
import Text.DocTemplates (FromContext(lookupContext), Context(..),
                          ToContext(toVal), Val(..))
import Text.Pandoc.Chunks (splitIntoChunks, Chunk(..), ChunkedDoc(..),
                           SecInfo(..))

-- A Chapter includes a list of blocks.
newtype Chapter = Chapter [Block]
  deriving (Int -> Chapter -> ShowS
[Chapter] -> ShowS
Chapter -> String
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  :: FilePath
      }

type E m = StateT EPUBState m

data EPUBMetadata = EPUBMetadata{
    EPUBMetadata -> [Identifier]
epubIdentifier          :: [Identifier]
  , EPUBMetadata -> [Title]
epubTitle               :: [Title]
  , EPUBMetadata -> [Date]
epubDate                :: [Date]
  , EPUBMetadata -> Text
epubLanguage            :: Text
  , EPUBMetadata -> [Creator]
epubCreator             :: [Creator]
  , EPUBMetadata -> [Creator]
epubContributor         :: [Creator]
  , EPUBMetadata -> [Subject]
epubSubject             :: [Subject]
  , EPUBMetadata -> Maybe Text
epubDescription         :: Maybe Text
  , EPUBMetadata -> Maybe Text
epubType                :: Maybe Text
  , EPUBMetadata -> Maybe Text
epubFormat              :: Maybe Text
  , EPUBMetadata -> Maybe Text
epubPublisher           :: Maybe Text
  , EPUBMetadata -> Maybe Text
epubSource              :: Maybe Text
  , EPUBMetadata -> Maybe Text
epubRelation            :: Maybe Text
  , EPUBMetadata -> Maybe Text
epubCoverage            :: Maybe Text
  , EPUBMetadata -> Maybe Text
epubRights              :: Maybe Text
  , EPUBMetadata -> Maybe Text
epubBelongsToCollection :: Maybe Text
  , EPUBMetadata -> Maybe Text
epubGroupPosition       :: Maybe Text
  , EPUBMetadata -> Maybe String
epubCoverImage          :: Maybe FilePath
  , EPUBMetadata -> [String]
epubStylesheets         :: [FilePath]
  , EPUBMetadata -> Maybe ProgressionDirection
epubPageDirection       :: Maybe ProgressionDirection
  , EPUBMetadata -> [(Text, Text)]
epubIbooksFields        :: [(Text, Text)]
  , EPUBMetadata -> [(Text, Text)]
epubCalibreFields       :: [(Text, Text)]
  } deriving Int -> EPUBMetadata -> ShowS
[EPUBMetadata] -> ShowS
EPUBMetadata -> String
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 -> Text
dateText  :: Text
  , Date -> Maybe Text
dateEvent :: Maybe Text
  } deriving Int -> Date -> ShowS
[Date] -> ShowS
Date -> String
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 -> Text
creatorText   :: Text
  , Creator -> Maybe Text
creatorRole   :: Maybe Text
  , Creator -> Maybe Text
creatorFileAs :: Maybe Text
  } deriving Int -> Creator -> ShowS
[Creator] -> ShowS
Creator -> String
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 -> Text
identifierText   :: Text
  , Identifier -> Maybe Text
identifierScheme :: Maybe Text
  } deriving Int -> Identifier -> ShowS
[Identifier] -> ShowS
Identifier -> String
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 -> Text
titleText   :: Text
  , Title -> Maybe Text
titleFileAs :: Maybe Text
  , Title -> Maybe Text
titleType   :: Maybe Text
  } deriving Int -> Title -> ShowS
[Title] -> ShowS
Title -> String
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
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

data Subject = Subject{
    Subject -> Text
subjectText      :: Text
  , Subject -> Maybe Text
subjectAuthority :: Maybe Text
  , Subject -> Maybe Text
subjectTerm      :: Maybe Text
  } deriving Int -> Subject -> ShowS
[Subject] -> ShowS
Subject -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Subject] -> ShowS
$cshowList :: [Subject] -> ShowS
show :: Subject -> String
$cshow :: Subject -> String
showsPrec :: Int -> Subject -> ShowS
$cshowsPrec :: Int -> Subject -> ShowS
Show

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

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

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

toId :: FilePath -> Text
toId :: String -> Text
toId = String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
.
       forall a b. (a -> b) -> [a] -> [b]
map (\Char
x -> if Char -> Bool
isAlphaNum Char
x Bool -> Bool -> Bool
|| Char
x forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
|| Char
x forall a. Eq a => a -> a -> Bool
== Char
'_'
                     then Char
x
                     else Char
'_') 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' :: Text -> Val T.Text
toVal' :: Text -> Val Text
toVal' = forall a b. ToContext a b => b -> Val a
toVal

mkEntry :: PandocMonad m => FilePath -> B.ByteString -> E m Entry
mkEntry :: forall (m :: * -> *).
PandocMonad m =>
String -> ByteString -> E m Entry
mkEntry String
path ByteString
content = do
  String
epubSubdir <- 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 forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
epubSubdir
              then String
""
              else String
epubSubdir forall a. [a] -> [a] -> [a]
++ String
"/") forall a. [a] -> [a] -> [a]
++ Entry -> String
eRelativePath Entry
e }
  Integer
epochtime <- forall a b. (RealFrac a, Integral b) => a -> b
floor forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). PandocMonad m => m POSIXTime
P.getPOSIXTime
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
       (if String
path forall a. Eq a => a -> a -> Bool
== String
"mimetype" Bool -> Bool -> Bool
|| String
"META-INF" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
path
           then forall a. a -> a
id
           else Entry -> Entry
addEpubSubdir) 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 :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Meta -> E m EPUBMetadata
getEPUBMetadata WriterOptions
opts Meta
meta = do
  let md :: EPUBMetadata
md = WriterOptions -> Meta -> EPUBMetadata
metadataFromMeta WriterOptions
opts Meta
meta
  [Element]
elts <- case WriterOptions -> Maybe Text
writerEpubMetadata WriterOptions
opts of
            Maybe Text
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return []
            Just Text
t -> case Text -> Either Text [Content]
parseXMLContents (Text -> Text
TL.fromStrict Text
t) of
                          Left Text
msg -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$
                            Text -> Text -> PandocError
PandocXMLError Text
"epub metadata" Text
msg
                          Right [Content]
ns -> forall (m :: * -> *) a. Monad m => a -> m a
return ([Content] -> [Element]
onlyElems [Content]
ns)
  let md' :: EPUBMetadata
md' = 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 forall (t :: * -> *) a. Foldable t => t a -> Bool
null (EPUBMetadata -> [Identifier]
epubIdentifier EPUBMetadata
m)
          then do
            UUID
randomId <- forall (m :: * -> *). PandocMonad m => m UUID
getRandomUUID
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ EPUBMetadata
m{ epubIdentifier :: [Identifier]
epubIdentifier = [Text -> Maybe Text -> Identifier
Identifier (forall a. Show a => a -> Text
tshow UUID
randomId) forall a. Maybe a
Nothing] }
          else forall (m :: * -> *) a. Monad m => a -> m a
return EPUBMetadata
m
  let addLanguage :: EPUBMetadata -> t m EPUBMetadata
addLanguage EPUBMetadata
m =
       if Text -> Bool
T.null (EPUBMetadata -> Text
epubLanguage EPUBMetadata
m)
          then case forall a b. FromContext a b => Text -> Context a -> Maybe b
lookupContext Text
"lang" (WriterOptions -> Context Text
writerVariables WriterOptions
opts) of
                     Just Text
x  -> forall (m :: * -> *) a. Monad m => a -> m a
return EPUBMetadata
m{ epubLanguage :: Text
epubLanguage = Text
x }
                     Maybe Text
Nothing -> do
                       Maybe Text
mLang <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ 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
T.map (\Char
c -> if Char
c forall a. Eq a => a -> a -> Bool
== Char
'_' then Char
'-' else Char
c) forall a b. (a -> b) -> a -> b
$
                                 (Char -> Bool) -> Text -> Text
T.takeWhile (forall a. Eq a => a -> a -> Bool
/=Char
'.') Text
lang
                               Maybe Text
Nothing -> Text
"en-US"
                       forall (m :: * -> *) a. Monad m => a -> m a
return EPUBMetadata
m{ epubLanguage :: Text
epubLanguage = Text
localeLang }
          else forall (m :: * -> *) a. Monad m => a -> m a
return EPUBMetadata
m
  let fixDate :: EPUBMetadata -> t m EPUBMetadata
fixDate EPUBMetadata
m =
       if forall (t :: * -> *) a. Foldable t => t a -> Bool
null (EPUBMetadata -> [Date]
epubDate EPUBMetadata
m)
          then do
            UTCTime
currentTime <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). PandocMonad m => m UTCTime
P.getTimestamp
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ EPUBMetadata
m{ epubDate :: [Date]
epubDate = [ Date{
                             dateText :: Text
dateText = UTCTime -> Text
showDateTimeISO8601 UTCTime
currentTime
                           , dateEvent :: Maybe Text
dateEvent = forall a. Maybe a
Nothing } ] }
          else forall (m :: * -> *) a. Monad m => a -> m a
return EPUBMetadata
m
  let addAuthor :: EPUBMetadata -> m EPUBMetadata
addAuthor EPUBMetadata
m =
       if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\Creator
c -> Creator -> Maybe Text
creatorRole Creator
c forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Text
"aut") forall a b. (a -> b) -> a -> b
$ EPUBMetadata -> [Creator]
epubCreator EPUBMetadata
m
          then forall (m :: * -> *) a. Monad m => a -> m a
return EPUBMetadata
m
          else do
            let authors' :: [Text]
authors' = forall a b. (a -> b) -> [a] -> [b]
map forall a. Walkable Inline a => a -> Text
stringify forall a b. (a -> b) -> a -> b
$ Meta -> [[Inline]]
docAuthors Meta
meta
            let toAuthor :: Text -> Creator
toAuthor Text
name = Creator{ creatorText :: Text
creatorText = Text
name
                                       , creatorRole :: Maybe Text
creatorRole = forall a. a -> Maybe a
Just Text
"aut"
                                       , creatorFileAs :: Maybe Text
creatorFileAs = forall a. Maybe a
Nothing }
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ EPUBMetadata
m{ epubCreator :: [Creator]
epubCreator = forall a b. (a -> b) -> [a] -> [b]
map Text -> Creator
toAuthor [Text]
authors' forall a. [a] -> [a] -> [a]
++ EPUBMetadata -> [Creator]
epubCreator EPUBMetadata
m }
  forall {m :: * -> *}.
PandocMonad m =>
EPUBMetadata -> m EPUBMetadata
addIdentifier EPUBMetadata
md' forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {t :: (* -> *) -> * -> *} {m :: * -> *}.
(MonadTrans t, Monad (t m), PandocMonad m) =>
EPUBMetadata -> t m EPUBMetadata
fixDate forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {m :: * -> *}. Monad m => EPUBMetadata -> m EPUBMetadata
addAuthor forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= 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 Text
name Maybe Text
_ (Just Text
"dc")) [Attr]
attrs [Content]
_ Maybe Integer
_) EPUBMetadata
md
  | Text
name forall a. Eq a => a -> a -> Bool
== Text
"identifier" = EPUBMetadata
md{ epubIdentifier :: [Identifier]
epubIdentifier =
             Identifier{ identifierText :: Text
identifierText = Element -> Text
strContent Element
e
                       , identifierScheme :: Maybe Text
identifierScheme = QName -> [Attr] -> Maybe Text
lookupAttr (Text -> QName
opfName Text
"scheme") [Attr]
attrs
                       } forall a. a -> [a] -> [a]
: EPUBMetadata -> [Identifier]
epubIdentifier EPUBMetadata
md }
  | Text
name forall a. Eq a => a -> a -> Bool
== Text
"title" = EPUBMetadata
md{ epubTitle :: [Title]
epubTitle =
            Title{ titleText :: Text
titleText = Element -> Text
strContent Element
e
                 , titleFileAs :: Maybe Text
titleFileAs = Text -> Maybe Text
getAttr Text
"file-as"
                 , titleType :: Maybe Text
titleType = Text -> Maybe Text
getAttr Text
"type"
                 } forall a. a -> [a] -> [a]
: EPUBMetadata -> [Title]
epubTitle EPUBMetadata
md }
  | Text
name forall a. Eq a => a -> a -> Bool
== Text
"date" = EPUBMetadata
md{ epubDate :: [Date]
epubDate =
             Date{ dateText :: Text
dateText = forall a. a -> Maybe a -> a
fromMaybe Text
"" forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
normalizeDate' forall a b. (a -> b) -> a -> b
$ Element -> Text
strContent Element
e
                 , dateEvent :: Maybe Text
dateEvent = Text -> Maybe Text
getAttr Text
"event"
                 } forall a. a -> [a] -> [a]
: EPUBMetadata -> [Date]
epubDate EPUBMetadata
md }
  | Text
name forall a. Eq a => a -> a -> Bool
== Text
"language" = EPUBMetadata
md{ epubLanguage :: Text
epubLanguage = Element -> Text
strContent Element
e }
  | Text
name forall a. Eq a => a -> a -> Bool
== Text
"creator" = EPUBMetadata
md{ epubCreator :: [Creator]
epubCreator =
              Creator{ creatorText :: Text
creatorText = Element -> Text
strContent Element
e
                     , creatorRole :: Maybe Text
creatorRole = Text -> Maybe Text
getAttr Text
"role"
                     , creatorFileAs :: Maybe Text
creatorFileAs = Text -> Maybe Text
getAttr Text
"file-as"
                     } forall a. a -> [a] -> [a]
: EPUBMetadata -> [Creator]
epubCreator EPUBMetadata
md }
  | Text
name forall a. Eq a => a -> a -> Bool
== Text
"contributor" = EPUBMetadata
md{ epubContributor :: [Creator]
epubContributor =
              Creator  { creatorText :: Text
creatorText = Element -> Text
strContent Element
e
                       , creatorRole :: Maybe Text
creatorRole = Text -> Maybe Text
getAttr Text
"role"
                       , creatorFileAs :: Maybe Text
creatorFileAs = Text -> Maybe Text
getAttr Text
"file-as"
                       } forall a. a -> [a] -> [a]
: EPUBMetadata -> [Creator]
epubContributor EPUBMetadata
md }
  | Text
name forall a. Eq a => a -> a -> Bool
== Text
"subject" = EPUBMetadata
md{ epubSubject :: [Subject]
epubSubject =
              Subject  { subjectText :: Text
subjectText = Element -> Text
strContent Element
e
                       , subjectAuthority :: Maybe Text
subjectAuthority = Text -> Maybe Text
getAttr Text
"authority"
                       , subjectTerm :: Maybe Text
subjectTerm = Text -> Maybe Text
getAttr Text
"term"
                       } forall a. a -> [a] -> [a]
: EPUBMetadata -> [Subject]
epubSubject EPUBMetadata
md }
  | Text
name forall a. Eq a => a -> a -> Bool
== Text
"description" = EPUBMetadata
md { epubDescription :: Maybe Text
epubDescription = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Element -> Text
strContent Element
e }
  | Text
name forall a. Eq a => a -> a -> Bool
== Text
"type" = EPUBMetadata
md { epubType :: Maybe Text
epubType = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Element -> Text
strContent Element
e }
  | Text
name forall a. Eq a => a -> a -> Bool
== Text
"format" = EPUBMetadata
md { epubFormat :: Maybe Text
epubFormat = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Element -> Text
strContent Element
e }
  | Text
name forall a. Eq a => a -> a -> Bool
== Text
"publisher" = EPUBMetadata
md { epubPublisher :: Maybe Text
epubPublisher = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Element -> Text
strContent Element
e }
  | Text
name forall a. Eq a => a -> a -> Bool
== Text
"source" = EPUBMetadata
md { epubSource :: Maybe Text
epubSource = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Element -> Text
strContent Element
e }
  | Text
name forall a. Eq a => a -> a -> Bool
== Text
"relation" = EPUBMetadata
md { epubRelation :: Maybe Text
epubRelation = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Element -> Text
strContent Element
e }
  | Text
name forall a. Eq a => a -> a -> Bool
== Text
"coverage" = EPUBMetadata
md { epubCoverage :: Maybe Text
epubCoverage = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Element -> Text
strContent Element
e }
  | Text
name forall a. Eq a => a -> a -> Bool
== Text
"rights" = EPUBMetadata
md { epubRights :: Maybe Text
epubRights = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Element -> Text
strContent Element
e }
  | Text
name forall a. Eq a => a -> a -> Bool
== Text
"belongs-to-collection" = EPUBMetadata
md { epubBelongsToCollection :: Maybe Text
epubBelongsToCollection = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Element -> Text
strContent Element
e }
  | Text
name forall a. Eq a => a -> a -> Bool
== Text
"group-position" = EPUBMetadata
md { epubGroupPosition :: Maybe Text
epubGroupPosition = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Element -> Text
strContent Element
e }
  | Bool
otherwise = EPUBMetadata
md
  where getAttr :: Text -> Maybe Text
getAttr Text
n = QName -> [Attr] -> Maybe Text
lookupAttr (Text -> QName
opfName Text
n) [Attr]
attrs
addMetadataFromXML e :: Element
e@(Element (QName Text
"meta" Maybe Text
_ Maybe Text
_) [Attr]
attrs [Content]
_ Maybe Integer
_) EPUBMetadata
md =
  case Text -> Maybe Text
getAttr Text
"property" of
       Just Text
s | Text
"ibooks:" Text -> Text -> Bool
`T.isPrefixOf` Text
s ->
                EPUBMetadata
md{ epubIbooksFields :: [(Text, Text)]
epubIbooksFields = (Int -> Text -> Text
T.drop Int
7 Text
s, Element -> Text
strContent Element
e) forall a. a -> [a] -> [a]
:
                       EPUBMetadata -> [(Text, Text)]
epubIbooksFields EPUBMetadata
md }
       Maybe Text
_ -> case Text -> Maybe Text
getAttr Text
"name" of
                 Just Text
s | Text
"calibre:" Text -> Text -> Bool
`T.isPrefixOf` Text
s ->
                   EPUBMetadata
md{ epubCalibreFields :: [(Text, Text)]
epubCalibreFields =
                         (Int -> Text -> Text
T.drop Int
8 Text
s, forall a. a -> Maybe a -> a
fromMaybe Text
"" forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
getAttr Text
"content") forall a. a -> [a] -> [a]
:
                          EPUBMetadata -> [(Text, Text)]
epubCalibreFields EPUBMetadata
md }
                 Maybe Text
_ -> EPUBMetadata
md
  where getAttr :: Text -> Maybe Text
getAttr Text
n = QName -> [Attr] -> Maybe Text
lookupAttr (Text -> QName
unqual Text
n) [Attr]
attrs
addMetadataFromXML Element
_ EPUBMetadata
md = EPUBMetadata
md

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

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

getList :: T.Text -> Meta -> (MetaValue -> a) -> [a]
getList :: forall a. 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) -> 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 = 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{ identifierText :: Text
identifierText = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" MetaValue -> Text
metaValueToString
                                        forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
"text" Map Text MetaValue
m
                     , identifierScheme :: Maybe Text
identifierScheme = MetaValue -> Text
metaValueToString forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                                          forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
"scheme" Map Text MetaValue
m }
        handleMetaValue MetaValue
mv = Text -> Maybe Text -> Identifier
Identifier (MetaValue -> Text
metaValueToString MetaValue
mv) forall a. Maybe a
Nothing

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

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

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

getSubject :: T.Text -> Meta -> [Subject]
getSubject :: Text -> Meta -> [Subject]
getSubject Text
s Meta
meta = forall a. Text -> Meta -> (MetaValue -> a) -> [a]
getList Text
s Meta
meta MetaValue -> Subject
handleMetaValue
  where handleMetaValue :: MetaValue -> Subject
handleMetaValue (MetaMap Map Text MetaValue
m) =
           Subject{ subjectText :: Text
subjectText = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" MetaValue -> Text
metaValueToString forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
"text" Map Text MetaValue
m
                  , subjectAuthority :: Maybe Text
subjectAuthority = MetaValue -> Text
metaValueToString forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
"authority" Map Text MetaValue
m
                  , subjectTerm :: Maybe Text
subjectTerm = MetaValue -> Text
metaValueToString forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
"term" Map Text MetaValue
m }
        handleMetaValue MetaValue
mv = Text -> Maybe Text -> Maybe Text -> Subject
Subject (MetaValue -> Text
metaValueToString MetaValue
mv) forall a. Maybe a
Nothing forall a. Maybe a
Nothing

metadataFromMeta :: WriterOptions -> Meta -> EPUBMetadata
metadataFromMeta :: WriterOptions -> Meta -> EPUBMetadata
metadataFromMeta WriterOptions
opts Meta
meta = EPUBMetadata{
      epubIdentifier :: [Identifier]
epubIdentifier           = [Identifier]
identifiers
    , epubTitle :: [Title]
epubTitle                = [Title]
titles
    , epubDate :: [Date]
epubDate                 = [Date]
date
    , epubLanguage :: Text
epubLanguage             = Text
language
    , epubCreator :: [Creator]
epubCreator              = [Creator]
creators
    , epubContributor :: [Creator]
epubContributor          = [Creator]
contributors
    , epubSubject :: [Subject]
epubSubject              = [Subject]
subjects
    , epubDescription :: Maybe Text
epubDescription          = Maybe Text
description
    , epubType :: Maybe Text
epubType                 = Maybe Text
epubtype
    , epubFormat :: Maybe Text
epubFormat               = Maybe Text
format
    , epubPublisher :: Maybe Text
epubPublisher            = Maybe Text
publisher
    , epubSource :: Maybe Text
epubSource               = Maybe Text
source
    , epubRelation :: Maybe Text
epubRelation             = Maybe Text
relation
    , epubCoverage :: Maybe Text
epubCoverage             = Maybe Text
coverage
    , epubRights :: Maybe Text
epubRights               = Maybe Text
rights
    , epubBelongsToCollection :: Maybe Text
epubBelongsToCollection  = Maybe Text
belongsToCollection
    , epubGroupPosition :: Maybe Text
epubGroupPosition        = Maybe Text
groupPosition
    , epubCoverImage :: Maybe String
epubCoverImage           = Maybe String
coverImage
    , epubStylesheets :: [String]
epubStylesheets          = [String]
stylesheets
    , epubPageDirection :: Maybe ProgressionDirection
epubPageDirection        = Maybe ProgressionDirection
pageDirection
    , epubIbooksFields :: [(Text, Text)]
epubIbooksFields         = [(Text, Text)]
ibooksFields
    , epubCalibreFields :: [(Text, Text)]
epubCalibreFields        = [(Text, Text)]
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 :: Text
language = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" MetaValue -> Text
metaValueToString forall a b. (a -> b) -> a -> b
$
           Text -> Meta -> Maybe MetaValue
lookupMeta Text
"language" Meta
meta 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 :: [Subject]
subjects = Text -> Meta -> [Subject]
getSubject Text
"subject" Meta
meta
        description :: Maybe Text
description = MetaValue -> Text
metaValueToString forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Meta -> Maybe MetaValue
lookupMeta Text
"description" Meta
meta
        epubtype :: Maybe Text
epubtype = MetaValue -> Text
metaValueToString forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Meta -> Maybe MetaValue
lookupMeta Text
"type" Meta
meta
        format :: Maybe Text
format = MetaValue -> Text
metaValueToString forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Meta -> Maybe MetaValue
lookupMeta Text
"format" Meta
meta
        publisher :: Maybe Text
publisher = MetaValue -> Text
metaValueToString forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Meta -> Maybe MetaValue
lookupMeta Text
"publisher" Meta
meta
        source :: Maybe Text
source = MetaValue -> Text
metaValueToString forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Meta -> Maybe MetaValue
lookupMeta Text
"source" Meta
meta
        relation :: Maybe Text
relation = MetaValue -> Text
metaValueToString forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Meta -> Maybe MetaValue
lookupMeta Text
"relation" Meta
meta
        coverage :: Maybe Text
coverage = MetaValue -> Text
metaValueToString forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Meta -> Maybe MetaValue
lookupMeta Text
"coverage" Meta
meta
        rights :: Maybe Text
rights = MetaValue -> Text
metaValueToString forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Meta -> Maybe MetaValue
lookupMeta Text
"rights" Meta
meta
        belongsToCollection :: Maybe Text
belongsToCollection = MetaValue -> Text
metaValueToString forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Meta -> Maybe MetaValue
lookupMeta Text
"belongs-to-collection" Meta
meta
        groupPosition :: Maybe Text
groupPosition = MetaValue -> Text
metaValueToString forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Meta -> Maybe MetaValue
lookupMeta Text
"group-position" Meta
meta
        coverImage :: Maybe String
coverImage = Text -> String
T.unpack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
            forall a b. FromContext a b => Text -> Context a -> Maybe b
lookupContext Text
"epub-cover-image" (WriterOptions -> Context Text
writerVariables WriterOptions
opts)
            forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` (MetaValue -> Text
metaValueToString 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 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Meta -> Maybe MetaValue
lookupMeta Text
"stylesheet" Meta
meta
        stylesheets :: [String]
stylesheets = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] MetaValue -> [String]
metaValueToPaths Maybe MetaValue
mCss forall a. [a] -> [a] -> [a]
++
                      case forall a b. FromContext a b => Text -> Context a -> Maybe b
lookupContext Text
"css" (WriterOptions -> Context Text
writerVariables WriterOptions
opts) of
                         Just [Text]
xs -> forall a b. (a -> b) -> [a] -> [b]
map Text -> String
T.unpack [Text]
xs
                         Maybe [Text]
Nothing ->
                           case 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
T.unpack Text
x]
                             Maybe Text
Nothing -> []
        pageDirection :: Maybe ProgressionDirection
pageDirection = case Text -> Text
T.toLower forall b c a. (b -> c) -> (a -> b) -> a -> c
. MetaValue -> Text
metaValueToString 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 Text
"ltr" -> forall a. a -> Maybe a
Just ProgressionDirection
LTR
                              Just Text
"rtl" -> forall a. a -> Maybe a
Just ProgressionDirection
RTL
                              Maybe Text
_          -> forall a. Maybe a
Nothing
        ibooksFields :: [(Text, Text)]
ibooksFields = case Text -> Meta -> Maybe MetaValue
lookupMeta Text
"ibooks" Meta
meta of
                            Just (MetaMap Map Text MetaValue
mp)
                               -> forall k a. Map k a -> [(k, a)]
M.toList forall a b. (a -> b) -> a -> b
$ forall a b k. (a -> b) -> Map k a -> Map k b
M.map MetaValue -> Text
metaValueToString Map Text MetaValue
mp
                            Maybe MetaValue
_  -> []
        calibreFields :: [(Text, Text)]
calibreFields = case Text -> Meta -> Maybe MetaValue
lookupMeta Text
"calibre" Meta
meta of
                            Just (MetaMap Map Text MetaValue
mp)
                               -> forall k a. Map k a -> [(k, a)]
M.toList forall a b. (a -> b) -> a -> b
$ forall a b k. (a -> b) -> Map k a -> Map k b
M.map MetaValue -> Text
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 :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m ByteString
writeEPUB2 = 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 :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m ByteString
writeEPUB3 = 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 :: forall (m :: * -> *).
PandocMonad m =>
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
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ((Char -> Bool) -> Text -> Bool
T.all (\Char
c -> Char -> Bool
isAscii Char
c Bool -> Bool -> Bool
&& Char -> Bool
isAlphaNum Char
c) Text
epubSubdir) forall a b. (a -> b) -> a -> b
$
    forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ Text -> PandocError
PandocEpubSubdirectoryError Text
epubSubdir
  let initState :: EPUBState
initState = EPUBState { stMediaPaths :: [(String, (String, Maybe Entry))]
stMediaPaths = []
                            , stMediaNextId :: Int
stMediaNextId = Int
0
                            , stEpubSubdir :: String
stEpubSubdir = Text -> String
T.unpack Text
epubSubdir }
  forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (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 :: forall (m :: * -> *).
PandocMonad m =>
EPUBVersion -> WriterOptions -> Pandoc -> E m ByteString
pandocToEPUB EPUBVersion
version WriterOptions
opts Pandoc
doc = do
  let doc' :: Pandoc
doc' = Pandoc -> Pandoc
ensureValidXmlIdentifiers Pandoc
doc
  -- handle pictures
  Pandoc Meta
meta [Block]
blocks <- forall a b (m :: * -> *).
(Walkable a b, Monad m, Applicative m, Functor m) =>
(a -> m a) -> b -> m b
walkM (forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> E m Inline
transformInline WriterOptions
opts) Pandoc
doc' forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                        forall a b (m :: * -> *).
(Walkable a b, Monad m, Applicative m, Functor m) =>
(a -> m a) -> b -> m b
walkM forall (m :: * -> *). PandocMonad m => Block -> E m Block
transformBlock
  [Entry]
picEntries <- forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets EPUBState -> [(String, (String, Maybe Entry))]
stMediaPaths

  String
epubSubdir <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets EPUBState -> String
stEpubSubdir
  let epub3 :: Bool
epub3 = EPUBVersion
version forall a. Eq a => a -> a -> Bool
== EPUBVersion
EPUB3

  let writeHtml :: WriterOptions -> Pandoc -> f ByteString
writeHtml WriterOptions
o = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> ByteString
UTF8.fromTextLazy forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
TL.fromStrict) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                      forall (m :: * -> *).
PandocMonad m =>
EPUBVersion -> WriterOptions -> Pandoc -> m Text
writeHtmlStringForEPUB EPUBVersion
version WriterOptions
o
  EPUBMetadata
metadata <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Meta -> E m EPUBMetadata
getEPUBMetadata WriterOptions
opts Meta
meta

  -- retrieve title of document
  let plainTitle :: Text
      plainTitle :: Text
plainTitle = case Meta -> [Inline]
docTitle' Meta
meta of
                        [] -> case EPUBMetadata -> [Title]
epubTitle EPUBMetadata
metadata of
                                   []    -> Text
"UNTITLED"
                                   (Title
x:[Title]
_) -> Title -> Text
titleText Title
x
                        [Inline]
x  -> 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]]) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                               forall (m :: * -> *). PandocMonad m => String -> m ByteString
readDataFile String
"epub.css"
                      [String]
fs -> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *). PandocMonad m => String -> m ByteString
P.readFileLazy [String]
fs
  [Entry]
stylesheetEntries <- forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM
        (\ByteString
bs Int
n -> forall (m :: * -> *).
PandocMonad m =>
String -> ByteString -> E m Entry
mkEntry (String
"styles/stylesheet" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
n forall a. [a] -> [a] -> [a]
++ String
".css") ByteString
bs)
        [ByteString]
stylesheets [(Int
1 :: Int)..]

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

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

  -- Add additional options for the writer
  let opts' :: WriterOptions
      opts' :: WriterOptions
opts' = WriterOptions
opts{ writerEmailObfuscation :: ObfuscationMethod
writerEmailObfuscation = ObfuscationMethod
NoObfuscation
                  , writerSectionDivs :: Bool
writerSectionDivs = Bool
True
                  , writerVariables :: Context Text
writerVariables = Context Text
vars
                  , writerWrapText :: WrapOption
writerWrapText = WrapOption
WrapAuto }

  -- cover page
  ([Entry]
cpgEntry, [Entry]
cpicEntry) <- forall (m :: * -> *).
PandocMonad m =>
Meta
-> EPUBMetadata
-> WriterOptions
-> Context Text
-> (Bool -> Context Text)
-> (WriterOptions -> Pandoc -> m ByteString)
-> Text
-> StateT EPUBState m ([Entry], [Entry])
createCoverPage Meta
meta EPUBMetadata
metadata WriterOptions
opts' Context Text
vars Bool -> Context Text
cssvars forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m ByteString
writeHtml Text
plainTitle

  -- title page
  ByteString
tpContent <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m ByteString
writeHtml WriterOptions
opts'{
                                  writerVariables :: Context Text
writerVariables =
                                      forall a. Map Text (Val a) -> Context a
Context (forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [
                                        (Text
"titlepage", Text -> Val Text
toVal' Text
"true"),
                                        (Text
"body-type",  Text -> Val Text
toVal' Text
"frontmatter"),
                                        (Text
"pagetitle", forall a b. ToContext a b => b -> Val a
toVal forall a b. (a -> b) -> a -> b
$
                                            Text -> Text
escapeStringForXML Text
plainTitle)])
                                      forall a. Semigroup a => a -> a -> a
<> Bool -> Context Text
cssvars Bool
True forall a. Semigroup a => a -> a -> a
<> Context Text
vars }
                               (Meta -> [Block] -> Pandoc
Pandoc Meta
meta [])
  Entry
tpEntry <- 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 <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). PandocMonad m => String -> m [String]
P.glob String
f
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
xs) forall a b. (a -> b) -> a -> b
$
          forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report forall a b. (a -> b) -> a -> b
$ Text -> Text -> LogMessage
CouldNotFetchResource (String -> Text
T.pack String
f) Text
"glob did not match any font files"
        forall (m :: * -> *) a. Monad m => a -> m a
return [String]
xs

  let mkFontEntry :: PandocMonad m => FilePath -> StateT EPUBState m Entry
      mkFontEntry :: forall (m :: * -> *).
PandocMonad m =>
String -> StateT EPUBState m Entry
mkFontEntry String
f = forall (m :: * -> *).
PandocMonad m =>
String -> ByteString -> E m Entry
mkEntry (String
"fonts/" forall a. [a] -> [a] -> [a]
++ ShowS
takeFileName String
f) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
                        forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall (m :: * -> *). PandocMonad m => String -> m ByteString
P.readFileLazy String
f)
  [String]
fontFiles <- forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall {t :: (* -> *) -> * -> *} {m :: * -> *}.
(MonadTrans t, PandocMonad m, PandocMonad (t m)) =>
String -> t m [String]
matchingGlob (WriterOptions -> [String]
writerEpubFonts WriterOptions
opts')
  [Entry]
fontEntries <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *).
PandocMonad m =>
String -> StateT EPUBState m Entry
mkFontEntry [String]
fontFiles

  -- body pages

  -- add level 1 header to beginning if none there
  let blocks' :: [Block]
blocks' = WriterOptions -> [Block] -> [Block]
addIdentifiers WriterOptions
opts
                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) forall a. a -> [a] -> [a]
: [Block]
blocks

  -- create the chapters
  let chunkedDoc :: ChunkedDoc
chunkedDoc = PathTemplate -> Bool -> Maybe Int -> Int -> Pandoc -> ChunkedDoc
splitIntoChunks PathTemplate
"ch%n.xhtml"
                     (WriterOptions -> Bool
writerNumberSections WriterOptions
opts)
                     forall a. Maybe a
Nothing
                     (WriterOptions -> Int
writerSplitLevel WriterOptions
opts)
                     (Meta -> [Block] -> Pandoc
Pandoc Meta
meta [Block]
blocks')


  -- Create the chapter entries from the chapters.
  -- Also requires access to the extended writer options and context
  -- as well as the css Context and html writer
  [Entry]
chapterEntries <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions
-> Context Text
-> (Bool -> Context Text)
-> (WriterOptions -> Pandoc -> StateT EPUBState m ByteString)
-> [Chunk]
-> StateT EPUBState m [Entry]
createChapterEntries WriterOptions
opts' Context Text
vars Bool -> Context Text
cssvars forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m ByteString
writeHtml
                      (ChunkedDoc -> [Chunk]
chunkedChunks ChunkedDoc
chunkedDoc)



  -- contents.opf

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

  -- incredibly inefficient (TODO):
  let containsMathML :: Entry -> Bool
containsMathML Entry
ent = Bool
epub3 Bool -> Bool -> Bool
&&
                           String
"<math" 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" 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] forall a. [a] -> [a] -> [a]
++ [a
"svg" | Entry -> Bool
containsSVG Entry
ent]

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

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

  -- The tocTitle is either the normal title or a specially configured title.
  let tocTitle :: Text
tocTitle = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
plainTitle
                   MetaValue -> Text
metaValueToString forall a b. (a -> b) -> a -> b
$ Text -> Meta -> Maybe MetaValue
lookupMeta Text
"toc-title" Meta
meta
  UTCTime
currentTime <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). PandocMonad m => m UTCTime
P.getTimestamp

  -- Construct the contentsData
  let contentsData :: ByteString
contentsData = Text -> ByteString
UTF8.fromTextLazy forall a b. (a -> b) -> a -> b
$ Text -> Text
TL.fromStrict forall a b. (a -> b) -> a -> b
$ Element -> Text
ppTopElement forall a b. (a -> b) -> a -> b
$
        forall t. Node t => Text -> t -> Element
unode Text
"package" forall t. (t -> Element) -> [(Text, Text)] -> t -> Element
!
          ([(Text
"version", case EPUBVersion
version of
                             EPUBVersion
EPUB2 -> Text
"2.0"
                             EPUBVersion
EPUB3 -> Text
"3.0")
           ,(Text
"xmlns",Text
"http://www.idpf.org/2007/opf")
           ,(Text
"unique-identifier",Text
"epub-id-1")
           ] forall a. [a] -> [a] -> [a]
++
           [(Text
"prefix",Text
"ibooks: http://vocabulary.itunes.apple.com/rdf/ibooks/vocabulary-extensions-1.0/") | EPUBVersion
version forall a. Eq a => a -> a -> Bool
== EPUBVersion
EPUB3]) forall a b. (a -> b) -> a -> b
$
          [ EPUBVersion -> EPUBMetadata -> UTCTime -> Element
metadataElement EPUBVersion
version EPUBMetadata
metadata UTCTime
currentTime
          , forall t. Node t => Text -> t -> Element
unode Text
"manifest" forall a b. (a -> b) -> a -> b
$
             [ forall t. Node t => Text -> t -> Element
unode Text
"item" forall t. (t -> Element) -> [(Text, Text)] -> t -> Element
! [(Text
"id",Text
"ncx"), (Text
"href",Text
"toc.ncx")
                              ,(Text
"media-type",Text
"application/x-dtbncx+xml")] forall a b. (a -> b) -> a -> b
$ ()
             , forall t. Node t => Text -> t -> Element
unode Text
"item" forall t. (t -> Element) -> [(Text, Text)] -> t -> Element
! ([(Text
"id",Text
"nav")
                               ,(Text
"href",Text
"nav.xhtml")
                               ,(Text
"media-type",Text
"application/xhtml+xml")] forall a. [a] -> [a] -> [a]
++
                               [(Text
"properties",Text
"nav") | Bool
epub3 ]) forall a b. (a -> b) -> a -> b
$ ()
             ] forall a. [a] -> [a] -> [a]
++
             [ forall t. Node t => Text -> t -> Element
unode Text
"item" forall t. (t -> Element) -> [(Text, Text)] -> t -> Element
! [(Text
"id",Text
"stylesheet" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow Int
n)
                              , (Text
"href", String -> Text
T.pack String
fp)
                              ,(Text
"media-type",Text
"text/css")] forall a b. (a -> b) -> a -> b
$ () |
                             (Int
n :: Int, String
fp) <- forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1..] (forall a b. (a -> b) -> [a] -> [b]
map
                               (String -> ShowS
makeRelative String
epubSubdir forall b c a. (b -> c) -> (a -> b) -> a -> c
. Entry -> String
eRelativePath)
                               [Entry]
stylesheetEntries) ] forall a. [a] -> [a] -> [a]
++
             forall a b. (a -> b) -> [a] -> [b]
map Entry -> Element
chapterNode ([Entry]
cpgEntry forall a. [a] -> [a] -> [a]
++
                               [Entry
tpEntry | WriterOptions -> Bool
writerEpubTitlePage WriterOptions
opts] forall a. [a] -> [a] -> [a]
++
                               [Entry]
chapterEntries) forall a. [a] -> [a] -> [a]
++
             (case [Entry]
cpicEntry of
                    []    -> []
                    (Entry
x:[Entry]
_) -> [[Attr] -> Element -> Element
add_attrs
                              [QName -> Text -> Attr
Attr (Text -> QName
unqual Text
"properties") Text
"cover-image" | Bool
epub3]
                              (Entry -> Element
pictureNode Entry
x)]) forall a. [a] -> [a] -> [a]
++
             forall a b. (a -> b) -> [a] -> [b]
map Entry -> Element
pictureNode [Entry]
picEntries forall a. [a] -> [a] -> [a]
++
             forall a b. (a -> b) -> [a] -> [b]
map Entry -> Element
fontNode [Entry]
fontEntries
          , forall t. Node t => Text -> t -> Element
unode Text
"spine" forall t. (t -> Element) -> [(Text, Text)] -> t -> Element
! (
             (Text
"toc",Text
"ncx") forall a. a -> [a] -> [a]
: [(Text, Text)]
progressionDirection) forall a b. (a -> b) -> a -> b
$
              case EPUBMetadata -> Maybe String
epubCoverImage EPUBMetadata
metadata of
                    Maybe String
Nothing -> []
                    Just String
_ -> [ forall t. Node t => Text -> t -> Element
unode Text
"itemref" forall t. (t -> Element) -> [(Text, Text)] -> t -> Element
!
                                [(Text
"idref", Text
"cover_xhtml")] forall a b. (a -> b) -> a -> b
$ () ]
              forall a. [a] -> [a] -> [a]
++ ([forall t. Node t => Text -> t -> Element
unode Text
"itemref" forall t. (t -> Element) -> [(Text, Text)] -> t -> Element
! [(Text
"idref", Text
"title_page_xhtml")
                                     ,(Text
"linear",
                                         case Text -> Meta -> Maybe MetaValue
lookupMeta Text
"title" Meta
meta of
                                               Just MetaValue
_  -> Text
"yes"
                                               Maybe MetaValue
Nothing -> Text
"no")] forall a b. (a -> b) -> a -> b
$ ()
                     | WriterOptions -> Bool
writerEpubTitlePage WriterOptions
opts] forall a. [a] -> [a] -> [a]
++
                  [forall t. Node t => Text -> t -> Element
unode Text
"itemref" forall t. (t -> Element) -> [(Text, Text)] -> t -> Element
! [(Text
"idref", Text
"nav")] forall a b. (a -> b) -> a -> b
$ ()
                         | WriterOptions -> Bool
writerTableOfContents WriterOptions
opts ] forall a. [a] -> [a] -> [a]
++
                  forall a b. (a -> b) -> [a] -> [b]
map Entry -> Element
chapterRefNode [Entry]
chapterEntries)
          , forall t. Node t => Text -> t -> Element
unode Text
"guide" forall a b. (a -> b) -> a -> b
$
             (forall t. Node t => Text -> t -> Element
unode Text
"reference" forall t. (t -> Element) -> [(Text, Text)] -> t -> Element
!
                 [(Text
"type",Text
"toc"),(Text
"title", Text
tocTitle),
                  (Text
"href",Text
"nav.xhtml")] forall a b. (a -> b) -> a -> b
$ ()
             ) forall a. a -> [a] -> [a]
:
             [ forall t. Node t => Text -> t -> Element
unode Text
"reference" forall t. (t -> Element) -> [(Text, Text)] -> t -> Element
!
                   [(Text
"type",Text
"cover")
                   ,(Text
"title",Text
"Cover")
                   ,(Text
"href",Text
"text/cover.xhtml")] forall a b. (a -> b) -> a -> b
$ ()
               | forall a. Maybe a -> Bool
isJust (EPUBMetadata -> Maybe String
epubCoverImage EPUBMetadata
metadata)
             ]
          ]
  -- Content should be stored in content.opf
  Entry
contentsEntry <- forall (m :: * -> *).
PandocMonad m =>
String -> ByteString -> E m Entry
mkEntry String
"content.opf" ByteString
contentsData

  -- toc.ncx
  -- Create the tocEntry from the metadata together with the sections and title.
  Entry
tocEntry <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions
-> Meta
-> EPUBMetadata
-> Text
-> Tree SecInfo
-> StateT EPUBState m Entry
createTocEntry WriterOptions
opts' Meta
meta EPUBMetadata
metadata Text
plainTitle
                (ChunkedDoc -> Tree SecInfo
chunkedTOC ChunkedDoc
chunkedDoc)

  -- Create the navEntry using the metadata, all of the various writer options,
  -- the CSS and HTML helpers, the document and toc title as well as the epub version and all of the sections
  Entry
navEntry <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions
-> Meta
-> EPUBMetadata
-> Context Text
-> (Bool -> Context Text)
-> (WriterOptions -> Pandoc -> m ByteString)
-> Text
-> EPUBVersion
-> Tree SecInfo
-> StateT EPUBState m Entry
createNavEntry WriterOptions
opts' Meta
meta EPUBMetadata
metadata Context Text
vars Bool -> Context Text
cssvars
                forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m ByteString
writeHtml Text
tocTitle EPUBVersion
version (ChunkedDoc -> Tree SecInfo
chunkedTOC ChunkedDoc
chunkedDoc)

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

  -- container.xml
  let containerData :: ByteString
containerData = ByteString -> ByteString
B.fromStrict forall a b. (a -> b) -> a -> b
$ Text -> ByteString
UTF8.fromText forall a b. (a -> b) -> a -> b
$ Element -> Text
ppTopElement forall a b. (a -> b) -> a -> b
$
       forall t. Node t => Text -> t -> Element
unode Text
"container" forall t. (t -> Element) -> [(Text, Text)] -> t -> Element
! [(Text
"version",Text
"1.0")
              ,(Text
"xmlns",Text
"urn:oasis:names:tc:opendocument:xmlns:container")] forall a b. (a -> b) -> a -> b
$
         forall t. Node t => Text -> t -> Element
unode Text
"rootfiles" forall a b. (a -> b) -> a -> b
$
           forall t. Node t => Text -> t -> Element
unode Text
"rootfile" forall t. (t -> Element) -> [(Text, Text)] -> t -> Element
! [(Text
"full-path",
                    (if forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
epubSubdir
                        then Text
""
                        else String -> Text
T.pack String
epubSubdir forall a. Semigroup a => a -> a -> a
<> Text
"/") forall a. Semigroup a => a -> a -> a
<> Text
"content.opf")
               ,(Text
"media-type",Text
"application/oebps-package+xml")] forall a b. (a -> b) -> a -> b
$ ()
  Entry
containerEntry <- 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 = ByteString -> ByteString
B.fromStrict forall a b. (a -> b) -> a -> b
$ Text -> ByteString
UTF8.fromText forall a b. (a -> b) -> a -> b
$ Element -> Text
ppTopElement forall a b. (a -> b) -> a -> b
$
        forall t. Node t => Text -> t -> Element
unode Text
"display_options" forall a b. (a -> b) -> a -> b
$
          forall t. Node t => Text -> t -> Element
unode Text
"platform" forall t. (t -> Element) -> [(Text, Text)] -> t -> Element
! [(Text
"name",Text
"*")] forall a b. (a -> b) -> a -> b
$
            forall t. Node t => Text -> t -> Element
unode Text
"option" forall t. (t -> Element) -> [(Text, Text)] -> t -> Element
! [(Text
"name",Text
"specified-fonts")] forall a b. (a -> b) -> a -> b
$ (Text
"true" :: Text)
  Entry
appleEntry <- 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 = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Entry -> Archive -> Archive
addEntryToArchive Archive
emptyArchive forall a b. (a -> b) -> a -> b
$
                 [Entry
mimetypeEntry, Entry
containerEntry, Entry
appleEntry,
                  Entry
contentsEntry, Entry
tocEntry, Entry
navEntry] forall a. [a] -> [a] -> [a]
++
                  [Entry
tpEntry | WriterOptions -> Bool
writerEpubTitlePage WriterOptions
opts] forall a. [a] -> [a] -> [a]
++
                  [Entry]
stylesheetEntries forall a. [a] -> [a] -> [a]
++ [Entry]
picEntries forall a. [a] -> [a] -> [a]
++ [Entry]
cpicEntry forall a. [a] -> [a] -> [a]
++
                  [Entry]
cpgEntry forall a. [a] -> [a] -> [a]
++ [Entry]
chapterEntries forall a. [a] -> [a] -> [a]
++ [Entry]
fontEntries
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Archive -> ByteString
fromArchive Archive
archive

-- | Function used during conversion from pandoc to EPUB to create the cover page.
-- The first Entry list is for the cover while the second one is for the cover image.
-- If no cover images are specified, empty lists will be returned.
createCoverPage :: PandocMonad m =>
                   Meta
                   -> EPUBMetadata
                   -> WriterOptions
                   -> Context Text
                   -> (Bool -> Context Text)
                   -> (WriterOptions -> Pandoc -> m B8.ByteString)
                   -> Text
                   -> StateT EPUBState m ([Entry], [Entry])
createCoverPage :: forall (m :: * -> *).
PandocMonad m =>
Meta
-> EPUBMetadata
-> WriterOptions
-> Context Text
-> (Bool -> Context Text)
-> (WriterOptions -> Pandoc -> m ByteString)
-> Text
-> StateT EPUBState m ([Entry], [Entry])
createCoverPage Meta
meta EPUBMetadata
metadata WriterOptions
opts' Context Text
vars Bool -> Context Text
cssvars WriterOptions -> Pandoc -> m ByteString
writeHtml Text
plainTitle =
    case EPUBMetadata -> Maybe String
epubCoverImage EPUBMetadata
metadata of
        Maybe String
Nothing   -> forall (m :: * -> *) a. Monad m => a -> m a
return ([],[])
        Just String
img  -> do
          let fp :: String
fp = ShowS
takeFileName String
img
          -- retrieve cover image file
          [String]
mediaPaths <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall b c a. (b -> c) -> (a -> b) -> a -> c
. EPUBState -> [(String, (String, Maybe Entry))]
stMediaPaths)
          String
coverImageName <-  -- see #4206
                if (String
"media/" forall a. Semigroup a => a -> a -> a
<> String
fp) forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
mediaPaths
                  then forall (m :: * -> *). PandocMonad m => String -> E m String
getMediaNextNewName (ShowS
takeExtension String
fp)
                  else forall (m :: * -> *) a. Monad m => a -> m a
return String
fp
          -- image dimensions
          ByteString
imgContent <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ 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  -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ImageSize -> (Integer, Integer)
sizeInPixels ImageSize
sz
                  Left Text
err' -> (Integer
0, Integer
0) forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report
                    (Text -> Text -> LogMessage
CouldNotDetermineImageSize (String -> Text
T.pack String
img) Text
err')
          -- write the HTML. Use the cssvars, vars and additional writer options.
          ByteString
cpContent <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ WriterOptions -> Pandoc -> m ByteString
writeHtml
                WriterOptions
opts'{ writerVariables :: Context Text
writerVariables =
                      forall a. Map Text (Val a) -> Context a
Context (forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [
                        (Text
"coverpage", Text -> Val Text
toVal' Text
"true"),
                        (Text
"pagetitle", forall a b. ToContext a b => b -> Val a
toVal forall a b. (a -> b) -> a -> b
$
                          Text -> Text
escapeStringForXML Text
plainTitle),
                        (Text
"cover-image",
                          Text -> Val Text
toVal' forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
coverImageName),
                        (Text
"cover-image-width", Text -> Val Text
toVal' forall a b. (a -> b) -> a -> b
$
                          forall a. Show a => a -> Text
tshow Integer
coverImageWidth),
                        (Text
"cover-image-height", Text -> Val Text
toVal' forall a b. (a -> b) -> a -> b
$
                          forall a. Show a => a -> Text
tshow Integer
coverImageHeight)]) forall a. Semigroup a => a -> a -> a
<>
                        Bool -> Context Text
cssvars Bool
True forall a. Semigroup a => a -> a -> a
<> Context Text
vars }
                (Meta -> [Block] -> Pandoc
Pandoc Meta
meta [])

          Entry
coverEntry <- forall (m :: * -> *).
PandocMonad m =>
String -> ByteString -> E m Entry
mkEntry String
"text/cover.xhtml" ByteString
cpContent
          Entry
coverImageEntry <- forall (m :: * -> *).
PandocMonad m =>
String -> ByteString -> E m Entry
mkEntry (String
"media/" forall a. [a] -> [a] -> [a]
++ String
coverImageName)
                                ByteString
imgContent

          forall (m :: * -> *) a. Monad m => a -> m a
return ( [ Entry
coverEntry ], [ Entry
coverImageEntry ] )

-- | Converts the given chapters to entries using the writeHtml function
-- and the various provided options
createChapterEntries :: PandocMonad m =>
                            WriterOptions
                            -> Context Text
                            -> (Bool -> Context Text)
                            -> (WriterOptions -> Pandoc -> StateT EPUBState m B8.ByteString)
                            -> [Chunk]
                            -> StateT EPUBState m [Entry]
createChapterEntries :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions
-> Context Text
-> (Bool -> Context Text)
-> (WriterOptions -> Pandoc -> StateT EPUBState m ByteString)
-> [Chunk]
-> StateT EPUBState m [Entry]
createChapterEntries WriterOptions
opts' Context Text
vars Bool -> Context Text
cssvars WriterOptions -> Pandoc -> StateT EPUBState m ByteString
writeHtml [Chunk]
chapters = do
  -- Create an entry from the chapter with the provided number.
  -- chapToEntry :: Int -> Chapter -> StateT EPUBState m Entry
  let chapToEntry :: Int -> Chunk -> StateT EPUBState m Entry
chapToEntry Int
num Chunk
chunk =
        forall (m :: * -> *).
PandocMonad m =>
String -> ByteString -> E m Entry
mkEntry (String
"text/" forall a. [a] -> [a] -> [a]
++ Chunk -> String
chunkPath Chunk
chunk) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
        -- Combine all provided options
        WriterOptions -> Pandoc -> StateT EPUBState m ByteString
writeHtml WriterOptions
opts'{ writerVariables :: Context Text
writerVariables =
                            forall a. Map Text (Val a) -> Context a
Context (forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
                                     [(Text
"body-type", Text -> Val Text
toVal' Text
bodyType),
                                      (Text
"pagetitle", Text -> Val Text
toVal' forall a b. (a -> b) -> a -> b
$
                                           Int -> Text
showChapter Int
num)])
                            forall a. Semigroup a => a -> a -> a
<> Bool -> Context Text
cssvars Bool
True forall a. Semigroup a => a -> a -> a
<> Context Text
vars } Pandoc
pdoc
         where bs :: [Block]
bs = Chunk -> [Block]
chunkContents Chunk
chunk
               meta' :: Meta
meta' = forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
setMeta Text
"title" (forall a. [a] -> Many a
fromList
                         (forall a b. Walkable a b => (a -> a) -> b -> b
walk Inline -> Inline
removeNote
                          (Chunk -> [Inline]
chunkHeading Chunk
chunk))) Meta
nullMeta
               (Pandoc
pdoc, Text
bodyType) =
                 case [Block]
bs of
                     (Div (Text
_,Text
"section":[Text]
_,[(Text, Text)]
kvs) [Block]
_ : [Block]
_) ->
                       -- remove notes or we get doubled footnotes
                       (Meta -> [Block] -> Pandoc
Pandoc Meta
meta' [Block]
bs,
                        -- Check if the chapters belongs to the frontmatter,
                        -- backmatter of bodymatter defaulting to the body
                        case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"epub:type" [(Text, Text)]
kvs of
                             Maybe Text
Nothing -> Text
"bodymatter"
                             Just Text
x
                               | Text
x forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
frontMatterTypes -> Text
"frontmatter"
                               | Text
x forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
backMatterTypes  -> Text
"backmatter"
                               | Bool
otherwise                 -> Text
"bodymatter")
                     [Block]
_                   -> (Meta -> [Block] -> Pandoc
Pandoc Meta
meta' [Block]
bs, Text
"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
"frontispiece",
                                   Text
"seriespage", Text
"titlepage"]
               backMatterTypes :: [Text]
backMatterTypes = [Text
"appendix", Text
"colophon", Text
"bibliography",
                                  Text
"index"]

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

createTocEntry :: PandocMonad m =>
                  WriterOptions
               -> Meta
               -> EPUBMetadata
               -> Text
               -> Tree SecInfo
               -> StateT EPUBState m Entry
createTocEntry :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions
-> Meta
-> EPUBMetadata
-> Text
-> Tree SecInfo
-> StateT EPUBState m Entry
createTocEntry WriterOptions
opts Meta
meta EPUBMetadata
metadata Text
plainTitle (Node SecInfo
_ [Tree SecInfo]
secs) = do
  let mkNavPoint :: Tree SecInfo -> State Int (Maybe Element)
      mkNavPoint :: Tree SecInfo -> State Int (Maybe Element)
mkNavPoint (Node SecInfo
secinfo [Tree SecInfo]
subsecs)
        | SecInfo -> Int
secLevel SecInfo
secinfo forall a. Ord a => a -> a -> Bool
> WriterOptions -> Int
writerTOCDepth WriterOptions
opts = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
        | Bool
otherwise = do
          Int
n <- forall s (m :: * -> *). MonadState s m => m s
get
          forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (forall a. Num a => a -> a -> a
+ Int
1)
          [Element]
subs <- forall a. [Maybe a] -> [a]
catMaybes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Tree SecInfo -> State Int (Maybe Element)
mkNavPoint [Tree SecInfo]
subsecs
          let secnum' :: Text
secnum' = case SecInfo -> Maybe Text
secNumber SecInfo
secinfo of
                          Just Text
t -> Text
t forall a. Semigroup a => a -> a -> a
<> Text
" "
                          Maybe Text
Nothing -> Text
""
          let title' :: Text
title' = Text
secnum' forall a. Semigroup a => a -> a -> a
<> forall a. Walkable Inline a => a -> Text
stringify (SecInfo -> [Inline]
secTitle SecInfo
secinfo)
          forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall t. Node t => Text -> t -> Element
unode Text
"navPoint" forall t. (t -> Element) -> [(Text, Text)] -> t -> Element
!
                   [(Text
"id", Text
"navPoint-" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow Int
n)] forall a b. (a -> b) -> a -> b
$
                      [ forall t. Node t => Text -> t -> Element
unode Text
"navLabel" forall a b. (a -> b) -> a -> b
$ forall t. Node t => Text -> t -> Element
unode Text
"text" Text
title'
                      , forall t. Node t => Text -> t -> Element
unode Text
"content" forall t. (t -> Element) -> [(Text, Text)] -> t -> Element
!
                          [(Text
"src", Text
"text/" forall a. Semigroup a => a -> a -> a
<> SecInfo -> Text
secPath SecInfo
secinfo)] forall a b. (a -> b) -> a -> b
$ ()
                      ] forall a. [a] -> [a] -> [a]
++ [Element]
subs

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

  let navMap :: [Element]
navMap = forall s a. State s a -> s -> a
evalState (forall a. [Maybe a] -> [a]
catMaybes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Tree SecInfo -> State Int (Maybe Element)
mkNavPoint [Tree SecInfo]
secs) Int
1

  Text
uuid <- case EPUBMetadata -> [Identifier]
epubIdentifier EPUBMetadata
metadata of
          (Identifier
x:[Identifier]
_) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Identifier -> Text
identifierText Identifier
x  -- use first identifier as UUID
          []    -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ Text -> PandocError
PandocShouldNeverHappenError Text
"epubIdentifier is null"  -- shouldn't happen
  let tocData :: ByteString
tocData = ByteString -> ByteString
B.fromStrict forall a b. (a -> b) -> a -> b
$ Text -> ByteString
UTF8.fromText forall a b. (a -> b) -> a -> b
$ Element -> Text
ppTopElement forall a b. (a -> b) -> a -> b
$
        forall t. Node t => Text -> t -> Element
unode Text
"ncx" forall t. (t -> Element) -> [(Text, Text)] -> t -> Element
! [(Text
"version",Text
"2005-1")
                       ,(Text
"xmlns",Text
"http://www.daisy.org/z3986/2005/ncx/")] forall a b. (a -> b) -> a -> b
$
          [ forall t. Node t => Text -> t -> Element
unode Text
"head" forall a b. (a -> b) -> a -> b
$
             [ forall t. Node t => Text -> t -> Element
unode Text
"meta" forall t. (t -> Element) -> [(Text, Text)] -> t -> Element
! [(Text
"name",Text
"dtb:uid")
                              ,(Text
"content", Text
uuid)] forall a b. (a -> b) -> a -> b
$ ()
             , forall t. Node t => Text -> t -> Element
unode Text
"meta" forall t. (t -> Element) -> [(Text, Text)] -> t -> Element
! [(Text
"name",Text
"dtb:depth")
                              ,(Text
"content", Text
"1")] forall a b. (a -> b) -> a -> b
$ ()
             , forall t. Node t => Text -> t -> Element
unode Text
"meta" forall t. (t -> Element) -> [(Text, Text)] -> t -> Element
! [(Text
"name",Text
"dtb:totalPageCount")
                              ,(Text
"content", Text
"0")] forall a b. (a -> b) -> a -> b
$ ()
             , forall t. Node t => Text -> t -> Element
unode Text
"meta" forall t. (t -> Element) -> [(Text, Text)] -> t -> Element
! [(Text
"name",Text
"dtb:maxPageNumber")
                              ,(Text
"content", Text
"0")] forall a b. (a -> b) -> a -> b
$ ()
             ] forall a. [a] -> [a] -> [a]
++ case EPUBMetadata -> Maybe String
epubCoverImage EPUBMetadata
metadata of
                        Maybe String
Nothing  -> []
                        Just String
img -> [forall t. Node t => Text -> t -> Element
unode Text
"meta" forall t. (t -> Element) -> [(Text, Text)] -> t -> Element
! [(Text
"name",Text
"cover"),
                                            (Text
"content", String -> Text
toId String
img)] forall a b. (a -> b) -> a -> b
$ ()]
          , forall t. Node t => Text -> t -> Element
unode Text
"docTitle" forall a b. (a -> b) -> a -> b
$ forall t. Node t => Text -> t -> Element
unode Text
"text" Text
plainTitle
          , forall t. Node t => Text -> t -> Element
unode Text
"navMap" forall a b. (a -> b) -> a -> b
$ [Element
tpNode | WriterOptions -> Bool
writerEpubTitlePage WriterOptions
opts] forall a. [a] -> [a] -> [a]
++ [Element]
navMap
          ]
  forall (m :: * -> *).
PandocMonad m =>
String -> ByteString -> E m Entry
mkEntry String
"toc.ncx" ByteString
tocData


createNavEntry  :: PandocMonad m
                => WriterOptions
                -> Meta
                -> EPUBMetadata
                -> Context Text
                -> (Bool -> Context Text)
                -> (WriterOptions -> Pandoc -> m B8.ByteString)
                -> Text
                -> EPUBVersion
                -> Tree SecInfo
                -> StateT EPUBState m Entry
createNavEntry :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions
-> Meta
-> EPUBMetadata
-> Context Text
-> (Bool -> Context Text)
-> (WriterOptions -> Pandoc -> m ByteString)
-> Text
-> EPUBVersion
-> Tree SecInfo
-> StateT EPUBState m Entry
createNavEntry WriterOptions
opts Meta
meta EPUBMetadata
metadata
               Context Text
vars Bool -> Context Text
cssvars WriterOptions -> Pandoc -> m ByteString
writeHtml Text
tocTitle EPUBVersion
version (Node SecInfo
_ [Tree SecInfo]
secs) = do
  let mkItem :: Tree SecInfo -> State Int (Maybe Element)
      mkItem :: Tree SecInfo -> State Int (Maybe Element)
mkItem (Node SecInfo
secinfo [Tree SecInfo]
subsecs)
        | SecInfo -> Int
secLevel SecInfo
secinfo forall a. Ord a => a -> a -> Bool
> WriterOptions -> Int
writerTOCDepth WriterOptions
opts = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
        | Bool
otherwise = do
          Int
n <- forall s (m :: * -> *). MonadState s m => m s
get
          forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (forall a. Num a => a -> a -> a
+ Int
1)
          [Element]
subs <- forall a. [Maybe a] -> [a]
catMaybes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Tree SecInfo -> State Int (Maybe Element)
mkItem [Tree SecInfo]
subsecs
          let secnum' :: [Inline]
secnum' = case SecInfo -> Maybe Text
secNumber SecInfo
secinfo of
                          Just Text
num -> [Attr -> [Inline] -> Inline
Span (Text
"", [Text
"section-header-number"], [])
                                       [Text -> Inline
Str Text
num] , Inline
Space]
                          Maybe Text
Nothing -> []
          let title' :: [Inline]
title' = [Inline]
secnum' forall a. Semigroup a => a -> a -> a
<> SecInfo -> [Inline]
secTitle SecInfo
secinfo
          -- can't have <a> elements inside generated links...
          let 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 titRendered :: Text
titRendered = case forall a. PandocPure a -> Either PandocError a
P.runPure
                                  (forall (m :: * -> *).
PandocMonad m =>
EPUBVersion -> WriterOptions -> Pandoc -> m Text
writeHtmlStringForEPUB EPUBVersion
version
                                    WriterOptions
opts{ writerTemplate :: Maybe (Template Text)
writerTemplate = forall a. Maybe a
Nothing }
                                    (Meta -> [Block] -> Pandoc
Pandoc Meta
nullMeta
                                      [[Inline] -> Block
Plain forall a b. (a -> b) -> a -> b
$ forall a b. Walkable a b => (a -> a) -> b -> b
walk Inline -> Inline
clean [Inline]
title'])) of
                                  Left PandocError
_  -> forall a. Walkable Inline a => a -> Text
stringify [Inline]
title'
                                  Right Text
x -> Text
x
          let titElements :: [Content]
titElements = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const []) forall a. a -> a
id forall a b. (a -> b) -> a -> b
$
                                  Text -> Either Text [Content]
parseXMLContents (Text -> Text
TL.fromStrict Text
titRendered)

          forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall t. Node t => Text -> t -> Element
unode Text
"li" forall t. (t -> Element) -> [(Text, Text)] -> t -> Element
!
                   [(Text
"id", Text
"toc-li-" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow Int
n)] forall a b. (a -> b) -> a -> b
$
                      (forall t. Node t => Text -> t -> Element
unode Text
"a" forall t. (t -> Element) -> [(Text, Text)] -> t -> Element
!
                        [(Text
"href", Text
"text/" forall a. Semigroup a => a -> a -> a
<> SecInfo -> Text
secPath SecInfo
secinfo)]
                        forall a b. (a -> b) -> a -> b
$ [Content]
titElements)
                       forall a. a -> [a] -> [a]
: case [Element]
subs of
                           [] -> []
                           (Element
_:[Element]
_) -> [forall t. Node t => Text -> t -> Element
unode Text
"ol" forall t. (t -> Element) -> [(Text, Text)] -> t -> Element
! [(Text
"class",Text
"toc")] forall a b. (a -> b) -> a -> b
$ [Element]
subs]

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

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

showDateTimeISO8601 :: UTCTime -> Text
showDateTimeISO8601 :: UTCTime -> Text
showDateTimeISO8601 = String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%FT%TZ"

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

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

getMediaNextNewName :: PandocMonad m => FilePath -> E m FilePath
getMediaNextNewName :: forall (m :: * -> *). PandocMonad m => String -> E m String
getMediaNextNewName String
ext = do
  Int
nextId <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets EPUBState -> Int
stMediaNextId
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \EPUBState
st -> EPUBState
st { stMediaNextId :: Int
stMediaNextId = Int
nextId forall a. Num a => a -> a -> a
+ Int
1 }
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String
"file" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
nextId forall a. [a] -> [a] -> [a]
++ String
ext

isHtmlFormat :: Format -> Bool
isHtmlFormat :: Format -> Bool
isHtmlFormat (Format Text
"html") = Bool
True
isHtmlFormat (Format Text
"html4") = Bool
True
isHtmlFormat (Format Text
"html5") = Bool
True
isHtmlFormat Format
_ = Bool
False

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

transformInline  :: PandocMonad m
                 => WriterOptions
                 -> Inline
                 -> E m Inline
transformInline :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> E m Inline
transformInline WriterOptions
_opts (Image attr :: Attr
attr@(Text
_,[Text]
_,[(Text, Text)]
kvs) [Inline]
lab (Text
src,Text
tit))
  | forall a. Maybe a -> Bool
isNothing (forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"external" [(Text, Text)]
kvs) = do
    Text
newsrc <- forall (m :: * -> *). PandocMonad m => String -> E m Text
modifyMediaRef forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
src
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Attr -> [Inline] -> (Text, Text) -> Inline
Image Attr
attr [Inline]
lab (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 <- forall (m :: * -> *). PandocMonad m => String -> E m Text
modifyMediaRef (Text -> String
T.unpack (Text
url forall a. Semigroup a => a -> a -> a
<> Text -> Text
urlEncode Text
m))
    let mathclass :: Text
mathclass = if MathType
t forall a. Eq a => a -> a -> Bool
== MathType
DisplayMath then Text
"display" else Text
"inline"
    forall (m :: * -> *) a. Monad m => a -> m a
return 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
"../" forall a. Semigroup a => a -> a -> a
<> Text
newsrc, Text
"")]
transformInline WriterOptions
_opts (RawInline Format
fmt Text
raw)
  | Format -> Bool
isHtmlFormat Format
fmt = do
  let tags :: [Tag Text]
tags = forall str. StringLike str => str -> [Tag str]
parseTags Text
raw
  [Tag Text]
tags' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *). PandocMonad m => Tag Text -> E m (Tag Text)
transformTag [Tag Text]
tags
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Format -> Text -> Inline
RawInline Format
fmt ([Tag Text] -> Text
renderTags' [Tag Text]
tags')
transformInline WriterOptions
_ Inline
x = forall (m :: * -> *) a. Monad m => a -> m a
return Inline
x

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

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 | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Text -> Text -> Bool
`T.isPrefixOf` Text
y) [Text]
mediaPrefixes -> forall a. a -> Maybe a
Just Text
y
    Maybe Text
_      -> forall a. Maybe a
Nothing

-- Returns filename for chapter number.
showChapter :: Int -> Text
showChapter :: Int -> Text
showChapter = String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall s a. State s a -> s -> a
evalState (forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall {m :: * -> *}. MonadState (Set Text) m => Block -> m Block
go [Block]
bs) 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 <- forall s (m :: * -> *). MonadState s m => m s
get
         let ident' :: Text
ident' = if Text -> Bool
T.null Text
ident
                         then Extensions -> [Inline] -> Set Text -> Text
uniqueIdent (WriterOptions -> Extensions
writerExtensions WriterOptions
opts) [Inline]
ils Set Text
ids
                         else Text
ident
         forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> Set a -> Set a
Set.insert Text
ident'
         forall (m :: * -> *) a. Monad m => a -> m a
return 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 = forall (m :: * -> *) a. Monad m => a -> m a
return Block
x

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

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

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

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

docTitle' :: Meta -> [Inline]
docTitle' :: Meta -> [Inline]
docTitle' Meta
meta = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] MetaValue -> [Inline]
go 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 forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
"type" Map Text MetaValue
m of
                   Just MetaValue
x | forall a. Walkable Inline a => a -> Text
stringify MetaValue
x forall a. Eq a => a -> a -> Bool
== Text
"main" ->
                              forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] MetaValue -> [Inline]
go forall a b. (a -> b) -> a -> b
$ 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) = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap MetaValue -> [Inline]
go [MetaValue]
xs
        go MetaValue
_ = []