{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
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(..))
newtype Chapter = Chapter [Block]
deriving (Int -> Chapter -> ShowS
[Chapter] -> ShowS
Chapter -> String
(Int -> Chapter -> ShowS)
-> (Chapter -> String) -> ([Chapter] -> ShowS) -> Show Chapter
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Chapter -> ShowS
showsPrec :: Int -> Chapter -> ShowS
$cshow :: Chapter -> String
show :: Chapter -> String
$cshowList :: [Chapter] -> ShowS
showList :: [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)]
, EPUBMetadata -> [Text]
epubAccessModes :: [Text]
, EPUBMetadata -> [Text]
epubAccessModeSufficient :: [Text]
, EPUBMetadata -> [Text]
epubAccessibilityFeatures :: [Text]
, EPUBMetadata -> [Text]
epubAccessibilityHazards :: [Text]
, EPUBMetadata -> Maybe Text
epubAccessibilitySummary :: Maybe Text
} deriving Int -> EPUBMetadata -> ShowS
[EPUBMetadata] -> ShowS
EPUBMetadata -> String
(Int -> EPUBMetadata -> ShowS)
-> (EPUBMetadata -> String)
-> ([EPUBMetadata] -> ShowS)
-> Show EPUBMetadata
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EPUBMetadata -> ShowS
showsPrec :: Int -> EPUBMetadata -> ShowS
$cshow :: EPUBMetadata -> String
show :: EPUBMetadata -> String
$cshowList :: [EPUBMetadata] -> ShowS
showList :: [EPUBMetadata] -> ShowS
Show
data Date = Date{
Date -> Text
dateText :: Text
, Date -> Maybe Text
dateEvent :: Maybe Text
} deriving Int -> Date -> ShowS
[Date] -> ShowS
Date -> String
(Int -> Date -> ShowS)
-> (Date -> String) -> ([Date] -> ShowS) -> Show Date
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Date -> ShowS
showsPrec :: Int -> Date -> ShowS
$cshow :: Date -> String
show :: Date -> String
$cshowList :: [Date] -> ShowS
showList :: [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
(Int -> Creator -> ShowS)
-> (Creator -> String) -> ([Creator] -> ShowS) -> Show Creator
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Creator -> ShowS
showsPrec :: Int -> Creator -> ShowS
$cshow :: Creator -> String
show :: Creator -> String
$cshowList :: [Creator] -> ShowS
showList :: [Creator] -> ShowS
Show
data Identifier = Identifier{
Identifier -> Text
identifierText :: Text
, Identifier -> Maybe Text
identifierScheme :: Maybe Text
} deriving Int -> Identifier -> ShowS
[Identifier] -> ShowS
Identifier -> String
(Int -> Identifier -> ShowS)
-> (Identifier -> String)
-> ([Identifier] -> ShowS)
-> Show Identifier
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Identifier -> ShowS
showsPrec :: Int -> Identifier -> ShowS
$cshow :: Identifier -> String
show :: Identifier -> String
$cshowList :: [Identifier] -> ShowS
showList :: [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
(Int -> Title -> ShowS)
-> (Title -> String) -> ([Title] -> ShowS) -> Show Title
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Title -> ShowS
showsPrec :: Int -> Title -> ShowS
$cshow :: Title -> String
show :: Title -> String
$cshowList :: [Title] -> ShowS
showList :: [Title] -> ShowS
Show
data ProgressionDirection = LTR | RTL deriving Int -> ProgressionDirection -> ShowS
[ProgressionDirection] -> ShowS
ProgressionDirection -> String
(Int -> ProgressionDirection -> ShowS)
-> (ProgressionDirection -> String)
-> ([ProgressionDirection] -> ShowS)
-> Show ProgressionDirection
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ProgressionDirection -> ShowS
showsPrec :: Int -> ProgressionDirection -> ShowS
$cshow :: ProgressionDirection -> String
show :: ProgressionDirection -> String
$cshowList :: [ProgressionDirection] -> ShowS
showList :: [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
(Int -> Subject -> ShowS)
-> (Subject -> String) -> ([Subject] -> ShowS) -> Show Subject
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Subject -> ShowS
showsPrec :: Int -> Subject -> ShowS
$cshow :: Subject -> String
show :: Subject -> String
$cshowList :: [Subject] -> ShowS
showList :: [Subject] -> ShowS
Show
dcName :: Text -> QName
dcName :: Text -> QName
dcName Text
n = Text -> Maybe Text -> Maybe Text -> QName
QName Text
n Maybe Text
forall a. Maybe a
Nothing (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"dc")
dcNode :: Node t => Text -> t -> Element
dcNode :: forall t. Node t => Text -> t -> Element
dcNode = QName -> t -> Element
forall t. Node t => QName -> t -> Element
node (QName -> t -> Element) -> (Text -> QName) -> Text -> t -> Element
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 Maybe Text
forall a. Maybe a
Nothing (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"opf")
toId :: FilePath -> Text
toId :: String -> Text
toId = String -> Text
T.pack (String -> Text) -> ShowS -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map (\Char
x -> if Char -> Bool
isAlphaNum Char
x Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_'
then Char
x
else Char
'_') ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
takeFileName
removeNote :: Inline -> Inline
removeNote :: Inline -> Inline
removeNote (Note [Block]
_) = Text -> Inline
Str Text
""
removeNote Inline
x = Inline
x
toVal' :: Text -> Val T.Text
toVal' :: Text -> Val Text
toVal' = Text -> Val Text
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 <- (EPUBState -> String) -> StateT EPUBState m String
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets EPUBState -> String
stEpubSubdir
let addEpubSubdir :: Entry -> Entry
addEpubSubdir :: Entry -> Entry
addEpubSubdir Entry
e = Entry
e{ eRelativePath =
(if null epubSubdir
then ""
else epubSubdir ++ "/") ++ eRelativePath e }
Integer
epochtime <- POSIXTime -> Integer
forall b. Integral b => POSIXTime -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (POSIXTime -> Integer)
-> StateT EPUBState m POSIXTime -> StateT EPUBState m Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m POSIXTime -> StateT EPUBState m POSIXTime
forall (m :: * -> *) a. Monad m => m a -> StateT EPUBState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m POSIXTime
forall (m :: * -> *). PandocMonad m => m POSIXTime
P.getPOSIXTime
Entry -> E m Entry
forall a. a -> StateT EPUBState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Entry -> E m Entry) -> Entry -> E m Entry
forall a b. (a -> b) -> a -> b
$
(if String
path String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"mimetype" Bool -> Bool -> Bool
|| String
"META-INF" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
path
then Entry -> Entry
forall a. a -> a
id
else Entry -> Entry
addEpubSubdir) (Entry -> Entry) -> Entry -> Entry
forall a b. (a -> b) -> a -> b
$ String -> Integer -> ByteString -> Entry
toEntry String
path Integer
epochtime ByteString
content
getEPUBMetadata :: PandocMonad m => WriterOptions -> Meta -> E m EPUBMetadata
getEPUBMetadata :: 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 -> [Element] -> StateT EPUBState m [Element]
forall a. a -> StateT EPUBState m a
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 -> PandocError -> StateT EPUBState m [Element]
forall a. PandocError -> StateT EPUBState m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError -> StateT EPUBState m [Element])
-> PandocError -> StateT EPUBState m [Element]
forall a b. (a -> b) -> a -> b
$
Text -> Text -> PandocError
PandocXMLError Text
"epub metadata" Text
msg
Right [Content]
ns -> [Element] -> StateT EPUBState m [Element]
forall a. a -> StateT EPUBState m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Content] -> [Element]
onlyElems [Content]
ns)
let md' :: EPUBMetadata
md' = (Element -> EPUBMetadata -> EPUBMetadata)
-> EPUBMetadata -> [Element] -> EPUBMetadata
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Element -> EPUBMetadata -> EPUBMetadata
addMetadataFromXML EPUBMetadata
md [Element]
elts
let addIdentifier :: EPUBMetadata -> m EPUBMetadata
addIdentifier EPUBMetadata
m =
if [Identifier] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (EPUBMetadata -> [Identifier]
epubIdentifier EPUBMetadata
m)
then do
UUID
randomId <- m UUID
forall (m :: * -> *). PandocMonad m => m UUID
getRandomUUID
EPUBMetadata -> m EPUBMetadata
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (EPUBMetadata -> m EPUBMetadata) -> EPUBMetadata -> m EPUBMetadata
forall a b. (a -> b) -> a -> b
$ EPUBMetadata
m{ epubIdentifier = [Identifier (tshow randomId) Nothing] }
else EPUBMetadata -> m EPUBMetadata
forall a. a -> m a
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 Text -> Context Text -> Maybe Text
forall a b. FromContext a b => Text -> Context a -> Maybe b
lookupContext Text
"lang" (WriterOptions -> Context Text
writerVariables WriterOptions
opts) of
Just Text
x -> EPUBMetadata -> t m EPUBMetadata
forall a. a -> t m a
forall (m :: * -> *) a. Monad m => a -> m a
return EPUBMetadata
m{ epubLanguage = x }
Maybe Text
Nothing -> do
Maybe Text
mLang <- m (Maybe Text) -> t m (Maybe Text)
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Maybe Text) -> t m (Maybe Text))
-> m (Maybe Text) -> t m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> m (Maybe Text)
forall (m :: * -> *). PandocMonad m => Text -> m (Maybe Text)
P.lookupEnv Text
"LANG"
let localeLang :: Text
localeLang =
case Maybe Text
mLang of
Just Text
lang ->
(Char -> Char) -> Text -> Text
T.map (\Char
c -> if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_' then Char
'-' else Char
c) (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$
(Char -> Bool) -> Text -> Text
T.takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'.') Text
lang
Maybe Text
Nothing -> Text
"en-US"
EPUBMetadata -> t m EPUBMetadata
forall a. a -> t m a
forall (m :: * -> *) a. Monad m => a -> m a
return EPUBMetadata
m{ epubLanguage = localeLang }
else EPUBMetadata -> t m EPUBMetadata
forall a. a -> t m a
forall (m :: * -> *) a. Monad m => a -> m a
return EPUBMetadata
m
let fixDate :: EPUBMetadata -> t m EPUBMetadata
fixDate EPUBMetadata
m =
if [Date] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (EPUBMetadata -> [Date]
epubDate EPUBMetadata
m)
then do
UTCTime
currentTime <- m UTCTime -> t m UTCTime
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m UTCTime
forall (m :: * -> *). PandocMonad m => m UTCTime
P.getTimestamp
EPUBMetadata -> t m EPUBMetadata
forall a. a -> t m a
forall (m :: * -> *) a. Monad m => a -> m a
return (EPUBMetadata -> t m EPUBMetadata)
-> EPUBMetadata -> t m EPUBMetadata
forall a b. (a -> b) -> a -> b
$ EPUBMetadata
m{ epubDate = [ Date{
dateText = showDateTimeISO8601 currentTime
, dateEvent = Nothing } ] }
else EPUBMetadata -> t m EPUBMetadata
forall a. a -> t m a
forall (m :: * -> *) a. Monad m => a -> m a
return EPUBMetadata
m
let addAuthor :: EPUBMetadata -> m EPUBMetadata
addAuthor EPUBMetadata
m =
if (Creator -> Bool) -> [Creator] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\Creator
c -> Creator -> Maybe Text
creatorRole Creator
c Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"aut") ([Creator] -> Bool) -> [Creator] -> Bool
forall a b. (a -> b) -> a -> b
$ EPUBMetadata -> [Creator]
epubCreator EPUBMetadata
m
then EPUBMetadata -> m EPUBMetadata
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return EPUBMetadata
m
else do
let authors' :: [Text]
authors' = ([Inline] -> Text) -> [[Inline]] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map [Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify ([[Inline]] -> [Text]) -> [[Inline]] -> [Text]
forall a b. (a -> b) -> a -> b
$ Meta -> [[Inline]]
docAuthors Meta
meta
let toAuthor :: Text -> Creator
toAuthor Text
name = Creator{ creatorText :: Text
creatorText = Text
name
, creatorRole :: Maybe Text
creatorRole = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"aut"
, creatorFileAs :: Maybe Text
creatorFileAs = Maybe Text
forall a. Maybe a
Nothing }
EPUBMetadata -> m EPUBMetadata
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (EPUBMetadata -> m EPUBMetadata) -> EPUBMetadata -> m EPUBMetadata
forall a b. (a -> b) -> a -> b
$ EPUBMetadata
m{ epubCreator = map toAuthor authors' ++ epubCreator m }
EPUBMetadata -> E m EPUBMetadata
forall {m :: * -> *}.
PandocMonad m =>
EPUBMetadata -> m EPUBMetadata
addIdentifier EPUBMetadata
md' E m EPUBMetadata
-> (EPUBMetadata -> E m EPUBMetadata) -> E m EPUBMetadata
forall a b.
StateT EPUBState m a
-> (a -> StateT EPUBState m b) -> StateT EPUBState m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= EPUBMetadata -> E m EPUBMetadata
forall {t :: (* -> *) -> * -> *} {m :: * -> *}.
(MonadTrans t, Monad (t m), PandocMonad m) =>
EPUBMetadata -> t m EPUBMetadata
fixDate E m EPUBMetadata
-> (EPUBMetadata -> E m EPUBMetadata) -> E m EPUBMetadata
forall a b.
StateT EPUBState m a
-> (a -> StateT EPUBState m b) -> StateT EPUBState m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= EPUBMetadata -> E m EPUBMetadata
forall {m :: * -> *}. Monad m => EPUBMetadata -> m EPUBMetadata
addAuthor E m EPUBMetadata
-> (EPUBMetadata -> E m EPUBMetadata) -> E m EPUBMetadata
forall a b.
StateT EPUBState m a
-> (a -> StateT EPUBState m b) -> StateT EPUBState m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= EPUBMetadata -> E m EPUBMetadata
forall {t :: (* -> *) -> * -> *} {m :: * -> *}.
(MonadTrans t, Monad (t m), PandocMonad m) =>
EPUBMetadata -> t m EPUBMetadata
addLanguage
addMetadataFromXML :: Element -> EPUBMetadata -> EPUBMetadata
addMetadataFromXML :: Element -> EPUBMetadata -> EPUBMetadata
addMetadataFromXML e :: Element
e@(Element (QName Text
name Maybe Text
_ (Just Text
"dc")) [Attr]
attrs [Content]
_ Maybe Integer
_) EPUBMetadata
md
| Text
name Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"identifier" = EPUBMetadata
md{ epubIdentifier =
Identifier{ identifierText = strContent e
, identifierScheme = lookupAttr (opfName "scheme") attrs
} : epubIdentifier md }
| Text
name Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"title" = EPUBMetadata
md{ epubTitle =
Title{ titleText = strContent e
, titleFileAs = getAttr "file-as"
, titleType = getAttr "type"
} : epubTitle md }
| Text
name Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"date" = EPUBMetadata
md{ epubDate =
Date{ dateText = fromMaybe "" $ normalizeDate' $ strContent e
, dateEvent = getAttr "event"
} : epubDate md }
| Text
name Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"language" = EPUBMetadata
md{ epubLanguage = strContent e }
| Text
name Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"creator" = EPUBMetadata
md{ epubCreator =
Creator{ creatorText = strContent e
, creatorRole = getAttr "role"
, creatorFileAs = getAttr "file-as"
} : epubCreator md }
| Text
name Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"contributor" = EPUBMetadata
md{ epubContributor =
Creator { creatorText = strContent e
, creatorRole = getAttr "role"
, creatorFileAs = getAttr "file-as"
} : epubContributor md }
| Text
name Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"subject" = EPUBMetadata
md{ epubSubject =
Subject { subjectText = strContent e
, subjectAuthority = getAttr "authority"
, subjectTerm = getAttr "term"
} : epubSubject md }
| Text
name Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"description" = EPUBMetadata
md { epubDescription = Just $ strContent e }
| Text
name Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"type" = EPUBMetadata
md { epubType = Just $ strContent e }
| Text
name Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"format" = EPUBMetadata
md { epubFormat = Just $ strContent e }
| Text
name Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"publisher" = EPUBMetadata
md { epubPublisher = Just $ strContent e }
| Text
name Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"source" = EPUBMetadata
md { epubSource = Just $ strContent e }
| Text
name Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"relation" = EPUBMetadata
md { epubRelation = Just $ strContent e }
| Text
name Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"coverage" = EPUBMetadata
md { epubCoverage = Just $ strContent e }
| Text
name Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"rights" = EPUBMetadata
md { epubRights = Just $ strContent e }
| Text
name Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"belongs-to-collection" = EPUBMetadata
md { epubBelongsToCollection = Just $ strContent e }
| Text
name Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"group-position" = EPUBMetadata
md { epubGroupPosition = Just $ strContent 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" Maybe Text -> Maybe Text -> Maybe Text
forall a. Maybe a -> Maybe a -> Maybe a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Text -> Maybe Text
getAttr Text
"name" of
Just Text
s | Text
"ibooks:" Text -> Text -> Bool
`T.isPrefixOf` Text
s ->
EPUBMetadata
md{ epubIbooksFields = (T.drop 7 s, strContent e) :
epubIbooksFields md }
| Text
"calibre:" Text -> Text -> Bool
`T.isPrefixOf` Text
s ->
EPUBMetadata
md{ epubCalibreFields =
(T.drop 8 s, fromMaybe "" $ getAttr "content") :
epubCalibreFields 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) = [Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify [Inline]
ils
metaValueToString (MetaBlocks [Block]
bs) = [Block] -> Text
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) = (MetaValue -> String) -> [MetaValue] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> String
T.unpack (Text -> String) -> (MetaValue -> Text) -> MetaValue -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MetaValue -> Text
metaValueToString) [MetaValue]
xs
metaValueToPaths MetaValue
x = [Text -> String
T.unpack (Text -> String) -> Text -> String
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) -> (MetaValue -> a) -> [MetaValue] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map MetaValue -> a
handleMetaValue [MetaValue]
xs
Just MetaValue
mv -> [MetaValue -> a
handleMetaValue MetaValue
mv]
Maybe MetaValue
Nothing -> []
getIdentifier :: Meta -> [Identifier]
getIdentifier :: Meta -> [Identifier]
getIdentifier Meta
meta = Text -> Meta -> (MetaValue -> Identifier) -> [Identifier]
forall a. Text -> Meta -> (MetaValue -> a) -> [a]
getList Text
"identifier" Meta
meta MetaValue -> Identifier
handleMetaValue
where handleMetaValue :: MetaValue -> Identifier
handleMetaValue (MetaMap Map Text MetaValue
m) =
Identifier{ identifierText :: Text
identifierText = Text -> (MetaValue -> Text) -> Maybe MetaValue -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" MetaValue -> Text
metaValueToString
(Maybe MetaValue -> Text) -> Maybe MetaValue -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Map Text MetaValue -> Maybe MetaValue
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
"text" Map Text MetaValue
m
, identifierScheme :: Maybe Text
identifierScheme = MetaValue -> Text
metaValueToString (MetaValue -> Text) -> Maybe MetaValue -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
Text -> Map Text MetaValue -> Maybe MetaValue
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
"scheme" Map Text MetaValue
m }
handleMetaValue MetaValue
mv = Text -> Maybe Text -> Identifier
Identifier (MetaValue -> Text
metaValueToString MetaValue
mv) Maybe Text
forall a. Maybe a
Nothing
getTitle :: Meta -> [Title]
getTitle :: Meta -> [Title]
getTitle Meta
meta = Text -> Meta -> (MetaValue -> Title) -> [Title]
forall a. Text -> Meta -> (MetaValue -> a) -> [a]
getList Text
"title" Meta
meta MetaValue -> Title
handleMetaValue
where handleMetaValue :: MetaValue -> Title
handleMetaValue (MetaMap Map Text MetaValue
m) =
Title{ titleText :: Text
titleText = Text -> (MetaValue -> Text) -> Maybe MetaValue -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" MetaValue -> Text
metaValueToString (Maybe MetaValue -> Text) -> Maybe MetaValue -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Map Text MetaValue -> Maybe MetaValue
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
"text" Map Text MetaValue
m
, titleFileAs :: Maybe Text
titleFileAs = MetaValue -> Text
metaValueToString (MetaValue -> Text) -> Maybe MetaValue -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Map Text MetaValue -> Maybe MetaValue
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
"file-as" Map Text MetaValue
m
, titleType :: Maybe Text
titleType = MetaValue -> Text
metaValueToString (MetaValue -> Text) -> Maybe MetaValue -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Map Text MetaValue -> Maybe MetaValue
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
"type" Map Text MetaValue
m }
handleMetaValue MetaValue
mv = Text -> Maybe Text -> Maybe Text -> Title
Title (MetaValue -> Text
metaValueToString MetaValue
mv) Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing
getCreator :: T.Text -> Meta -> [Creator]
getCreator :: Text -> Meta -> [Creator]
getCreator Text
s Meta
meta = Text -> Meta -> (MetaValue -> Creator) -> [Creator]
forall a. Text -> Meta -> (MetaValue -> a) -> [a]
getList Text
s Meta
meta MetaValue -> Creator
handleMetaValue
where handleMetaValue :: MetaValue -> Creator
handleMetaValue (MetaMap Map Text MetaValue
m) =
Creator{ creatorText :: Text
creatorText = Text -> (MetaValue -> Text) -> Maybe MetaValue -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" MetaValue -> Text
metaValueToString (Maybe MetaValue -> Text) -> Maybe MetaValue -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Map Text MetaValue -> Maybe MetaValue
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
"text" Map Text MetaValue
m
, creatorFileAs :: Maybe Text
creatorFileAs = MetaValue -> Text
metaValueToString (MetaValue -> Text) -> Maybe MetaValue -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Map Text MetaValue -> Maybe MetaValue
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
"file-as" Map Text MetaValue
m
, creatorRole :: Maybe Text
creatorRole = MetaValue -> Text
metaValueToString (MetaValue -> Text) -> Maybe MetaValue -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Map Text MetaValue -> Maybe MetaValue
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
"role" Map Text MetaValue
m }
handleMetaValue MetaValue
mv = Text -> Maybe Text -> Maybe Text -> Creator
Creator (MetaValue -> Text
metaValueToString MetaValue
mv) Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing
getDate :: T.Text -> Meta -> [Date]
getDate :: Text -> Meta -> [Date]
getDate Text
s Meta
meta = Text -> Meta -> (MetaValue -> Date) -> [Date]
forall a. Text -> Meta -> (MetaValue -> a) -> [a]
getList Text
s Meta
meta MetaValue -> Date
handleMetaValue
where handleMetaValue :: MetaValue -> Date
handleMetaValue (MetaMap Map Text MetaValue
m) =
Date{ dateText :: Text
dateText = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$
Text -> Map Text MetaValue -> Maybe MetaValue
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
"text" Map Text MetaValue
m Maybe MetaValue -> (MetaValue -> Maybe Text) -> Maybe Text
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe Text
normalizeDate' (Text -> Maybe Text)
-> (MetaValue -> Text) -> MetaValue -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MetaValue -> Text
metaValueToString
, dateEvent :: Maybe Text
dateEvent = MetaValue -> Text
metaValueToString (MetaValue -> Text) -> Maybe MetaValue -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Map Text MetaValue -> Maybe MetaValue
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
"event" Map Text MetaValue
m }
handleMetaValue MetaValue
mv = Date { dateText :: Text
dateText = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
normalizeDate' (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ MetaValue -> Text
metaValueToString MetaValue
mv
, dateEvent :: Maybe Text
dateEvent = Maybe Text
forall a. Maybe a
Nothing }
getSubject :: T.Text -> Meta -> [Subject]
getSubject :: Text -> Meta -> [Subject]
getSubject Text
s Meta
meta = Text -> Meta -> (MetaValue -> Subject) -> [Subject]
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 = Text -> (MetaValue -> Text) -> Maybe MetaValue -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" MetaValue -> Text
metaValueToString (Maybe MetaValue -> Text) -> Maybe MetaValue -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Map Text MetaValue -> Maybe MetaValue
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
"text" Map Text MetaValue
m
, subjectAuthority :: Maybe Text
subjectAuthority = MetaValue -> Text
metaValueToString (MetaValue -> Text) -> Maybe MetaValue -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Map Text MetaValue -> Maybe MetaValue
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
"authority" Map Text MetaValue
m
, subjectTerm :: Maybe Text
subjectTerm = MetaValue -> Text
metaValueToString (MetaValue -> Text) -> Maybe MetaValue -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Map Text MetaValue -> Maybe MetaValue
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
"term" Map Text MetaValue
m }
handleMetaValue MetaValue
mv = Text -> Maybe Text -> Maybe Text -> Subject
Subject (MetaValue -> Text
metaValueToString MetaValue
mv) Maybe Text
forall a. Maybe a
Nothing Maybe Text
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
, epubAccessModes :: [Text]
epubAccessModes = [Text]
accessModes
, epubAccessModeSufficient :: [Text]
epubAccessModeSufficient = [Text]
accessModeSufficient
, epubAccessibilityFeatures :: [Text]
epubAccessibilityFeatures = [Text]
accessibilityFeatures
, epubAccessibilityHazards :: [Text]
epubAccessibilityHazards = [Text]
accessibilityHazards
, epubAccessibilitySummary :: Maybe Text
epubAccessibilitySummary = Maybe Text
accessibilitySummary
}
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 = Text -> (MetaValue -> Text) -> Maybe MetaValue -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" MetaValue -> Text
metaValueToString (Maybe MetaValue -> Text) -> Maybe MetaValue -> Text
forall a b. (a -> b) -> a -> b
$
Text -> Meta -> Maybe MetaValue
lookupMeta Text
"language" Meta
meta Maybe MetaValue -> Maybe MetaValue -> Maybe MetaValue
forall a. Maybe a -> Maybe a -> Maybe a
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 (MetaValue -> Text) -> Maybe MetaValue -> Maybe Text
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 (MetaValue -> Text) -> Maybe MetaValue -> Maybe Text
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 (MetaValue -> Text) -> Maybe MetaValue -> Maybe Text
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 (MetaValue -> Text) -> Maybe MetaValue -> Maybe Text
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 (MetaValue -> Text) -> Maybe MetaValue -> Maybe Text
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 (MetaValue -> Text) -> Maybe MetaValue -> Maybe Text
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 (MetaValue -> Text) -> Maybe MetaValue -> Maybe Text
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 (MetaValue -> Text) -> Maybe MetaValue -> Maybe Text
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 (MetaValue -> Text) -> Maybe MetaValue -> Maybe Text
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 (MetaValue -> Text) -> Maybe MetaValue -> Maybe Text
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 (Text -> String) -> Maybe Text -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
Text -> Context Text -> Maybe Text
forall a b. FromContext a b => Text -> Context a -> Maybe b
lookupContext Text
"epub-cover-image" (WriterOptions -> Context Text
writerVariables WriterOptions
opts)
Maybe Text -> Maybe Text -> Maybe Text
forall a. Maybe a -> Maybe a -> Maybe a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` (MetaValue -> Text
metaValueToString (MetaValue -> Text) -> Maybe MetaValue -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Meta -> Maybe MetaValue
lookupMeta Text
"cover-image" Meta
meta)
mCss :: Maybe MetaValue
mCss = Text -> Meta -> Maybe MetaValue
lookupMeta Text
"css" Meta
meta Maybe MetaValue -> Maybe MetaValue -> Maybe MetaValue
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Meta -> Maybe MetaValue
lookupMeta Text
"stylesheet" Meta
meta
stylesheets :: [String]
stylesheets = [String] -> (MetaValue -> [String]) -> Maybe MetaValue -> [String]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] MetaValue -> [String]
metaValueToPaths Maybe MetaValue
mCss [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
case Text -> Context Text -> Maybe [Text]
forall a b. FromContext a b => Text -> Context a -> Maybe b
lookupContext Text
"css" (WriterOptions -> Context Text
writerVariables WriterOptions
opts) of
Just [Text]
xs -> (Text -> String) -> [Text] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Text -> String
T.unpack [Text]
xs
Maybe [Text]
Nothing ->
case Text -> Context Text -> Maybe Text
forall a b. FromContext a b => Text -> Context a -> Maybe b
lookupContext Text
"css" (WriterOptions -> Context Text
writerVariables WriterOptions
opts) of
Just Text
x -> [Text -> String
T.unpack Text
x]
Maybe Text
Nothing -> []
pageDirection :: Maybe ProgressionDirection
pageDirection = case Text -> Text
T.toLower (Text -> Text) -> (MetaValue -> Text) -> MetaValue -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MetaValue -> Text
metaValueToString (MetaValue -> Text) -> Maybe MetaValue -> Maybe Text
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" -> ProgressionDirection -> Maybe ProgressionDirection
forall a. a -> Maybe a
Just ProgressionDirection
LTR
Just Text
"rtl" -> ProgressionDirection -> Maybe ProgressionDirection
forall a. a -> Maybe a
Just ProgressionDirection
RTL
Maybe Text
_ -> Maybe ProgressionDirection
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)
-> Map Text Text -> [(Text, Text)]
forall k a. Map k a -> [(k, a)]
M.toList (Map Text Text -> [(Text, Text)])
-> Map Text Text -> [(Text, Text)]
forall a b. (a -> b) -> a -> b
$ (MetaValue -> Text) -> Map Text MetaValue -> Map Text Text
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)
-> Map Text Text -> [(Text, Text)]
forall k a. Map k a -> [(k, a)]
M.toList (Map Text Text -> [(Text, Text)])
-> Map Text Text -> [(Text, Text)]
forall a b. (a -> b) -> a -> b
$ (MetaValue -> Text) -> Map Text MetaValue -> Map Text Text
forall a b k. (a -> b) -> Map k a -> Map k b
M.map MetaValue -> Text
metaValueToString Map Text MetaValue
mp
Maybe MetaValue
_ -> []
accessModes :: [Text]
accessModes = case Text -> Meta -> Maybe MetaValue
lookupMeta Text
"accessModes" Meta
meta of
Just (MetaList [MetaValue]
xs) -> (MetaValue -> Text) -> [MetaValue] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map MetaValue -> Text
metaValueToString [MetaValue]
xs
Maybe MetaValue
_ -> [Text
"textual"]
accessModeSufficient :: [Text]
accessModeSufficient = case Text -> Meta -> Maybe MetaValue
lookupMeta Text
"accessModeSufficient" Meta
meta of
Just (MetaList [MetaValue]
xs) -> (MetaValue -> Text) -> [MetaValue] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map MetaValue -> Text
metaValueToString [MetaValue]
xs
Maybe MetaValue
_ -> [Text
"textual"]
accessibilityFeatures :: [Text]
accessibilityFeatures =
case Text -> Meta -> Maybe MetaValue
lookupMeta Text
"accessibilityFeatures" Meta
meta of
Just (MetaList [MetaValue]
xs) -> (MetaValue -> Text) -> [MetaValue] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map MetaValue -> Text
metaValueToString [MetaValue]
xs
Maybe MetaValue
_ -> [Text
"alternativeText", Text
"readingOrder",
Text
"structuralNavigation", Text
"tableOfContents"]
accessibilityHazards :: [Text]
accessibilityHazards =
case Text -> Meta -> Maybe MetaValue
lookupMeta Text
"accessibilityHazards" Meta
meta of
Just (MetaList [MetaValue]
xs) -> (MetaValue -> Text) -> [MetaValue] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map MetaValue -> Text
metaValueToString [MetaValue]
xs
Maybe MetaValue
_ -> [Text
"none"]
accessibilitySummary :: Maybe Text
accessibilitySummary = MetaValue -> Text
metaValueToString (MetaValue -> Text) -> Maybe MetaValue -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Meta -> Maybe MetaValue
lookupMeta Text
"accessibilitySummary" Meta
meta
writeEPUB2 :: PandocMonad m
=> WriterOptions
-> Pandoc
-> m B.ByteString
writeEPUB2 :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m ByteString
writeEPUB2 = EPUBVersion -> WriterOptions -> Pandoc -> m ByteString
forall (m :: * -> *).
PandocMonad m =>
EPUBVersion -> WriterOptions -> Pandoc -> m ByteString
writeEPUB EPUBVersion
EPUB2
writeEPUB3 :: PandocMonad m
=> WriterOptions
-> Pandoc
-> m B.ByteString
writeEPUB3 :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m ByteString
writeEPUB3 = EPUBVersion -> WriterOptions -> Pandoc -> m ByteString
forall (m :: * -> *).
PandocMonad m =>
EPUBVersion -> WriterOptions -> Pandoc -> m ByteString
writeEPUB EPUBVersion
EPUB3
writeEPUB :: PandocMonad m
=> EPUBVersion
-> WriterOptions
-> Pandoc
-> 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
Bool -> m () -> m ()
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) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
PandocError -> m ()
forall a. PandocError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError -> m ()) -> PandocError -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> PandocError
PandocEpubSubdirectoryError Text
epubSubdir
let initState :: EPUBState
initState = EPUBState { stMediaPaths :: [(String, (String, Maybe Entry))]
stMediaPaths = []
, stMediaNextId :: Int
stMediaNextId = Int
0
, stEpubSubdir :: String
stEpubSubdir = Text -> String
T.unpack Text
epubSubdir }
StateT EPUBState m ByteString -> EPUBState -> m ByteString
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (EPUBVersion
-> WriterOptions -> Pandoc -> StateT EPUBState m ByteString
forall (m :: * -> *).
PandocMonad m =>
EPUBVersion -> WriterOptions -> Pandoc -> E m ByteString
pandocToEPUB EPUBVersion
epubVersion WriterOptions
opts Pandoc
doc) EPUBState
initState
pandocToEPUB :: PandocMonad m
=> EPUBVersion
-> WriterOptions
-> Pandoc
-> E m B.ByteString
pandocToEPUB :: 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
Pandoc Meta
meta [Block]
blocks <- (Inline -> StateT EPUBState m Inline)
-> Pandoc -> StateT EPUBState m Pandoc
forall a b (m :: * -> *).
(Walkable a b, Monad m, Applicative m, Functor m) =>
(a -> m a) -> b -> m b
forall (m :: * -> *).
(Monad m, Applicative m, Functor m) =>
(Inline -> m Inline) -> Pandoc -> m Pandoc
walkM (WriterOptions -> Inline -> StateT EPUBState m Inline
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> E m Inline
transformInline WriterOptions
opts) Pandoc
doc' StateT EPUBState m Pandoc
-> (Pandoc -> StateT EPUBState m Pandoc)
-> StateT EPUBState m Pandoc
forall a b.
StateT EPUBState m a
-> (a -> StateT EPUBState m b) -> StateT EPUBState m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
(Block -> StateT EPUBState m Block)
-> Pandoc -> StateT EPUBState m Pandoc
forall a b (m :: * -> *).
(Walkable a b, Monad m, Applicative m, Functor m) =>
(a -> m a) -> b -> m b
forall (m :: * -> *).
(Monad m, Applicative m, Functor m) =>
(Block -> m Block) -> Pandoc -> m Pandoc
walkM Block -> StateT EPUBState m Block
forall (m :: * -> *). PandocMonad m => Block -> E m Block
transformBlock
[Entry]
picEntries <- ((String, (String, Maybe Entry)) -> Maybe Entry)
-> [(String, (String, Maybe Entry))] -> [Entry]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ((String, Maybe Entry) -> Maybe Entry
forall a b. (a, b) -> b
snd ((String, Maybe Entry) -> Maybe Entry)
-> ((String, (String, Maybe Entry)) -> (String, Maybe Entry))
-> (String, (String, Maybe Entry))
-> Maybe Entry
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, (String, Maybe Entry)) -> (String, Maybe Entry)
forall a b. (a, b) -> b
snd) ([(String, (String, Maybe Entry))] -> [Entry])
-> StateT EPUBState m [(String, (String, Maybe Entry))]
-> StateT EPUBState m [Entry]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (EPUBState -> [(String, (String, Maybe Entry))])
-> StateT EPUBState m [(String, (String, Maybe Entry))]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets EPUBState -> [(String, (String, Maybe Entry))]
stMediaPaths
String
epubSubdir <- (EPUBState -> String) -> StateT EPUBState m String
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets EPUBState -> String
stEpubSubdir
let epub3 :: Bool
epub3 = EPUBVersion
version EPUBVersion -> EPUBVersion -> Bool
forall a. Eq a => a -> a -> Bool
== EPUBVersion
EPUB3
let writeHtml :: WriterOptions -> Pandoc -> f ByteString
writeHtml WriterOptions
o = (Text -> ByteString) -> f Text -> f ByteString
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> ByteString
UTF8.fromTextLazy (Text -> ByteString) -> (Text -> Text) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
TL.fromStrict) (f Text -> f ByteString)
-> (Pandoc -> f Text) -> Pandoc -> f ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
EPUBVersion -> WriterOptions -> Pandoc -> f Text
forall (m :: * -> *).
PandocMonad m =>
EPUBVersion -> WriterOptions -> Pandoc -> m Text
writeHtmlStringForEPUB EPUBVersion
version WriterOptions
o
EPUBMetadata
metadata <- WriterOptions -> Meta -> E m EPUBMetadata
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Meta -> E m EPUBMetadata
getEPUBMetadata WriterOptions
opts Meta
meta
let plainTitle :: 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 -> [Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify [Inline]
x
[ByteString]
stylesheets <- case EPUBMetadata -> [String]
epubStylesheets EPUBMetadata
metadata of
[] -> (\ByteString
x -> [[ByteString] -> ByteString
B.fromChunks [ByteString
x]]) (ByteString -> [ByteString])
-> StateT EPUBState m ByteString -> StateT EPUBState m [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
String -> StateT EPUBState m ByteString
forall (m :: * -> *). PandocMonad m => String -> m ByteString
readDataFile String
"epub.css"
[String]
fs -> (String -> E m ByteString)
-> [String] -> StateT EPUBState m [ByteString]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM String -> E m ByteString
forall (m :: * -> *). PandocMonad m => String -> m ByteString
P.readFileLazy [String]
fs
[Entry]
stylesheetEntries <- (ByteString -> Int -> StateT EPUBState m Entry)
-> [ByteString] -> [Int] -> StateT EPUBState m [Entry]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM
(\ByteString
bs Int
n -> String -> ByteString -> StateT EPUBState m Entry
forall (m :: * -> *).
PandocMonad m =>
String -> ByteString -> E m Entry
mkEntry (String
"styles/stylesheet" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
".css") ByteString
bs)
[ByteString]
stylesheets [(Int
1 :: Int)..]
let vars :: Context Text
vars :: Context Text
vars = Map Text (Val Text) -> Context Text
forall a. Map Text (Val a) -> Context a
Context (Map Text (Val Text) -> Context Text)
-> Map Text (Val Text) -> Context Text
forall a b. (a -> b) -> a -> b
$
Text -> Map Text (Val Text) -> Map Text (Val Text)
forall k a. Ord k => k -> Map k a -> Map k a
M.delete Text
"css" (Map Text (Val Text) -> Map Text (Val Text))
-> (Map Text (Val Text) -> Map Text (Val Text))
-> Map Text (Val Text)
-> Map Text (Val Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Text -> Val Text -> Map Text (Val Text) -> Map Text (Val Text)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Text
"epub3"
(Text -> Val Text
toVal' (Text -> Val Text) -> Text -> Val Text
forall a b. (a -> b) -> a -> b
$ if Bool
epub3 then Text
"true" else Text
"false") (Map Text (Val Text) -> Map Text (Val Text))
-> (Map Text (Val Text) -> Map Text (Val Text))
-> Map Text (Val Text)
-> Map Text (Val Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Text -> Val Text -> Map Text (Val Text) -> Map Text (Val Text)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Text
"lang" (Text -> Val Text
toVal' (Text -> Val Text) -> Text -> Val Text
forall a b. (a -> b) -> a -> b
$ EPUBMetadata -> Text
epubLanguage EPUBMetadata
metadata)
(Map Text (Val Text) -> Map Text (Val Text))
-> Map Text (Val Text) -> Map Text (Val Text)
forall a b. (a -> b) -> a -> b
$ Context Text -> Map Text (Val Text)
forall a. Context a -> Map Text (Val a)
unContext (Context Text -> Map Text (Val Text))
-> Context Text -> Map Text (Val Text)
forall a b. (a -> b) -> a -> b
$ WriterOptions -> Context Text
writerVariables WriterOptions
opts
let cssvars :: Bool -> Context Text
cssvars :: Bool -> Context Text
cssvars Bool
useprefix = Map Text (Val Text) -> Context Text
forall a. Map Text (Val a) -> Context a
Context (Map Text (Val Text) -> Context Text)
-> Map Text (Val Text) -> Context Text
forall a b. (a -> b) -> a -> b
$ Text -> Val Text -> Map Text (Val Text) -> Map Text (Val Text)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Text
"css"
([Val Text] -> Val Text
forall a. [Val a] -> Val a
ListVal ([Val Text] -> Val Text) -> [Val Text] -> Val Text
forall a b. (a -> b) -> a -> b
$ (Entry -> Val Text) -> [Entry] -> [Val Text]
forall a b. (a -> b) -> [a] -> [b]
map
(\Entry
e -> Text -> Val Text
toVal' (Text -> Val Text) -> Text -> Val Text
forall a b. (a -> b) -> a -> b
$
(if Bool
useprefix then Text
"../" else Text
"") Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
String -> Text
T.pack
(String -> ShowS
makeRelative String
epubSubdir (Entry -> String
eRelativePath Entry
e)))
[Entry]
stylesheetEntries)
Map Text (Val Text)
forall a. Monoid a => a
mempty
let opts' :: WriterOptions
opts' :: WriterOptions
opts' = WriterOptions
opts{ writerEmailObfuscation = NoObfuscation
, writerSectionDivs = True
, writerVariables = vars
, writerWrapText = WrapAuto }
([Entry]
cpgEntry, [Entry]
cpicEntry) <- Meta
-> EPUBMetadata
-> WriterOptions
-> Context Text
-> (Bool -> Context Text)
-> (WriterOptions -> Pandoc -> m ByteString)
-> Text
-> StateT EPUBState m ([Entry], [Entry])
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
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m ByteString
writeHtml Text
plainTitle
ByteString
tpContent <- m ByteString -> E m ByteString
forall (m :: * -> *) a. Monad m => m a -> StateT EPUBState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ByteString -> E m ByteString) -> m ByteString -> E m ByteString
forall a b. (a -> b) -> a -> b
$ WriterOptions -> Pandoc -> m ByteString
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m ByteString
writeHtml WriterOptions
opts'{
writerVariables =
Context (M.fromList [
("titlepage", toVal' "true"),
("body-type", toVal' "frontmatter"),
("pagetitle", toVal $
escapeStringForXML plainTitle)])
<> cssvars True <> vars }
(Meta -> [Block] -> Pandoc
Pandoc Meta
meta [])
Entry
tpEntry <- String -> ByteString -> StateT EPUBState m Entry
forall (m :: * -> *).
PandocMonad m =>
String -> ByteString -> E m Entry
mkEntry String
"text/title_page.xhtml" ByteString
tpContent
let matchingGlob :: String -> t m [String]
matchingGlob String
f = do
[String]
xs <- m [String] -> t m [String]
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [String] -> t m [String]) -> m [String] -> t m [String]
forall a b. (a -> b) -> a -> b
$ String -> m [String]
forall (m :: * -> *). PandocMonad m => String -> m [String]
P.glob String
f
Bool -> t m () -> t m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
xs) (t m () -> t m ()) -> t m () -> t m ()
forall a b. (a -> b) -> a -> b
$
LogMessage -> t m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> t m ()) -> LogMessage -> t m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> LogMessage
CouldNotFetchResource (String -> Text
T.pack String
f) Text
"glob did not match any font files"
[String] -> t m [String]
forall a. a -> t m a
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 = String -> ByteString -> E m Entry
forall (m :: * -> *).
PandocMonad m =>
String -> ByteString -> E m Entry
mkEntry (String
"fonts/" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
takeFileName String
f) (ByteString -> E m Entry)
-> StateT EPUBState m ByteString -> E m Entry
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
m ByteString -> StateT EPUBState m ByteString
forall (m :: * -> *) a. Monad m => m a -> StateT EPUBState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (String -> m ByteString
forall (m :: * -> *). PandocMonad m => String -> m ByteString
P.readFileLazy String
f)
[String]
fontFiles <- [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[String]] -> [String])
-> StateT EPUBState m [[String]] -> StateT EPUBState m [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> StateT EPUBState m [String])
-> [String] -> StateT EPUBState m [[String]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM String -> StateT EPUBState m [String]
forall {t :: (* -> *) -> * -> *} {m :: * -> *}.
(MonadTrans t, PandocMonad m, PandocMonad (t m)) =>
String -> t m [String]
matchingGlob (WriterOptions -> [String]
writerEpubFonts WriterOptions
opts')
[Entry]
fontEntries <- (String -> StateT EPUBState m Entry)
-> [String] -> StateT EPUBState m [Entry]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM String -> StateT EPUBState m Entry
forall (m :: * -> *).
PandocMonad m =>
String -> StateT EPUBState m Entry
mkFontEntry [String]
fontFiles
let blocks' :: [Block]
blocks' = WriterOptions -> [Block] -> [Block]
addIdentifiers WriterOptions
opts
([Block] -> [Block]) -> [Block] -> [Block]
forall a b. (a -> b) -> a -> b
$ case [Block]
blocks of
(Div Attr
_
(Header{}:[Block]
_) : [Block]
_) -> [Block]
blocks
(Header Int
1 Attr
_ [Inline]
_ : [Block]
_) -> [Block]
blocks
[Block]
_ -> Int -> Attr -> [Inline] -> Block
Header Int
1 (Text
"",[Text
"unnumbered"],[])
(Meta -> [Inline]
docTitle' Meta
meta) Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
blocks
let chunkedDoc :: ChunkedDoc
chunkedDoc = PathTemplate -> Bool -> Maybe Int -> Int -> Pandoc -> ChunkedDoc
splitIntoChunks PathTemplate
"ch%n.xhtml"
(WriterOptions -> Bool
writerNumberSections WriterOptions
opts)
Maybe Int
forall a. Maybe a
Nothing
(WriterOptions -> Int
writerSplitLevel WriterOptions
opts)
(Meta -> [Block] -> Pandoc
Pandoc Meta
meta [Block]
blocks')
[Entry]
chapterEntries <- WriterOptions
-> Context Text
-> (Bool -> Context Text)
-> (WriterOptions -> Pandoc -> E m ByteString)
-> [Chunk]
-> StateT EPUBState m [Entry]
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 -> E m ByteString
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m ByteString
writeHtml
(ChunkedDoc -> [Chunk]
chunkedChunks ChunkedDoc
chunkedDoc)
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
_ -> []
let containsMathML :: Entry -> Bool
containsMathML Entry
ent = Bool
epub3 Bool -> Bool -> Bool
&&
String
"<math" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf`
ByteString -> String
B8.unpack (Entry -> ByteString
fromEntry Entry
ent)
let containsSVG :: Entry -> Bool
containsSVG Entry
ent = Bool
epub3 Bool -> Bool -> Bool
&&
String
"<svg" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf`
ByteString -> String
B8.unpack (Entry -> ByteString
fromEntry Entry
ent)
let props :: Entry -> [a]
props Entry
ent = [a
"mathml" | Entry -> Bool
containsMathML Entry
ent] [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a
"svg" | Entry -> Bool
containsSVG Entry
ent]
let chapterNode :: Entry -> Element
chapterNode Entry
ent = Text -> () -> Element
forall t. Node t => Text -> t -> Element
unode Text
"item" (() -> Element) -> [(Text, Text)] -> () -> Element
forall t. (t -> Element) -> [(Text, Text)] -> t -> Element
!
([(Text
"id", String -> Text
toId (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> ShowS
makeRelative String
epubSubdir
ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Entry -> String
eRelativePath Entry
ent),
(Text
"href", String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> ShowS
makeRelative String
epubSubdir
ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Entry -> String
eRelativePath Entry
ent),
(Text
"media-type", Text
"application/xhtml+xml")]
[(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++ case Entry -> [Text]
forall {a}. IsString a => Entry -> [a]
props Entry
ent of
[] -> []
[Text]
xs -> [(Text
"properties", [Text] -> Text
T.unwords [Text]
xs)])
(() -> Element) -> () -> Element
forall a b. (a -> b) -> a -> b
$ ()
let chapterRefNode :: Entry -> Element
chapterRefNode Entry
ent = Text -> () -> Element
forall t. Node t => Text -> t -> Element
unode Text
"itemref" (() -> Element) -> [(Text, Text)] -> () -> Element
forall t. (t -> Element) -> [(Text, Text)] -> t -> Element
!
[(Text
"idref", String -> Text
toId (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> ShowS
makeRelative String
epubSubdir
ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Entry -> String
eRelativePath Entry
ent)] (() -> Element) -> () -> Element
forall a b. (a -> b) -> a -> b
$ ()
let pictureNode :: Entry -> Element
pictureNode Entry
ent = Text -> () -> Element
forall t. Node t => Text -> t -> Element
unode Text
"item" (() -> Element) -> [(Text, Text)] -> () -> Element
forall t. (t -> Element) -> [(Text, Text)] -> t -> Element
!
[(Text
"id", String -> Text
toId (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> ShowS
makeRelative String
epubSubdir
ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Entry -> String
eRelativePath Entry
ent),
(Text
"href", String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> ShowS
makeRelative String
epubSubdir
ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Entry -> String
eRelativePath Entry
ent),
(Text
"media-type",
Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"application/octet-stream"
(Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ String -> Maybe Text
mediaTypeOf (String -> Maybe Text) -> String -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Entry -> String
eRelativePath Entry
ent)] (() -> Element) -> () -> Element
forall a b. (a -> b) -> a -> b
$ ()
let fontNode :: Entry -> Element
fontNode Entry
ent = Text -> () -> Element
forall t. Node t => Text -> t -> Element
unode Text
"item" (() -> Element) -> [(Text, Text)] -> () -> Element
forall t. (t -> Element) -> [(Text, Text)] -> t -> Element
!
[(Text
"id", String -> Text
toId (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> ShowS
makeRelative String
epubSubdir
ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Entry -> String
eRelativePath Entry
ent),
(Text
"href", String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> ShowS
makeRelative String
epubSubdir
ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Entry -> String
eRelativePath Entry
ent),
(Text
"media-type", Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$
String -> Maybe Text
getMimeType (String -> Maybe Text) -> String -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Entry -> String
eRelativePath Entry
ent)] (() -> Element) -> () -> Element
forall a b. (a -> b) -> a -> b
$ ()
let tocTitle :: Text
tocTitle = Text -> (MetaValue -> Text) -> Maybe MetaValue -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
plainTitle
MetaValue -> Text
metaValueToString (Maybe MetaValue -> Text) -> Maybe MetaValue -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Meta -> Maybe MetaValue
lookupMeta Text
"toc-title" Meta
meta
UTCTime
currentTime <- m UTCTime -> StateT EPUBState m UTCTime
forall (m :: * -> *) a. Monad m => m a -> StateT EPUBState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m UTCTime
forall (m :: * -> *). PandocMonad m => m UTCTime
P.getTimestamp
let contentsData :: ByteString
contentsData = Text -> ByteString
UTF8.fromTextLazy (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> Text
TL.fromStrict (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Element -> Text
ppTopElement (Element -> Text) -> Element -> Text
forall a b. (a -> b) -> a -> b
$
Text -> [Element] -> Element
forall t. Node t => Text -> t -> Element
unode Text
"package" ([Element] -> Element) -> [(Text, Text)] -> [Element] -> Element
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, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++
[(Text
"xml:lang", EPUBMetadata -> Text
epubLanguage EPUBMetadata
metadata) | EPUBVersion
version EPUBVersion -> EPUBVersion -> Bool
forall a. Eq a => a -> a -> Bool
== EPUBVersion
EPUB3] [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++
[(Text
"unique-identifier",Text
"epub-id-1")] [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++
[(Text
"prefix",Text
"ibooks: http://vocabulary.itunes.apple.com/rdf/ibooks/vocabulary-extensions-1.0/") | EPUBVersion
version EPUBVersion -> EPUBVersion -> Bool
forall a. Eq a => a -> a -> Bool
== EPUBVersion
EPUB3]) ([Element] -> Element) -> [Element] -> Element
forall a b. (a -> b) -> a -> b
$
[ EPUBVersion -> EPUBMetadata -> UTCTime -> Element
metadataElement EPUBVersion
version EPUBMetadata
metadata UTCTime
currentTime
, Text -> [Element] -> Element
forall t. Node t => Text -> t -> Element
unode Text
"manifest" ([Element] -> Element) -> [Element] -> Element
forall a b. (a -> b) -> a -> b
$
[ Text -> () -> Element
forall t. Node t => Text -> t -> Element
unode Text
"item" (() -> Element) -> [(Text, Text)] -> () -> Element
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")] (() -> Element) -> () -> Element
forall a b. (a -> b) -> a -> b
$ ()
, Text -> () -> Element
forall t. Node t => Text -> t -> Element
unode Text
"item" (() -> Element) -> [(Text, Text)] -> () -> Element
forall t. (t -> Element) -> [(Text, Text)] -> t -> Element
! ([(Text
"id",Text
"nav")
,(Text
"href",Text
"nav.xhtml")
,(Text
"media-type",Text
"application/xhtml+xml")] [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++
[(Text
"properties",Text
"nav") | Bool
epub3 ]) (() -> Element) -> () -> Element
forall a b. (a -> b) -> a -> b
$ ()
] [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++
[ Text -> () -> Element
forall t. Node t => Text -> t -> Element
unode Text
"item" (() -> Element) -> [(Text, Text)] -> () -> Element
forall t. (t -> Element) -> [(Text, Text)] -> t -> Element
! [(Text
"id",Text
"stylesheet" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
n)
, (Text
"href", String -> Text
T.pack String
fp)
,(Text
"media-type",Text
"text/css")] (() -> Element) -> () -> Element
forall a b. (a -> b) -> a -> b
$ () |
(Int
n :: Int, String
fp) <- [Int] -> [String] -> [(Int, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1..] ((Entry -> String) -> [Entry] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map
(String -> ShowS
makeRelative String
epubSubdir ShowS -> (Entry -> String) -> Entry -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Entry -> String
eRelativePath)
[Entry]
stylesheetEntries) ] [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++
(Entry -> Element) -> [Entry] -> [Element]
forall a b. (a -> b) -> [a] -> [b]
map Entry -> Element
chapterNode ([Entry]
cpgEntry [Entry] -> [Entry] -> [Entry]
forall a. [a] -> [a] -> [a]
++
[Entry
tpEntry | WriterOptions -> Bool
writerEpubTitlePage WriterOptions
opts] [Entry] -> [Entry] -> [Entry]
forall a. [a] -> [a] -> [a]
++
[Entry]
chapterEntries) [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++
(case [Entry]
cpicEntry of
[] -> []
(Entry
x:[Entry]
_) -> [[Attr] -> Element -> Element
add_attrs
[QName -> Text -> Attr
Attr (Text -> QName
unqual Text
"properties") Text
"cover-image" | Bool
epub3]
(Entry -> Element
pictureNode Entry
x)]) [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++
(Entry -> Element) -> [Entry] -> [Element]
forall a b. (a -> b) -> [a] -> [b]
map Entry -> Element
pictureNode [Entry]
picEntries [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++
(Entry -> Element) -> [Entry] -> [Element]
forall a b. (a -> b) -> [a] -> [b]
map Entry -> Element
fontNode [Entry]
fontEntries
, Text -> [Element] -> Element
forall t. Node t => Text -> t -> Element
unode Text
"spine" ([Element] -> Element) -> [(Text, Text)] -> [Element] -> Element
forall t. (t -> Element) -> [(Text, Text)] -> t -> Element
! (
(Text
"toc",Text
"ncx") (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
: [(Text, Text)]
progressionDirection) ([Element] -> Element) -> [Element] -> Element
forall a b. (a -> b) -> a -> b
$
case EPUBMetadata -> Maybe String
epubCoverImage EPUBMetadata
metadata of
Maybe String
Nothing -> []
Just String
_ -> [ Text -> () -> Element
forall t. Node t => Text -> t -> Element
unode Text
"itemref" (() -> Element) -> [(Text, Text)] -> () -> Element
forall t. (t -> Element) -> [(Text, Text)] -> t -> Element
!
[(Text
"idref", Text
"cover_xhtml")] (() -> Element) -> () -> Element
forall a b. (a -> b) -> a -> b
$ () ]
[Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++ ([Text -> () -> Element
forall t. Node t => Text -> t -> Element
unode Text
"itemref" (() -> Element) -> [(Text, Text)] -> () -> Element
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")] (() -> Element) -> () -> Element
forall a b. (a -> b) -> a -> b
$ ()
| WriterOptions -> Bool
writerEpubTitlePage WriterOptions
opts] [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++
[Text -> () -> Element
forall t. Node t => Text -> t -> Element
unode Text
"itemref" (() -> Element) -> [(Text, Text)] -> () -> Element
forall t. (t -> Element) -> [(Text, Text)] -> t -> Element
! [(Text
"idref", Text
"nav")] (() -> Element) -> () -> Element
forall a b. (a -> b) -> a -> b
$ ()
| WriterOptions -> Bool
writerTableOfContents WriterOptions
opts ] [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++
(Entry -> Element) -> [Entry] -> [Element]
forall a b. (a -> b) -> [a] -> [b]
map Entry -> Element
chapterRefNode [Entry]
chapterEntries)
, Text -> [Element] -> Element
forall t. Node t => Text -> t -> Element
unode Text
"guide" ([Element] -> Element) -> [Element] -> Element
forall a b. (a -> b) -> a -> b
$
(Text -> () -> Element
forall t. Node t => Text -> t -> Element
unode Text
"reference" (() -> Element) -> [(Text, Text)] -> () -> Element
forall t. (t -> Element) -> [(Text, Text)] -> t -> Element
!
[(Text
"type",Text
"toc"),(Text
"title", Text
tocTitle),
(Text
"href",Text
"nav.xhtml")] (() -> Element) -> () -> Element
forall a b. (a -> b) -> a -> b
$ ()
) Element -> [Element] -> [Element]
forall a. a -> [a] -> [a]
:
[ Text -> () -> Element
forall t. Node t => Text -> t -> Element
unode Text
"reference" (() -> Element) -> [(Text, Text)] -> () -> Element
forall t. (t -> Element) -> [(Text, Text)] -> t -> Element
!
[(Text
"type",Text
"cover")
,(Text
"title",Text
"Cover")
,(Text
"href",Text
"text/cover.xhtml")] (() -> Element) -> () -> Element
forall a b. (a -> b) -> a -> b
$ ()
| Maybe String -> Bool
forall a. Maybe a -> Bool
isJust (EPUBMetadata -> Maybe String
epubCoverImage EPUBMetadata
metadata)
]
]
Entry
contentsEntry <- String -> ByteString -> StateT EPUBState m Entry
forall (m :: * -> *).
PandocMonad m =>
String -> ByteString -> E m Entry
mkEntry String
"content.opf" ByteString
contentsData
Entry
tocEntry <- WriterOptions
-> Meta
-> EPUBMetadata
-> Text
-> Tree SecInfo
-> StateT EPUBState m Entry
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)
Entry
navEntry <- WriterOptions
-> Meta
-> EPUBMetadata
-> Context Text
-> (Bool -> Context Text)
-> (WriterOptions -> Pandoc -> m ByteString)
-> Text
-> EPUBVersion
-> Tree SecInfo
-> StateT EPUBState m Entry
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
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m ByteString
writeHtml Text
tocTitle EPUBVersion
version (ChunkedDoc -> Tree SecInfo
chunkedTOC ChunkedDoc
chunkedDoc)
Entry
mimetypeEntry <- String -> ByteString -> StateT EPUBState m Entry
forall (m :: * -> *).
PandocMonad m =>
String -> ByteString -> E m Entry
mkEntry String
"mimetype" (ByteString -> StateT EPUBState m Entry)
-> ByteString -> StateT EPUBState m Entry
forall a b. (a -> b) -> a -> b
$
String -> ByteString
UTF8.fromStringLazy String
"application/epub+zip"
let containerData :: ByteString
containerData = ByteString -> ByteString
B.fromStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
UTF8.fromText (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ Element -> Text
ppTopElement (Element -> Text) -> Element -> Text
forall a b. (a -> b) -> a -> b
$
Text -> Element -> Element
forall t. Node t => Text -> t -> Element
unode Text
"container" (Element -> Element) -> [(Text, Text)] -> Element -> Element
forall t. (t -> Element) -> [(Text, Text)] -> t -> Element
! [(Text
"version",Text
"1.0")
,(Text
"xmlns",Text
"urn:oasis:names:tc:opendocument:xmlns:container")] (Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$
Text -> Element -> Element
forall t. Node t => Text -> t -> Element
unode Text
"rootfiles" (Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$
Text -> () -> Element
forall t. Node t => Text -> t -> Element
unode Text
"rootfile" (() -> Element) -> [(Text, Text)] -> () -> Element
forall t. (t -> Element) -> [(Text, Text)] -> t -> Element
! [(Text
"full-path",
(if String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
epubSubdir
then Text
""
else String -> Text
T.pack String
epubSubdir Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/") Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"content.opf")
,(Text
"media-type",Text
"application/oebps-package+xml")] (() -> Element) -> () -> Element
forall a b. (a -> b) -> a -> b
$ ()
Entry
containerEntry <- String -> ByteString -> StateT EPUBState m Entry
forall (m :: * -> *).
PandocMonad m =>
String -> ByteString -> E m Entry
mkEntry String
"META-INF/container.xml" ByteString
containerData
let apple :: ByteString
apple = ByteString -> ByteString
B.fromStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
UTF8.fromText (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ Element -> Text
ppTopElement (Element -> Text) -> Element -> Text
forall a b. (a -> b) -> a -> b
$
Text -> Element -> Element
forall t. Node t => Text -> t -> Element
unode Text
"display_options" (Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$
Text -> Element -> Element
forall t. Node t => Text -> t -> Element
unode Text
"platform" (Element -> Element) -> [(Text, Text)] -> Element -> Element
forall t. (t -> Element) -> [(Text, Text)] -> t -> Element
! [(Text
"name",Text
"*")] (Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$
Text -> Text -> Element
forall t. Node t => Text -> t -> Element
unode Text
"option" (Text -> Element) -> [(Text, Text)] -> Text -> Element
forall t. (t -> Element) -> [(Text, Text)] -> t -> Element
! [(Text
"name",Text
"specified-fonts")] (Text -> Element) -> Text -> Element
forall a b. (a -> b) -> a -> b
$ (Text
"true" :: Text)
Entry
appleEntry <- String -> ByteString -> StateT EPUBState m Entry
forall (m :: * -> *).
PandocMonad m =>
String -> ByteString -> E m Entry
mkEntry String
"META-INF/com.apple.ibooks.display-options.xml" ByteString
apple
let archive :: Archive
archive = (Entry -> Archive -> Archive) -> Archive -> [Entry] -> Archive
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Entry -> Archive -> Archive
addEntryToArchive Archive
emptyArchive ([Entry] -> Archive) -> [Entry] -> Archive
forall a b. (a -> b) -> a -> b
$
[Entry
mimetypeEntry, Entry
containerEntry, Entry
appleEntry,
Entry
contentsEntry, Entry
tocEntry, Entry
navEntry] [Entry] -> [Entry] -> [Entry]
forall a. [a] -> [a] -> [a]
++
[Entry
tpEntry | WriterOptions -> Bool
writerEpubTitlePage WriterOptions
opts] [Entry] -> [Entry] -> [Entry]
forall a. [a] -> [a] -> [a]
++
[Entry]
stylesheetEntries [Entry] -> [Entry] -> [Entry]
forall a. [a] -> [a] -> [a]
++ [Entry]
picEntries [Entry] -> [Entry] -> [Entry]
forall a. [a] -> [a] -> [a]
++ [Entry]
cpicEntry [Entry] -> [Entry] -> [Entry]
forall a. [a] -> [a] -> [a]
++
[Entry]
cpgEntry [Entry] -> [Entry] -> [Entry]
forall a. [a] -> [a] -> [a]
++ [Entry]
chapterEntries [Entry] -> [Entry] -> [Entry]
forall a. [a] -> [a] -> [a]
++ [Entry]
fontEntries
ByteString -> E m ByteString
forall a. a -> StateT EPUBState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> E m ByteString) -> ByteString -> E m ByteString
forall a b. (a -> b) -> a -> b
$ Archive -> ByteString
fromArchive Archive
archive
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 -> ([Entry], [Entry]) -> StateT EPUBState m ([Entry], [Entry])
forall a. a -> StateT EPUBState m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([],[])
Just String
img -> do
let fp :: String
fp = ShowS
takeFileName String
img
[String]
mediaPaths <- (EPUBState -> [String]) -> StateT EPUBState m [String]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (((String, (String, Maybe Entry)) -> String)
-> [(String, (String, Maybe Entry))] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((String, Maybe Entry) -> String
forall a b. (a, b) -> a
fst ((String, Maybe Entry) -> String)
-> ((String, (String, Maybe Entry)) -> (String, Maybe Entry))
-> (String, (String, Maybe Entry))
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, (String, Maybe Entry)) -> (String, Maybe Entry)
forall a b. (a, b) -> b
snd) ([(String, (String, Maybe Entry))] -> [String])
-> (EPUBState -> [(String, (String, Maybe Entry))])
-> EPUBState
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EPUBState -> [(String, (String, Maybe Entry))]
stMediaPaths)
String
coverImageName <-
if (String
"media/" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
fp) String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
mediaPaths
then String -> E m String
forall (m :: * -> *). PandocMonad m => String -> E m String
getMediaNextNewName (ShowS
takeExtension String
fp)
else String -> E m String
forall a. a -> StateT EPUBState m a
forall (m :: * -> *) a. Monad m => a -> m a
return String
fp
ByteString
imgContent <- m ByteString -> StateT EPUBState m ByteString
forall (m :: * -> *) a. Monad m => m a -> StateT EPUBState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ByteString -> StateT EPUBState m ByteString)
-> m ByteString -> StateT EPUBState m ByteString
forall a b. (a -> b) -> a -> b
$ String -> m ByteString
forall (m :: * -> *). PandocMonad m => String -> m ByteString
P.readFileLazy String
img
(Integer
coverImageWidth, Integer
coverImageHeight) <-
case WriterOptions -> ByteString -> Either Text ImageSize
imageSize WriterOptions
opts' (ByteString -> ByteString
B.toStrict ByteString
imgContent) of
Right ImageSize
sz -> (Integer, Integer) -> StateT EPUBState m (Integer, Integer)
forall a. a -> StateT EPUBState m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Integer, Integer) -> StateT EPUBState m (Integer, Integer))
-> (Integer, Integer) -> StateT EPUBState m (Integer, Integer)
forall a b. (a -> b) -> a -> b
$ ImageSize -> (Integer, Integer)
sizeInPixels ImageSize
sz
Left Text
err' -> (Integer
0, Integer
0) (Integer, Integer)
-> StateT EPUBState m () -> StateT EPUBState m (Integer, Integer)
forall a b. a -> StateT EPUBState m b -> StateT EPUBState m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ LogMessage -> StateT EPUBState m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report
(Text -> Text -> LogMessage
CouldNotDetermineImageSize (String -> Text
T.pack String
img) Text
err')
ByteString
cpContent <- m ByteString -> StateT EPUBState m ByteString
forall (m :: * -> *) a. Monad m => m a -> StateT EPUBState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ByteString -> StateT EPUBState m ByteString)
-> m ByteString -> StateT EPUBState m ByteString
forall a b. (a -> b) -> a -> b
$ WriterOptions -> Pandoc -> m ByteString
writeHtml
WriterOptions
opts'{ writerVariables =
Context (M.fromList [
("coverpage", toVal' "true"),
("pagetitle", toVal $
escapeStringForXML plainTitle),
("cover-image",
toVal' $ T.pack coverImageName),
("cover-image-width", toVal' $
tshow coverImageWidth),
("cover-image-height", toVal' $
tshow coverImageHeight)]) <>
cssvars True <> vars }
(Meta -> [Block] -> Pandoc
Pandoc Meta
meta [])
Entry
coverEntry <- String -> ByteString -> E m Entry
forall (m :: * -> *).
PandocMonad m =>
String -> ByteString -> E m Entry
mkEntry String
"text/cover.xhtml" ByteString
cpContent
Entry
coverImageEntry <- String -> ByteString -> E m Entry
forall (m :: * -> *).
PandocMonad m =>
String -> ByteString -> E m Entry
mkEntry (String
"media/" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
coverImageName)
ByteString
imgContent
([Entry], [Entry]) -> StateT EPUBState m ([Entry], [Entry])
forall a. a -> StateT EPUBState m a
forall (m :: * -> *) a. Monad m => a -> m a
return ( [ Entry
coverEntry ], [ Entry
coverImageEntry ] )
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
let chapToEntry :: Int -> Chunk -> StateT EPUBState m Entry
chapToEntry Int
num Chunk
chunk =
String -> ByteString -> StateT EPUBState m Entry
forall (m :: * -> *).
PandocMonad m =>
String -> ByteString -> E m Entry
mkEntry (String
"text/" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Chunk -> String
chunkPath Chunk
chunk) (ByteString -> StateT EPUBState m Entry)
-> StateT EPUBState m ByteString -> StateT EPUBState m Entry
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
WriterOptions -> Pandoc -> StateT EPUBState m ByteString
writeHtml WriterOptions
opts'{ writerVariables =
Context (M.fromList
[("body-type", toVal' bodyType),
("pagetitle", toVal' $
showChapter num)])
<> cssvars True <> vars } Pandoc
pdoc
where bs :: [Block]
bs = Chunk -> [Block]
chunkContents Chunk
chunk
meta' :: Meta
meta' = Text -> Many Inline -> Meta -> Meta
forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
forall b. ToMetaValue b => Text -> b -> Meta -> Meta
setMeta Text
"title" ([Inline] -> Many Inline
forall a. [a] -> Many a
fromList
((Inline -> Inline) -> [Inline] -> [Inline]
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]
_) ->
(Meta -> [Block] -> Pandoc
Pandoc Meta
meta' [Block]
bs,
case Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"epub:type" [(Text, Text)]
kvs of
Maybe Text
Nothing -> Text
"bodymatter"
Just Text
x
| Text
x Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
frontMatterTypes -> Text
"frontmatter"
| Text
x Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
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"]
(Int -> Chunk -> StateT EPUBState m Entry)
-> [Int] -> [Chunk] -> StateT EPUBState m [Entry]
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> WriterOptions -> Int
writerTOCDepth WriterOptions
opts = Maybe Element -> State Int (Maybe Element)
forall a. a -> StateT Int Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Element
forall a. Maybe a
Nothing
| Bool
otherwise = do
Int
n <- StateT Int Identity Int
forall s (m :: * -> *). MonadState s m => m s
get
(Int -> Int) -> StateT Int Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
[Element]
subs <- [Maybe Element] -> [Element]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Element] -> [Element])
-> StateT Int Identity [Maybe Element]
-> StateT Int Identity [Element]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Tree SecInfo -> State Int (Maybe Element))
-> [Tree SecInfo] -> StateT Int Identity [Maybe Element]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" "
Maybe Text
Nothing -> Text
""
let title' :: Text
title' = Text
secnum' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify (SecInfo -> [Inline]
secTitle SecInfo
secinfo)
Maybe Element -> State Int (Maybe Element)
forall a. a -> StateT Int Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Element -> State Int (Maybe Element))
-> Maybe Element -> State Int (Maybe Element)
forall a b. (a -> b) -> a -> b
$ Element -> Maybe Element
forall a. a -> Maybe a
Just (Element -> Maybe Element) -> Element -> Maybe Element
forall a b. (a -> b) -> a -> b
$ Text -> [Element] -> Element
forall t. Node t => Text -> t -> Element
unode Text
"navPoint" ([Element] -> Element) -> [(Text, Text)] -> [Element] -> Element
forall t. (t -> Element) -> [(Text, Text)] -> t -> Element
!
[(Text
"id", Text
"navPoint-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
n)] ([Element] -> Element) -> [Element] -> Element
forall a b. (a -> b) -> a -> b
$
[ Text -> Element -> Element
forall t. Node t => Text -> t -> Element
unode Text
"navLabel" (Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Element
forall t. Node t => Text -> t -> Element
unode Text
"text" Text
title'
, Text -> () -> Element
forall t. Node t => Text -> t -> Element
unode Text
"content" (() -> Element) -> [(Text, Text)] -> () -> Element
forall t. (t -> Element) -> [(Text, Text)] -> t -> Element
!
[(Text
"src", Text
"text/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SecInfo -> Text
secPath SecInfo
secinfo)] (() -> Element) -> () -> Element
forall a b. (a -> b) -> a -> b
$ ()
] [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++ [Element]
subs
let tpNode :: Element
tpNode = Text -> [Element] -> Element
forall t. Node t => Text -> t -> Element
unode Text
"navPoint" ([Element] -> Element) -> [(Text, Text)] -> [Element] -> Element
forall t. (t -> Element) -> [(Text, Text)] -> t -> Element
! [(Text
"id", Text
"navPoint-0")] ([Element] -> Element) -> [Element] -> Element
forall a b. (a -> b) -> a -> b
$
[ Text -> Element -> Element
forall t. Node t => Text -> t -> Element
unode Text
"navLabel" (Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Element
forall t. Node t => Text -> t -> Element
unode Text
"text"
([Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify ([Inline] -> Text) -> [Inline] -> Text
forall a b. (a -> b) -> a -> b
$ Meta -> [Inline]
docTitle' Meta
meta)
, Text -> () -> Element
forall t. Node t => Text -> t -> Element
unode Text
"content" (() -> Element) -> [(Text, Text)] -> () -> Element
forall t. (t -> Element) -> [(Text, Text)] -> t -> Element
! [(Text
"src", Text
"text/title_page.xhtml")]
(() -> Element) -> () -> Element
forall a b. (a -> b) -> a -> b
$ () ]
let navMap :: [Element]
navMap = StateT Int Identity [Element] -> Int -> [Element]
forall s a. State s a -> s -> a
evalState ([Maybe Element] -> [Element]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Element] -> [Element])
-> StateT Int Identity [Maybe Element]
-> StateT Int Identity [Element]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Tree SecInfo -> State Int (Maybe Element))
-> [Tree SecInfo] -> StateT Int Identity [Maybe Element]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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]
_) -> Text -> StateT EPUBState m Text
forall a. a -> StateT EPUBState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> StateT EPUBState m Text)
-> Text -> StateT EPUBState m Text
forall a b. (a -> b) -> a -> b
$ Identifier -> Text
identifierText Identifier
x
[] -> PandocError -> StateT EPUBState m Text
forall a. PandocError -> StateT EPUBState m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError -> StateT EPUBState m Text)
-> PandocError -> StateT EPUBState m Text
forall a b. (a -> b) -> a -> b
$ Text -> PandocError
PandocShouldNeverHappenError Text
"epubIdentifier is null"
let tocData :: ByteString
tocData = ByteString -> ByteString
B.fromStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
UTF8.fromText (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ Element -> Text
ppTopElement (Element -> Text) -> Element -> Text
forall a b. (a -> b) -> a -> b
$
Text -> [Element] -> Element
forall t. Node t => Text -> t -> Element
unode Text
"ncx" ([Element] -> Element) -> [(Text, Text)] -> [Element] -> Element
forall t. (t -> Element) -> [(Text, Text)] -> t -> Element
! [(Text
"version",Text
"2005-1")
,(Text
"xmlns",Text
"http://www.daisy.org/z3986/2005/ncx/")] ([Element] -> Element) -> [Element] -> Element
forall a b. (a -> b) -> a -> b
$
[ Text -> [Element] -> Element
forall t. Node t => Text -> t -> Element
unode Text
"head" ([Element] -> Element) -> [Element] -> Element
forall a b. (a -> b) -> a -> b
$
[ Text -> () -> Element
forall t. Node t => Text -> t -> Element
unode Text
"meta" (() -> Element) -> [(Text, Text)] -> () -> Element
forall t. (t -> Element) -> [(Text, Text)] -> t -> Element
! [(Text
"name",Text
"dtb:uid")
,(Text
"content", Text
uuid)] (() -> Element) -> () -> Element
forall a b. (a -> b) -> a -> b
$ ()
, Text -> () -> Element
forall t. Node t => Text -> t -> Element
unode Text
"meta" (() -> Element) -> [(Text, Text)] -> () -> Element
forall t. (t -> Element) -> [(Text, Text)] -> t -> Element
! [(Text
"name",Text
"dtb:depth")
,(Text
"content", Text
"1")] (() -> Element) -> () -> Element
forall a b. (a -> b) -> a -> b
$ ()
, Text -> () -> Element
forall t. Node t => Text -> t -> Element
unode Text
"meta" (() -> Element) -> [(Text, Text)] -> () -> Element
forall t. (t -> Element) -> [(Text, Text)] -> t -> Element
! [(Text
"name",Text
"dtb:totalPageCount")
,(Text
"content", Text
"0")] (() -> Element) -> () -> Element
forall a b. (a -> b) -> a -> b
$ ()
, Text -> () -> Element
forall t. Node t => Text -> t -> Element
unode Text
"meta" (() -> Element) -> [(Text, Text)] -> () -> Element
forall t. (t -> Element) -> [(Text, Text)] -> t -> Element
! [(Text
"name",Text
"dtb:maxPageNumber")
,(Text
"content", Text
"0")] (() -> Element) -> () -> Element
forall a b. (a -> b) -> a -> b
$ ()
] [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++ case EPUBMetadata -> Maybe String
epubCoverImage EPUBMetadata
metadata of
Maybe String
Nothing -> []
Just String
img -> [Text -> () -> Element
forall t. Node t => Text -> t -> Element
unode Text
"meta" (() -> Element) -> [(Text, Text)] -> () -> Element
forall t. (t -> Element) -> [(Text, Text)] -> t -> Element
! [(Text
"name",Text
"cover"),
(Text
"content", String -> Text
toId String
img)] (() -> Element) -> () -> Element
forall a b. (a -> b) -> a -> b
$ ()]
, Text -> Element -> Element
forall t. Node t => Text -> t -> Element
unode Text
"docTitle" (Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Element
forall t. Node t => Text -> t -> Element
unode Text
"text" Text
plainTitle
, Text -> [Element] -> Element
forall t. Node t => Text -> t -> Element
unode Text
"navMap" ([Element] -> Element) -> [Element] -> Element
forall a b. (a -> b) -> a -> b
$ [Element
tpNode | WriterOptions -> Bool
writerEpubTitlePage WriterOptions
opts] [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++ [Element]
navMap
]
String -> ByteString -> StateT EPUBState m Entry
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> WriterOptions -> Int
writerTOCDepth WriterOptions
opts = Maybe Element -> State Int (Maybe Element)
forall a. a -> StateT Int Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Element
forall a. Maybe a
Nothing
| Bool
otherwise = do
Int
n <- StateT Int Identity Int
forall s (m :: * -> *). MonadState s m => m s
get
(Int -> Int) -> StateT Int Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
[Element]
subs <- [Maybe Element] -> [Element]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Element] -> [Element])
-> StateT Int Identity [Maybe Element]
-> StateT Int Identity [Element]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Tree SecInfo -> State Int (Maybe Element))
-> [Tree SecInfo] -> StateT Int Identity [Maybe Element]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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' [Inline] -> [Inline] -> [Inline]
forall a. Semigroup a => a -> a -> a
<> SecInfo -> [Inline]
secTitle SecInfo
secinfo
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 PandocPure Text -> Either PandocError Text
forall a. PandocPure a -> Either PandocError a
P.runPure
(EPUBVersion -> WriterOptions -> Pandoc -> PandocPure Text
forall (m :: * -> *).
PandocMonad m =>
EPUBVersion -> WriterOptions -> Pandoc -> m Text
writeHtmlStringForEPUB EPUBVersion
version
WriterOptions
opts{ writerTemplate = Nothing }
(Meta -> [Block] -> Pandoc
Pandoc Meta
nullMeta
[[Inline] -> Block
Plain ([Inline] -> Block) -> [Inline] -> Block
forall a b. (a -> b) -> a -> b
$ (Inline -> Inline) -> [Inline] -> [Inline]
forall a b. Walkable a b => (a -> a) -> b -> b
walk Inline -> Inline
clean [Inline]
title'])) of
Left PandocError
_ -> [Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify [Inline]
title'
Right Text
x -> Text
x
let titElements :: [Content]
titElements = (Text -> [Content])
-> ([Content] -> [Content]) -> Either Text [Content] -> [Content]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ([Content] -> Text -> [Content]
forall a b. a -> b -> a
const []) [Content] -> [Content]
forall a. a -> a
id (Either Text [Content] -> [Content])
-> Either Text [Content] -> [Content]
forall a b. (a -> b) -> a -> b
$
Text -> Either Text [Content]
parseXMLContents (Text -> Text
TL.fromStrict Text
titRendered)
Maybe Element -> State Int (Maybe Element)
forall a. a -> StateT Int Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Element -> State Int (Maybe Element))
-> Maybe Element -> State Int (Maybe Element)
forall a b. (a -> b) -> a -> b
$ Element -> Maybe Element
forall a. a -> Maybe a
Just (Element -> Maybe Element) -> Element -> Maybe Element
forall a b. (a -> b) -> a -> b
$ Text -> [Element] -> Element
forall t. Node t => Text -> t -> Element
unode Text
"li" ([Element] -> Element) -> [(Text, Text)] -> [Element] -> Element
forall t. (t -> Element) -> [(Text, Text)] -> t -> Element
!
[(Text
"id", Text
"toc-li-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
n)] ([Element] -> Element) -> [Element] -> Element
forall a b. (a -> b) -> a -> b
$
(Text -> [Content] -> Element
forall t. Node t => Text -> t -> Element
unode Text
"a" ([Content] -> Element) -> [(Text, Text)] -> [Content] -> Element
forall t. (t -> Element) -> [(Text, Text)] -> t -> Element
!
[(Text
"href", Text
"text/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SecInfo -> Text
secPath SecInfo
secinfo)]
([Content] -> Element) -> [Content] -> Element
forall a b. (a -> b) -> a -> b
$ [Content]
titElements)
Element -> [Element] -> [Element]
forall a. a -> [a] -> [a]
: case [Element]
subs of
[] -> []
(Element
_:[Element]
_) -> [Text -> [Element] -> Element
forall t. Node t => Text -> t -> Element
unode Text
"ol" ([Element] -> Element) -> [(Text, Text)] -> [Element] -> Element
forall t. (t -> Element) -> [(Text, Text)] -> t -> Element
! [(Text
"class",Text
"toc")] ([Element] -> Element) -> [Element] -> Element
forall a b. (a -> b) -> a -> b
$ [Element]
subs]
let navtag :: Text
navtag = if EPUBVersion
version EPUBVersion -> EPUBVersion -> Bool
forall a. Eq a => a -> a -> Bool
== EPUBVersion
EPUB3 then Text
"nav" else Text
"div"
let tocBlocks :: [Element]
tocBlocks = StateT Int Identity [Element] -> Int -> [Element]
forall s a. State s a -> s -> a
evalState ([Maybe Element] -> [Element]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Element] -> [Element])
-> StateT Int Identity [Maybe Element]
-> StateT Int Identity [Element]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Tree SecInfo -> State Int (Maybe Element))
-> [Tree SecInfo] -> StateT Int Identity [Maybe Element]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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")
(Text -> Block) -> Text -> Block
forall a b. (a -> b) -> a -> b
$ Element -> Text
showElement (Element -> Text) -> Element -> Text
forall a b. (a -> b) -> a -> b
$
Text -> [Element] -> Element
forall t. Node t => Text -> t -> Element
unode Text
navtag ([Element] -> Element) -> [(Text, Text)] -> [Element] -> Element
forall t. (t -> Element) -> [(Text, Text)] -> t -> Element
! ([(Text
"epub:type",Text
"toc") | EPUBVersion
version EPUBVersion -> EPUBVersion -> Bool
forall a. Eq a => a -> a -> Bool
== EPUBVersion
EPUB3] [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++
[(Text
"role",Text
"doc-toc") | EPUBVersion
version EPUBVersion -> EPUBVersion -> Bool
forall a. Eq a => a -> a -> Bool
== EPUBVersion
EPUB3] [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++
[(Text
"id",Text
"toc")]) ([Element] -> Element) -> [Element] -> Element
forall a b. (a -> b) -> a -> b
$
[ Text -> Text -> Element
forall t. Node t => Text -> t -> Element
unode Text
"h1" (Text -> Element) -> [(Text, Text)] -> Text -> Element
forall t. (t -> Element) -> [(Text, Text)] -> t -> Element
! [(Text
"id",Text
"toc-title")] (Text -> Element) -> Text -> Element
forall a b. (a -> b) -> a -> b
$ Text
tocTitle
, Text -> [Element] -> Element
forall t. Node t => Text -> t -> Element
unode Text
"ol" ([Element] -> Element) -> [(Text, Text)] -> [Element] -> Element
forall t. (t -> Element) -> [(Text, Text)] -> t -> Element
! [(Text
"class",Text
"toc")] ([Element] -> Element) -> [Element] -> Element
forall a b. (a -> b) -> a -> b
$ [Element]
tocBlocks ]]
let landmarkItems :: [Element]
landmarkItems = if EPUBVersion
version EPUBVersion -> EPUBVersion -> Bool
forall a. Eq a => a -> a -> Bool
== EPUBVersion
EPUB3
then [ Text -> [Element] -> Element
forall t. Node t => Text -> t -> Element
unode Text
"li"
[ Text -> Text -> Element
forall t. Node t => Text -> t -> Element
unode Text
"a" (Text -> Element) -> [(Text, Text)] -> Text -> Element
forall t. (t -> Element) -> [(Text, Text)] -> t -> Element
! [(Text
"href",
Text
"text/title_page.xhtml")
,(Text
"epub:type", Text
"titlepage")] (Text -> Element) -> Text -> Element
forall a b. (a -> b) -> a -> b
$
(Text
"Title Page" :: Text) ] |
WriterOptions -> Bool
writerEpubTitlePage WriterOptions
opts ] [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++
[ Text -> [Element] -> Element
forall t. Node t => Text -> t -> Element
unode Text
"li"
[ Text -> Text -> Element
forall t. Node t => Text -> t -> Element
unode Text
"a" (Text -> Element) -> [(Text, Text)] -> Text -> Element
forall t. (t -> Element) -> [(Text, Text)] -> t -> Element
! [(Text
"href", Text
"text/cover.xhtml")
,(Text
"epub:type", Text
"cover")] (Text -> Element) -> Text -> Element
forall a b. (a -> b) -> a -> b
$
(Text
"Cover" :: Text)] |
Maybe String -> Bool
forall a. Maybe a -> Bool
isJust (EPUBMetadata -> Maybe String
epubCoverImage EPUBMetadata
metadata)
] [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++
[ Text -> [Element] -> Element
forall t. Node t => Text -> t -> Element
unode Text
"li"
[ Text -> Text -> Element
forall t. Node t => Text -> t -> Element
unode Text
"a" (Text -> Element) -> [(Text, Text)] -> Text -> Element
forall t. (t -> Element) -> [(Text, Text)] -> t -> Element
! [(Text
"href", Text
"#toc")
,(Text
"epub:type", Text
"toc")] (Text -> Element) -> Text -> Element
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") (Text -> Block) -> Text -> Block
forall a b. (a -> b) -> a -> b
$ Element -> Text
ppElement (Element -> Text) -> Element -> Text
forall a b. (a -> b) -> a -> b
$
Text -> [Element] -> Element
forall t. Node t => Text -> t -> Element
unode Text
"nav" ([Element] -> Element) -> [(Text, Text)] -> [Element] -> Element
forall t. (t -> Element) -> [(Text, Text)] -> t -> Element
! [(Text
"epub:type",Text
"landmarks")
,(Text
"id",Text
"landmarks")
,(Text
"hidden",Text
"hidden")] ([Element] -> Element) -> [Element] -> Element
forall a b. (a -> b) -> a -> b
$
[ Text -> [Element] -> Element
forall t. Node t => Text -> t -> Element
unode Text
"ol" [Element]
landmarkItems ]
| Bool -> Bool
not ([Element] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Element]
landmarkItems)]
ByteString
navData <- m ByteString -> StateT EPUBState m ByteString
forall (m :: * -> *) a. Monad m => m a -> StateT EPUBState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ByteString -> StateT EPUBState m ByteString)
-> m ByteString -> StateT EPUBState m ByteString
forall a b. (a -> b) -> a -> b
$ WriterOptions -> Pandoc -> m ByteString
writeHtml WriterOptions
opts{ writerVariables =
Context (M.fromList [("navpage", toVal' "true")
,("body-type", toVal' "frontmatter")
])
<> cssvars False <> vars }
(Meta -> [Block] -> Pandoc
Pandoc (Text -> Many Inline -> Meta -> Meta
forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
forall b. ToMetaValue b => Text -> b -> Meta -> Meta
setMeta Text
"title"
((Inline -> Inline) -> Many Inline -> Many Inline
forall a b. Walkable a b => (a -> a) -> b -> b
walk Inline -> Inline
removeNote (Many Inline -> Many Inline) -> Many Inline -> Many Inline
forall a b. (a -> b) -> a -> b
$ [Inline] -> Many Inline
forall a. [a] -> Many a
fromList ([Inline] -> Many Inline) -> [Inline] -> Many Inline
forall a b. (a -> b) -> a -> b
$ Meta -> [Inline]
docTitle' Meta
meta) Meta
nullMeta)
([Block]
navBlocks [Block] -> [Block] -> [Block]
forall a. [a] -> [a] -> [a]
++ [Block]
landmarks))
String -> ByteString -> StateT EPUBState m Entry
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 =
Text -> [Element] -> Element
forall t. Node t => Text -> t -> Element
unode Text
"metadata" ([Element] -> Element) -> [(Text, Text)] -> [Element] -> Element
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")] ([Element] -> Element) -> [Element] -> Element
forall a b. (a -> b) -> a -> b
$ [Element]
mdNodes
where mdNodes :: [Element]
mdNodes = [Element]
identifierNodes [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++ [Element]
titleNodes [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++ [Element]
dateNodes
[Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++ [Element]
languageNodes [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++ [Element]
ibooksNodes [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++ [Element]
calibreNodes
[Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++ [Element]
creatorNodes [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++ [Element]
contributorNodes [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++ [Element]
subjectNodes
[Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++ [Element]
descriptionNodes [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++ [Element]
typeNodes [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++ [Element]
formatNodes
[Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++ [Element]
publisherNodes [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++ [Element]
sourceNodes [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++ [Element]
relationNodes
[Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++ [Element]
coverageNodes [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++ [Element]
rightsNodes [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++ [Element]
coverImageNodes
[Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++ [Element]
modifiedNodes [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++ [Element]
belongsToCollectionNodes
[Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++ case EPUBVersion
version of
EPUBVersion
EPUB2 -> []
EPUBVersion
EPUB3 -> [Element]
accessModeNodes [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++
[Element]
accessModeSufficientNodes [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++
[Element]
accessibilityFeatureNodes [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++
[Element]
accessibilityHazardNodes [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++
[Element]
accessibilitySummaryNodes
metaprop :: Text
metaprop = if EPUBVersion
version EPUBVersion -> EPUBVersion -> Bool
forall a. Eq a => a -> a -> Bool
== EPUBVersion
EPUB2 then Text
"name" else Text
"property"
withIds :: Text -> (Text -> b -> [a]) -> [b] -> [a]
withIds Text
base Text -> b -> [a]
f = [[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[a]] -> [a]) -> ([b] -> [[a]]) -> [b] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> b -> [a]) -> [Text] -> [b] -> [[a]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Text -> b -> [a]
f ((Int -> Text) -> [Int] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
x -> Text
base Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Char -> Text -> Text
T.cons Char
'-' (Int -> Text
forall a. Show a => a -> Text
tshow Int
x))
([Int
1..] :: [Int]))
identifierNodes :: [Element]
identifierNodes = Text
-> (Text -> Identifier -> [Element]) -> [Identifier] -> [Element]
forall {b} {a}. Text -> (Text -> b -> [a]) -> [b] -> [a]
withIds Text
"epub-id" Text -> Identifier -> [Element]
toIdentifierNode ([Identifier] -> [Element]) -> [Identifier] -> [Element]
forall a b. (a -> b) -> a -> b
$
EPUBMetadata -> [Identifier]
epubIdentifier EPUBMetadata
md
titleNodes :: [Element]
titleNodes = Text -> (Text -> Title -> [Element]) -> [Title] -> [Element]
forall {b} {a}. Text -> (Text -> b -> [a]) -> [b] -> [a]
withIds Text
"epub-title" Text -> Title -> [Element]
toTitleNode ([Title] -> [Element]) -> [Title] -> [Element]
forall a b. (a -> b) -> a -> b
$ EPUBMetadata -> [Title]
epubTitle EPUBMetadata
md
dateNodes :: [Element]
dateNodes = if EPUBVersion
version EPUBVersion -> EPUBVersion -> Bool
forall a. Eq a => a -> a -> Bool
== EPUBVersion
EPUB2
then Text -> (Text -> Date -> [Element]) -> [Date] -> [Element]
forall {b} {a}. Text -> (Text -> b -> [a]) -> [b] -> [a]
withIds Text
"epub-date" Text -> Date -> [Element]
toDateNode ([Date] -> [Element]) -> [Date] -> [Element]
forall a b. (a -> b) -> a -> b
$ EPUBMetadata -> [Date]
epubDate EPUBMetadata
md
else
case EPUBMetadata -> [Date]
epubDate EPUBMetadata
md of
[] -> []
(Date
x:[Date]
_) -> [Text -> Text -> Element
forall t. Node t => Text -> t -> Element
dcNode Text
"date" (Text -> Element) -> [(Text, Text)] -> Text -> Element
forall t. (t -> Element) -> [(Text, Text)] -> t -> Element
! [(Text
"id",Text
"epub-date")]
(Text -> Element) -> Text -> Element
forall a b. (a -> b) -> a -> b
$ Date -> Text
dateText Date
x]
ibooksNodes :: [Element]
ibooksNodes = ((Text, Text) -> Element) -> [(Text, Text)] -> [Element]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Text) -> Element
forall {b}. Node b => (Text, b) -> Element
ibooksNode (EPUBMetadata -> [(Text, Text)]
epubIbooksFields EPUBMetadata
md)
ibooksNode :: (Text, b) -> Element
ibooksNode (Text
k, b
v) = Text -> b -> Element
forall t. Node t => Text -> t -> Element
unode Text
"meta" (b -> Element) -> [(Text, Text)] -> b -> Element
forall t. (t -> Element) -> [(Text, Text)] -> t -> Element
! [(Text
metaprop, Text
"ibooks:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
k)] (b -> Element) -> b -> Element
forall a b. (a -> b) -> a -> b
$ b
v
calibreNodes :: [Element]
calibreNodes = ((Text, Text) -> Element) -> [(Text, Text)] -> [Element]
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) = Text -> () -> Element
forall t. Node t => Text -> t -> Element
unode Text
"meta" (() -> Element) -> [(Text, Text)] -> () -> Element
forall t. (t -> Element) -> [(Text, Text)] -> t -> Element
! [(Text
metaprop, Text
"calibre:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
k),
(Text
"content", Text
v)] (() -> Element) -> () -> Element
forall a b. (a -> b) -> a -> b
$ ()
languageNodes :: [Element]
languageNodes = [Text -> Text -> Element
forall t. Node t => Text -> t -> Element
dcTag Text
"language" (Text -> Element) -> Text -> Element
forall a b. (a -> b) -> a -> b
$ EPUBMetadata -> Text
epubLanguage EPUBMetadata
md]
creatorNodes :: [Element]
creatorNodes = Text -> (Text -> Creator -> [Element]) -> [Creator] -> [Element]
forall {b} {a}. Text -> (Text -> b -> [a]) -> [b] -> [a]
withIds Text
"epub-creator" (Text -> Text -> Creator -> [Element]
toCreatorNode Text
"creator") ([Creator] -> [Element]) -> [Creator] -> [Element]
forall a b. (a -> b) -> a -> b
$
EPUBMetadata -> [Creator]
epubCreator EPUBMetadata
md
contributorNodes :: [Element]
contributorNodes = Text -> (Text -> Creator -> [Element]) -> [Creator] -> [Element]
forall {b} {a}. Text -> (Text -> b -> [a]) -> [b] -> [a]
withIds Text
"epub-contributor"
(Text -> Text -> Creator -> [Element]
toCreatorNode Text
"contributor") ([Creator] -> [Element]) -> [Creator] -> [Element]
forall a b. (a -> b) -> a -> b
$ EPUBMetadata -> [Creator]
epubContributor EPUBMetadata
md
subjectNodes :: [Element]
subjectNodes = Text -> (Text -> Subject -> [Element]) -> [Subject] -> [Element]
forall {b} {a}. Text -> (Text -> b -> [a]) -> [b] -> [a]
withIds Text
"subject" Text -> Subject -> [Element]
toSubjectNode ([Subject] -> [Element]) -> [Subject] -> [Element]
forall a b. (a -> b) -> a -> b
$ EPUBMetadata -> [Subject]
epubSubject EPUBMetadata
md
descriptionNodes :: [Element]
descriptionNodes = [Element] -> (Text -> [Element]) -> Maybe Text -> [Element]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (Text -> Text -> [Element]
forall {t}. Node t => Text -> t -> [Element]
dcTag' Text
"description") (Maybe Text -> [Element]) -> Maybe Text -> [Element]
forall a b. (a -> b) -> a -> b
$ EPUBMetadata -> Maybe Text
epubDescription EPUBMetadata
md
typeNodes :: [Element]
typeNodes = [Element] -> (Text -> [Element]) -> Maybe Text -> [Element]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (Text -> Text -> [Element]
forall {t}. Node t => Text -> t -> [Element]
dcTag' Text
"type") (Maybe Text -> [Element]) -> Maybe Text -> [Element]
forall a b. (a -> b) -> a -> b
$ EPUBMetadata -> Maybe Text
epubType EPUBMetadata
md
formatNodes :: [Element]
formatNodes = [Element] -> (Text -> [Element]) -> Maybe Text -> [Element]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (Text -> Text -> [Element]
forall {t}. Node t => Text -> t -> [Element]
dcTag' Text
"format") (Maybe Text -> [Element]) -> Maybe Text -> [Element]
forall a b. (a -> b) -> a -> b
$ EPUBMetadata -> Maybe Text
epubFormat EPUBMetadata
md
publisherNodes :: [Element]
publisherNodes = [Element] -> (Text -> [Element]) -> Maybe Text -> [Element]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (Text -> Text -> [Element]
forall {t}. Node t => Text -> t -> [Element]
dcTag' Text
"publisher") (Maybe Text -> [Element]) -> Maybe Text -> [Element]
forall a b. (a -> b) -> a -> b
$ EPUBMetadata -> Maybe Text
epubPublisher EPUBMetadata
md
sourceNodes :: [Element]
sourceNodes = [Element] -> (Text -> [Element]) -> Maybe Text -> [Element]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (Text -> Text -> [Element]
forall {t}. Node t => Text -> t -> [Element]
dcTag' Text
"source") (Maybe Text -> [Element]) -> Maybe Text -> [Element]
forall a b. (a -> b) -> a -> b
$ EPUBMetadata -> Maybe Text
epubSource EPUBMetadata
md
relationNodes :: [Element]
relationNodes = [Element] -> (Text -> [Element]) -> Maybe Text -> [Element]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (Text -> Text -> [Element]
forall {t}. Node t => Text -> t -> [Element]
dcTag' Text
"relation") (Maybe Text -> [Element]) -> Maybe Text -> [Element]
forall a b. (a -> b) -> a -> b
$ EPUBMetadata -> Maybe Text
epubRelation EPUBMetadata
md
coverageNodes :: [Element]
coverageNodes = [Element] -> (Text -> [Element]) -> Maybe Text -> [Element]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (Text -> Text -> [Element]
forall {t}. Node t => Text -> t -> [Element]
dcTag' Text
"coverage") (Maybe Text -> [Element]) -> Maybe Text -> [Element]
forall a b. (a -> b) -> a -> b
$ EPUBMetadata -> Maybe Text
epubCoverage EPUBMetadata
md
rightsNodes :: [Element]
rightsNodes = [Element] -> (Text -> [Element]) -> Maybe Text -> [Element]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (Text -> Text -> [Element]
forall {t}. Node t => Text -> t -> [Element]
dcTag' Text
"rights") (Maybe Text -> [Element]) -> Maybe Text -> [Element]
forall a b. (a -> b) -> a -> b
$ EPUBMetadata -> Maybe Text
epubRights EPUBMetadata
md
coverImageNodes :: [Element]
coverImageNodes = [Element] -> (String -> [Element]) -> Maybe String -> [Element]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe []
(\String
img -> [Text -> () -> Element
forall t. Node t => Text -> t -> Element
unode Text
"meta" (() -> Element) -> [(Text, Text)] -> () -> Element
forall t. (t -> Element) -> [(Text, Text)] -> t -> Element
! [(Text
metaprop,Text
"cover"),
(Text
"content",String -> Text
toId String
img)] (() -> Element) -> () -> Element
forall a b. (a -> b) -> a -> b
$ ()
| EPUBVersion
version EPUBVersion -> EPUBVersion -> Bool
forall a. Eq a => a -> a -> Bool
== EPUBVersion
EPUB2])
(Maybe String -> [Element]) -> Maybe String -> [Element]
forall a b. (a -> b) -> a -> b
$ EPUBMetadata -> Maybe String
epubCoverImage EPUBMetadata
md
modifiedNodes :: [Element]
modifiedNodes = [ Text -> Text -> Element
forall t. Node t => Text -> t -> Element
unode Text
"meta" (Text -> Element) -> [(Text, Text)] -> Text -> Element
forall t. (t -> Element) -> [(Text, Text)] -> t -> Element
! [(Text
metaprop, Text
"dcterms:modified")] (Text -> Element) -> Text -> Element
forall a b. (a -> b) -> a -> b
$
UTCTime -> Text
showDateTimeISO8601 UTCTime
currentTime | EPUBVersion
version EPUBVersion -> EPUBVersion -> Bool
forall a. Eq a => a -> a -> Bool
== EPUBVersion
EPUB3 ]
belongsToCollectionNodes :: [Element]
belongsToCollectionNodes =
[Element] -> (Text -> [Element]) -> Maybe Text -> [Element]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe []
(\Text
belongsToCollection -> (Text -> Text -> Element
forall t. Node t => Text -> t -> Element
unode Text
"meta" (Text -> Element) -> [(Text, Text)] -> Text -> Element
forall t. (t -> Element) -> [(Text, Text)] -> t -> Element
! [(Text
metaprop, Text
"belongs-to-collection"), (Text
"id", Text
"epub-collection-1")] (Text -> Element) -> Text -> Element
forall a b. (a -> b) -> a -> b
$ Text
belongsToCollection )
Element -> [Element] -> [Element]
forall a. a -> [a] -> [a]
:
[Text -> Text -> Element
forall t. Node t => Text -> t -> Element
unode Text
"meta" (Text -> Element) -> [(Text, Text)] -> Text -> Element
forall t. (t -> Element) -> [(Text, Text)] -> t -> Element
! [(Text
"refines", Text
"#epub-collection-1"), (Text
metaprop, Text
"collection-type")] (Text -> Element) -> Text -> Element
forall a b. (a -> b) -> a -> b
$ (Text
"series" :: Text) ])
(EPUBMetadata -> Maybe Text
epubBelongsToCollection EPUBMetadata
md)[Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++
[Element] -> (Text -> [Element]) -> Maybe Text -> [Element]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe []
(\Text
groupPosition -> [Text -> Text -> Element
forall t. Node t => Text -> t -> Element
unode Text
"meta" (Text -> Element) -> [(Text, Text)] -> Text -> Element
forall t. (t -> Element) -> [(Text, Text)] -> t -> Element
! [(Text
"refines", Text
"#epub-collection-1"), (Text
metaprop, Text
"group-position")] (Text -> Element) -> Text -> Element
forall a b. (a -> b) -> a -> b
$ Text
groupPosition ])
(EPUBMetadata -> Maybe Text
epubGroupPosition EPUBMetadata
md)
schemanode :: Text -> p -> Element
schemanode Text
k p
v = Text -> p -> Element
forall t. Node t => Text -> t -> Element
unode Text
"meta" (p -> Element) -> [(Text, Text)] -> p -> Element
forall t. (t -> Element) -> [(Text, Text)] -> t -> Element
! [(Text
metaprop, Text
"schema:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
k)] (p -> Element) -> p -> Element
forall a b. (a -> b) -> a -> b
$ p
v
accessModeNodes :: [Element]
accessModeNodes = (Text -> Element) -> [Text] -> [Element]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Text -> Element
forall t. Node t => Text -> t -> Element
schemanode Text
"accessMode") (EPUBMetadata -> [Text]
epubAccessModes EPUBMetadata
md)
accessModeSufficientNodes :: [Element]
accessModeSufficientNodes = (Text -> Element) -> [Text] -> [Element]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Text -> Element
forall t. Node t => Text -> t -> Element
schemanode Text
"accessModeSufficient") (EPUBMetadata -> [Text]
epubAccessModeSufficient EPUBMetadata
md)
accessibilityFeatureNodes :: [Element]
accessibilityFeatureNodes = (Text -> Element) -> [Text] -> [Element]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Text -> Element
forall t. Node t => Text -> t -> Element
schemanode Text
"accessibilityFeature")
(EPUBMetadata -> [Text]
epubAccessibilityFeatures EPUBMetadata
md)
accessibilityHazardNodes :: [Element]
accessibilityHazardNodes = (Text -> Element) -> [Text] -> [Element]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Text -> Element
forall t. Node t => Text -> t -> Element
schemanode Text
"accessibilityHazard")
(EPUBMetadata -> [Text]
epubAccessibilityHazards EPUBMetadata
md)
accessibilitySummaryNodes :: [Element]
accessibilitySummaryNodes = [Element] -> (Text -> [Element]) -> Maybe Text -> [Element]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Text
summary -> [Text -> Text -> Element
forall t. Node t => Text -> t -> Element
schemanode Text
"accessibilitySummary" Text
summary]) (Maybe Text -> [Element]) -> Maybe Text -> [Element]
forall a b. (a -> b) -> a -> b
$ EPUBMetadata -> Maybe Text
epubAccessibilitySummary EPUBMetadata
md
dcTag :: Text -> t -> Element
dcTag Text
n t
s = Text -> t -> Element
forall t. Node t => Text -> t -> Element
unode (Text
"dc:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
n) t
s
dcTag' :: Text -> t -> [Element]
dcTag' Text
n t
s = [Text -> t -> Element
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 EPUBVersion -> EPUBVersion -> Bool
forall a. Eq a => a -> a -> Bool
== EPUBVersion
EPUB2 = [Text -> Text -> Element
forall t. Node t => Text -> t -> Element
dcNode Text
"identifier" (Text -> Element) -> [(Text, Text)] -> Text -> Element
forall t. (t -> Element) -> [(Text, Text)] -> t -> Element
!
((Text
"id",Text
id') (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
: [(Text, Text)]
-> (Text -> [(Text, Text)]) -> Maybe Text -> [(Text, Text)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Text
x -> [(Text
"opf:scheme", Text
x)]) Maybe Text
scheme) (Text -> Element) -> Text -> Element
forall a b. (a -> b) -> a -> b
$
Text
txt]
| Bool
otherwise = (Text -> Text -> Element
forall t. Node t => Text -> t -> Element
dcNode Text
"identifier" (Text -> Element) -> [(Text, Text)] -> Text -> Element
forall t. (t -> Element) -> [(Text, Text)] -> t -> Element
! [(Text
"id",Text
id')] (Text -> Element) -> Text -> Element
forall a b. (a -> b) -> a -> b
$ Text
txt) Element -> [Element] -> [Element]
forall a. a -> [a] -> [a]
:
[Element] -> (Text -> [Element]) -> Maybe Text -> [Element]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ((\Text
x -> [Text -> Text -> Element
forall t. Node t => Text -> t -> Element
unode Text
"meta" (Text -> Element) -> [(Text, Text)] -> Text -> Element
forall t. (t -> Element) -> [(Text, Text)] -> t -> Element
!
[ (Text
"refines",Text
"#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
id')
, (Text
metaprop,Text
"identifier-type")
, (Text
"scheme",Text
"onix:codelist5")
]
(Text -> Element) -> Text -> Element
forall a b. (a -> b) -> a -> b
$ Text
x
])
(Text -> [Element]) -> (Text -> Text) -> Text -> [Element]
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 EPUBVersion -> EPUBVersion -> Bool
forall a. Eq a => a -> a -> Bool
== EPUBVersion
EPUB2 = [Text -> Text -> Element
forall t. Node t => Text -> t -> Element
dcNode Text
s (Text -> Element) -> [(Text, Text)] -> Text -> Element
forall t. (t -> Element) -> [(Text, Text)] -> t -> Element
!
((Text
"id",Text
id') (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
:
[(Text, Text)]
-> (Text -> [(Text, Text)]) -> Maybe Text -> [(Text, Text)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Text
x -> [(Text
"opf:file-as",Text
x)]) (Creator -> Maybe Text
creatorFileAs Creator
creator) [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++
[(Text, Text)]
-> (Text -> [(Text, Text)]) -> Maybe Text -> [(Text, Text)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Text
x -> [(Text
"opf:role",Text
x)])
(Creator -> Maybe Text
creatorRole Creator
creator Maybe Text -> (Text -> Maybe Text) -> Maybe Text
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe Text
toRelator)) (Text -> Element) -> Text -> Element
forall a b. (a -> b) -> a -> b
$ Creator -> Text
creatorText Creator
creator]
| Bool
otherwise = [Text -> Text -> Element
forall t. Node t => Text -> t -> Element
dcNode Text
s (Text -> Element) -> [(Text, Text)] -> Text -> Element
forall t. (t -> Element) -> [(Text, Text)] -> t -> Element
! [(Text
"id",Text
id')] (Text -> Element) -> Text -> Element
forall a b. (a -> b) -> a -> b
$ Creator -> Text
creatorText Creator
creator] [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++
[Element] -> (Text -> [Element]) -> Maybe Text -> [Element]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Text
x -> [Text -> Text -> Element
forall t. Node t => Text -> t -> Element
unode Text
"meta" (Text -> Element) -> [(Text, Text)] -> Text -> Element
forall t. (t -> Element) -> [(Text, Text)] -> t -> Element
!
[(Text
"refines",Text
"#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
id'),(Text
metaprop,Text
"file-as")] (Text -> Element) -> Text -> Element
forall a b. (a -> b) -> a -> b
$ Text
x])
(Creator -> Maybe Text
creatorFileAs Creator
creator) [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++
[Element] -> (Text -> [Element]) -> Maybe Text -> [Element]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Text
x -> [Text -> Text -> Element
forall t. Node t => Text -> t -> Element
unode Text
"meta" (Text -> Element) -> [(Text, Text)] -> Text -> Element
forall t. (t -> Element) -> [(Text, Text)] -> t -> Element
!
[(Text
"refines",Text
"#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
id'),(Text
metaprop,Text
"role"),
(Text
"scheme",Text
"marc:relators")] (Text -> Element) -> Text -> Element
forall a b. (a -> b) -> a -> b
$ Text
x])
(Creator -> Maybe Text
creatorRole Creator
creator Maybe Text -> (Text -> Maybe Text) -> Maybe Text
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
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 EPUBVersion -> EPUBVersion -> Bool
forall a. Eq a => a -> a -> Bool
== EPUBVersion
EPUB2 = [Text -> Text -> Element
forall t. Node t => Text -> t -> Element
dcNode Text
"title" (Text -> Element) -> [(Text, Text)] -> Text -> Element
forall t. (t -> Element) -> [(Text, Text)] -> t -> Element
!
((Text
"id",Text
id') (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
:
[(Text, Text)]
-> (Text -> [(Text, Text)]) -> Maybe Text -> [(Text, Text)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Text
x -> [(Text
"opf:file-as",Text
x)]) (Title -> Maybe Text
titleFileAs Title
title)) (Text -> Element) -> Text -> Element
forall a b. (a -> b) -> a -> b
$
Title -> Text
titleText Title
title]
| Bool
otherwise = [Text -> Text -> Element
forall t. Node t => Text -> t -> Element
dcNode Text
"title" (Text -> Element) -> [(Text, Text)] -> Text -> Element
forall t. (t -> Element) -> [(Text, Text)] -> t -> Element
! [(Text
"id",Text
id')] (Text -> Element) -> Text -> Element
forall a b. (a -> b) -> a -> b
$ Title -> Text
titleText Title
title]
[Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++
[Element] -> (Text -> [Element]) -> Maybe Text -> [Element]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Text
x -> [Text -> Text -> Element
forall t. Node t => Text -> t -> Element
unode Text
"meta" (Text -> Element) -> [(Text, Text)] -> Text -> Element
forall t. (t -> Element) -> [(Text, Text)] -> t -> Element
!
[(Text
"refines",Text
"#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
id'),(Text
metaprop,Text
"file-as")] (Text -> Element) -> Text -> Element
forall a b. (a -> b) -> a -> b
$ Text
x])
(Title -> Maybe Text
titleFileAs Title
title) [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++
[Element] -> (Text -> [Element]) -> Maybe Text -> [Element]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Text
x -> [Text -> Text -> Element
forall t. Node t => Text -> t -> Element
unode Text
"meta" (Text -> Element) -> [(Text, Text)] -> Text -> Element
forall t. (t -> Element) -> [(Text, Text)] -> t -> Element
!
[(Text
"refines",Text
"#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
id'),(Text
metaprop,Text
"title-type")] (Text -> Element) -> Text -> Element
forall a b. (a -> b) -> a -> b
$ Text
x])
(Title -> Maybe Text
titleType Title
title)
toDateNode :: Text -> Date -> [Element]
toDateNode Text
id' Date
date = [Text -> Text -> Element
forall t. Node t => Text -> t -> Element
dcNode Text
"date" (Text -> Element) -> [(Text, Text)] -> Text -> Element
forall t. (t -> Element) -> [(Text, Text)] -> t -> Element
!
((Text
"id",Text
id') (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
:
[(Text, Text)]
-> (Text -> [(Text, Text)]) -> Maybe Text -> [(Text, Text)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Text
x -> [(Text
"opf:event",Text
x)]) (Date -> Maybe Text
dateEvent Date
date)) (Text -> Element) -> Text -> Element
forall a b. (a -> b) -> a -> b
$
Date -> Text
dateText Date
date]
toSubjectNode :: Text -> Subject -> [Element]
toSubjectNode Text
id' Subject
subject
| EPUBVersion
version EPUBVersion -> EPUBVersion -> Bool
forall a. Eq a => a -> a -> Bool
== EPUBVersion
EPUB2 = [Text -> Text -> Element
forall t. Node t => Text -> t -> Element
dcNode Text
"subject" (Text -> Element) -> [(Text, Text)] -> Text -> Element
forall t. (t -> Element) -> [(Text, Text)] -> t -> Element
!
[(Text
"id",Text
id')] (Text -> Element) -> Text -> Element
forall a b. (a -> b) -> a -> b
$ Subject -> Text
subjectText Subject
subject]
| Bool
otherwise = (Text -> Text -> Element
forall t. Node t => Text -> t -> Element
dcNode Text
"subject" (Text -> Element) -> [(Text, Text)] -> Text -> Element
forall t. (t -> Element) -> [(Text, Text)] -> t -> Element
! [(Text
"id",Text
id')] (Text -> Element) -> Text -> Element
forall a b. (a -> b) -> a -> b
$ Subject -> Text
subjectText Subject
subject)
Element -> [Element] -> [Element]
forall a. a -> [a] -> [a]
: [Element] -> (Text -> [Element]) -> Maybe Text -> [Element]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Text
x -> (Text -> Text -> Element
forall t. Node t => Text -> t -> Element
unode Text
"meta" (Text -> Element) -> [(Text, Text)] -> Text -> Element
forall t. (t -> Element) -> [(Text, Text)] -> t -> Element
!
[(Text
"refines", Text
"#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
id'),(Text
metaprop,Text
"authority")] (Text -> Element) -> Text -> Element
forall a b. (a -> b) -> a -> b
$ Text
x) Element -> [Element] -> [Element]
forall a. a -> [a] -> [a]
:
[Element] -> (Text -> [Element]) -> Maybe Text -> [Element]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Text
y -> [Text -> Text -> Element
forall t. Node t => Text -> t -> Element
unode Text
"meta" (Text -> Element) -> [(Text, Text)] -> Text -> Element
forall t. (t -> Element) -> [(Text, Text)] -> t -> Element
!
[(Text
"refines", Text
"#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
id'),(Text
metaprop,Text
"term")] (Text -> Element) -> Text -> Element
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 (String -> Text) -> (UTCTime -> String) -> UTCTime -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeLocale -> String -> UTCTime -> String
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 Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"video", Text
"source", Text
"img", Text
"audio"] Bool -> Bool -> Bool
&&
Maybe Text -> Bool
forall a. Maybe a -> Bool
isNothing (Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"data-external" [(Text, Text)]
attr) = do
let src :: Text
src = Text -> Tag Text -> Text
forall str.
(Show str, Eq str, StringLike str) =>
str -> Tag str -> str
fromAttrib Text
"src" Tag Text
tag
let poster :: Text
poster = Text -> Tag Text -> Text
forall str.
(Show str, Eq str, StringLike str) =>
str -> Tag str -> str
fromAttrib Text
"poster" Tag Text
tag
Text
newsrc <- String -> E m Text
forall (m :: * -> *). PandocMonad m => String -> E m Text
modifyMediaRef (String -> E m Text) -> String -> E m Text
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
src
Text
newposter <- String -> E m Text
forall (m :: * -> *). PandocMonad m => String -> E m Text
modifyMediaRef (String -> E m Text) -> String -> E m Text
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
poster
let attr' :: [(Text, Text)]
attr' = ((Text, Text) -> Bool) -> [(Text, Text)] -> [(Text, Text)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Text
x,Text
_) -> Text
x Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"src" Bool -> Bool -> Bool
&& Text
x Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"poster") [(Text, Text)]
attr [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++
[(Text
"src", Text
"../" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
newsrc) | Bool -> Bool
not (Text -> Bool
T.null Text
newsrc)] [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++
[(Text
"poster", Text
"../" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
newposter) | Bool -> Bool
not (Text -> Bool
T.null Text
newposter)]
Tag Text -> E m (Tag Text)
forall a. a -> StateT EPUBState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Tag Text -> E m (Tag Text)) -> Tag Text -> E m (Tag Text)
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)] -> Tag Text
forall str. str -> [Attribute str] -> Tag str
TagOpen Text
name [(Text, Text)]
attr'
transformTag Tag Text
tag = Tag Text -> E m (Tag Text)
forall a. a -> StateT EPUBState m a
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
"" = Text -> StateT EPUBState m Text
forall a. a -> StateT EPUBState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
""
modifyMediaRef String
oldsrc = do
[(String, (String, Maybe Entry))]
media <- (EPUBState -> [(String, (String, Maybe Entry))])
-> StateT EPUBState m [(String, (String, Maybe Entry))]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets EPUBState -> [(String, (String, Maybe Entry))]
stMediaPaths
case String
-> [(String, (String, Maybe Entry))] -> Maybe (String, Maybe Entry)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
oldsrc [(String, (String, Maybe Entry))]
media of
Just (String
n,Maybe Entry
_) -> Text -> StateT EPUBState m Text
forall a. a -> StateT EPUBState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> StateT EPUBState m Text)
-> Text -> StateT EPUBState m Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
n
Maybe (String, Maybe Entry)
Nothing -> StateT EPUBState m Text
-> (PandocError -> StateT EPUBState m Text)
-> StateT EPUBState m Text
forall a.
StateT EPUBState m a
-> (PandocError -> StateT EPUBState m a) -> StateT EPUBState m a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError
(do (ByteString
img, Maybe Text
mbMime) <- Text -> StateT EPUBState m (ByteString, Maybe Text)
forall (m :: * -> *).
PandocMonad m =>
Text -> m (ByteString, Maybe Text)
P.fetchItem (Text -> StateT EPUBState m (ByteString, Maybe Text))
-> Text -> StateT EPUBState m (ByteString, Maybe Text)
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
oldsrc
let ext :: String
ext = String -> (Text -> String) -> Maybe Text -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
(ShowS
takeExtension ((Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'?') String
oldsrc))
(Text -> String
T.unpack (Text -> String) -> (Text -> Text) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>))
(Maybe Text
mbMime Maybe Text -> (Text -> Maybe Text) -> Maybe Text
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe Text
extensionFromMimeType)
String
newName <- String -> E m String
forall (m :: * -> *). PandocMonad m => String -> E m String
getMediaNextNewName String
ext
let newPath :: String
newPath = String
"media/" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
newName
Entry
entry <- String -> ByteString -> E m Entry
forall (m :: * -> *).
PandocMonad m =>
String -> ByteString -> E m Entry
mkEntry String
newPath ([ByteString] -> ByteString
B.fromChunks ([ByteString] -> ByteString)
-> (ByteString -> [ByteString]) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:[]) (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString
img)
(EPUBState -> EPUBState) -> StateT EPUBState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((EPUBState -> EPUBState) -> StateT EPUBState m ())
-> (EPUBState -> EPUBState) -> StateT EPUBState m ()
forall a b. (a -> b) -> a -> b
$ \EPUBState
st -> EPUBState
st{ stMediaPaths =
(oldsrc, (newPath, Just entry)):media}
Text -> StateT EPUBState m Text
forall a. a -> StateT EPUBState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> StateT EPUBState m Text)
-> Text -> StateT EPUBState m Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
newPath)
(\PandocError
e -> do
LogMessage -> StateT EPUBState m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> StateT EPUBState m ())
-> LogMessage -> StateT EPUBState m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> LogMessage
CouldNotFetchResource (String -> Text
T.pack String
oldsrc) (PandocError -> Text
forall a. Show a => a -> Text
tshow PandocError
e)
Text -> StateT EPUBState m Text
forall a. a -> StateT EPUBState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> StateT EPUBState m Text)
-> Text -> StateT EPUBState m Text
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 <- (EPUBState -> Int) -> StateT EPUBState m Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets EPUBState -> Int
stMediaNextId
(EPUBState -> EPUBState) -> StateT EPUBState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((EPUBState -> EPUBState) -> StateT EPUBState m ())
-> (EPUBState -> EPUBState) -> StateT EPUBState m ()
forall a b. (a -> b) -> a -> b
$ \EPUBState
st -> EPUBState
st { stMediaNextId = nextId + 1 }
String -> E m String
forall a. a -> StateT EPUBState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> E m String) -> String -> E m String
forall a b. (a -> b) -> a -> b
$ String
"file" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
nextId String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
ext
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 = Text -> [Tag Text]
forall str. StringLike str => str -> [Tag str]
parseTags Text
raw
[Tag Text]
tags' <- (Tag Text -> StateT EPUBState m (Tag Text))
-> [Tag Text] -> StateT EPUBState m [Tag Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Tag Text -> StateT EPUBState m (Tag Text)
forall (m :: * -> *). PandocMonad m => Tag Text -> E m (Tag Text)
transformTag [Tag Text]
tags
Block -> E m Block
forall a. a -> StateT EPUBState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Block -> E m Block) -> Block -> E m Block
forall a b. (a -> b) -> a -> b
$ Format -> Text -> Block
RawBlock Format
fmt ([Tag Text] -> Text
renderTags' [Tag Text]
tags')
transformBlock Block
b = Block -> E m Block
forall a. a -> StateT EPUBState m a
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))
| Maybe Text -> Bool
forall a. Maybe a -> Bool
isNothing (Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"external" [(Text, Text)]
kvs) = do
Text
newsrc <- String -> E m Text
forall (m :: * -> *). PandocMonad m => String -> E m Text
modifyMediaRef (String -> E m Text) -> String -> E m Text
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
src
Inline -> E m Inline
forall a. a -> StateT EPUBState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Inline -> E m Inline) -> Inline -> E m Inline
forall a b. (a -> b) -> a -> b
$ Attr -> [Inline] -> (Text, Text) -> Inline
Image Attr
attr [Inline]
lab (Text
"../" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
newsrc, Text
tit)
transformInline WriterOptions
opts x :: Inline
x@(Math MathType
t Text
m)
| WebTeX Text
url <- WriterOptions -> HTMLMathMethod
writerHTMLMathMethod WriterOptions
opts = do
Text
newsrc <- String -> E m Text
forall (m :: * -> *). PandocMonad m => String -> E m Text
modifyMediaRef (Text -> String
T.unpack (Text
url Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
urlEncode Text
m))
let mathclass :: Text
mathclass = if MathType
t MathType -> MathType -> Bool
forall a. Eq a => a -> a -> Bool
== MathType
DisplayMath then Text
"display" else Text
"inline"
Inline -> E m Inline
forall a. a -> StateT EPUBState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Inline -> E m Inline) -> Inline -> E m Inline
forall a b. (a -> b) -> a -> b
$ Attr -> [Inline] -> Inline
Span (Text
"",[Text
"math",Text
mathclass],[])
[Attr -> [Inline] -> (Text, Text) -> Inline
Image Attr
nullAttr [Inline
x] (Text
"../" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
newsrc, Text
"")]
transformInline WriterOptions
_opts (RawInline Format
fmt Text
raw)
| Format -> Bool
isHtmlFormat Format
fmt = do
let tags :: [Tag Text]
tags = Text -> [Tag Text]
forall str. StringLike str => str -> [Tag str]
parseTags Text
raw
[Tag Text]
tags' <- (Tag Text -> StateT EPUBState m (Tag Text))
-> [Tag Text] -> StateT EPUBState m [Tag Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Tag Text -> StateT EPUBState m (Tag Text)
forall (m :: * -> *). PandocMonad m => Tag Text -> E m (Tag Text)
transformTag [Tag Text]
tags
Inline -> E m Inline
forall a. a -> StateT EPUBState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Inline -> E m Inline) -> Inline -> E m Inline
forall a b. (a -> b) -> a -> b
$ Format -> Text -> Inline
RawInline Format
fmt ([Tag Text] -> Text
renderTags' [Tag Text]
tags')
transformInline WriterOptions
_ Inline
x = Inline -> E m Inline
forall a. a -> StateT EPUBState m a
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 (((Text, Text) -> Attr) -> [(Text, Text)] -> [Attr]
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 | (Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Text -> Text -> Bool
`T.isPrefixOf` Text
y) [Text]
mediaPrefixes -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
y
Maybe Text
_ -> Maybe Text
forall a. Maybe a
Nothing
showChapter :: Int -> Text
showChapter :: Int -> Text
showChapter = String -> Text
T.pack (String -> Text) -> (Int -> String) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"ch%03d.xhtml"
addIdentifiers :: WriterOptions -> [Block] -> [Block]
addIdentifiers :: WriterOptions -> [Block] -> [Block]
addIdentifiers WriterOptions
opts [Block]
bs = State (Set Text) [Block] -> Set Text -> [Block]
forall s a. State s a -> s -> a
evalState ((Block -> StateT (Set Text) Identity Block)
-> [Block] -> State (Set Text) [Block]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Block -> StateT (Set Text) Identity Block
forall {m :: * -> *}. MonadState (Set Text) m => Block -> m Block
go [Block]
bs) Set Text
forall a. Set a
Set.empty
where go :: Block -> m Block
go (Header Int
n (Text
ident,[Text]
classes,[(Text, Text)]
kvs) [Inline]
ils) = do
Set Text
ids <- m (Set Text)
forall s (m :: * -> *). MonadState s m => m s
get
let ident' :: Text
ident' = if Text -> Bool
T.null Text
ident
then Extensions -> [Inline] -> Set Text -> Text
uniqueIdent (WriterOptions -> Extensions
writerExtensions WriterOptions
opts) [Inline]
ils Set Text
ids
else Text
ident
(Set Text -> Set Text) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((Set Text -> Set Text) -> m ()) -> (Set Text -> Set Text) -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Set Text -> Set Text
forall a. Ord a => a -> Set a -> Set a
Set.insert Text
ident'
Block -> m Block
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Block -> m Block) -> Block -> m Block
forall a b. (a -> b) -> a -> b
$ Int -> Attr -> [Inline] -> Block
Header Int
n (Text
ident',[Text]
classes,[(Text, Text)]
kvs) [Inline]
ils
go Block
x = Block -> m Block
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Block
x
normalizeDate' :: Text -> Maybe Text
normalizeDate' :: Text -> Maybe Text
normalizeDate' = Text -> Maybe Text
go (Text -> Maybe Text) -> (Text -> Text) -> Text -> Maybe Text
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 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
4
, (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isDigit Text
xs = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
xs
| (Text
y, Text
s) <- Int -> Text -> (Text, Text)
T.splitAt Int
4 Text
xs
, Just (Char
'-', Text
m) <- Text -> Maybe (Char, Text)
T.uncons Text
s
, Text -> Int
T.length Text
m Int -> Int -> Bool
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 = Text -> Maybe Text
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 Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
relators = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
x
| Bool
otherwise = Text -> [(Text, Text)] -> Maybe Text
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 = ((Text, Text) -> Text) -> [(Text, Text)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Text) -> Text
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 = [Inline] -> (MetaValue -> [Inline]) -> Maybe MetaValue -> [Inline]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] MetaValue -> [Inline]
go (Maybe MetaValue -> [Inline]) -> Maybe MetaValue -> [Inline]
forall a b. (a -> b) -> a -> b
$ Text -> Meta -> Maybe MetaValue
lookupMeta Text
"title" Meta
meta
where go :: MetaValue -> [Inline]
go (MetaString Text
s) = [Text -> Inline
Str Text
s]
go (MetaInlines [Inline]
xs) = [Inline]
xs
go (MetaBlocks [Para [Inline]
xs]) = [Inline]
xs
go (MetaBlocks [Plain [Inline]
xs]) = [Inline]
xs
go (MetaMap Map Text MetaValue
m) =
case Text -> Map Text MetaValue -> Maybe MetaValue
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
"type" Map Text MetaValue
m of
Just MetaValue
x | MetaValue -> Text
forall a. Walkable Inline a => a -> Text
stringify MetaValue
x Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"main" ->
[Inline] -> (MetaValue -> [Inline]) -> Maybe MetaValue -> [Inline]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] MetaValue -> [Inline]
go (Maybe MetaValue -> [Inline]) -> Maybe MetaValue -> [Inline]
forall a b. (a -> b) -> a -> b
$ Text -> Map Text MetaValue -> Maybe MetaValue
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
"text" Map Text MetaValue
m
Maybe MetaValue
_ -> []
go (MetaList [MetaValue]
xs) = (MetaValue -> [Inline]) -> [MetaValue] -> [Inline]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap MetaValue -> [Inline]
go [MetaValue]
xs
go MetaValue
_ = []