{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE OverloadedStrings #-}
module Text.Pandoc.Readers.FB2 ( readFB2 ) where
import Control.Monad.Except (throwError)
import Control.Monad.State.Strict
import Data.ByteString.Base64.Lazy
import Data.Functor
import Data.List (intersperse)
import qualified Data.Map as M
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import Data.Default
import Data.Maybe
import Text.Pandoc.XML (lookupEntity)
import Text.Pandoc.Builder
import Text.Pandoc.Class.PandocMonad (PandocMonad, insertMedia, report)
import Text.Pandoc.Error
import Text.Pandoc.Logging
import Text.Pandoc.Options
import Text.Pandoc.XML.Light
import qualified Text.Pandoc.UTF8 as UTF8
import Text.Pandoc.Sources (ToSources(..), sourcesToText)
type FB2 m = StateT FB2State m
data FB2State = FB2State{ FB2State -> Int
fb2SectionLevel :: Int
, FB2State -> Meta
fb2Meta :: Meta
, FB2State -> [Text]
fb2Authors :: [Text]
, FB2State -> Map Text Blocks
fb2Notes :: M.Map Text Blocks
} deriving Int -> FB2State -> ShowS
[FB2State] -> ShowS
FB2State -> String
(Int -> FB2State -> ShowS)
-> (FB2State -> String) -> ([FB2State] -> ShowS) -> Show FB2State
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FB2State -> ShowS
showsPrec :: Int -> FB2State -> ShowS
$cshow :: FB2State -> String
show :: FB2State -> String
$cshowList :: [FB2State] -> ShowS
showList :: [FB2State] -> ShowS
Show
instance Default FB2State where
def :: FB2State
def = FB2State{ fb2SectionLevel :: Int
fb2SectionLevel = Int
1
, fb2Meta :: Meta
fb2Meta = Meta
forall a. Monoid a => a
mempty
, fb2Authors :: [Text]
fb2Authors = []
, fb2Notes :: Map Text Blocks
fb2Notes = Map Text Blocks
forall k a. Map k a
M.empty
}
instance HasMeta FB2State where
setMeta :: forall b. ToMetaValue b => Text -> b -> FB2State -> FB2State
setMeta Text
field b
v FB2State
s = FB2State
s {fb2Meta = setMeta field v (fb2Meta s)}
deleteMeta :: Text -> FB2State -> FB2State
deleteMeta Text
field FB2State
s = FB2State
s {fb2Meta = deleteMeta field (fb2Meta s)}
readFB2 :: (PandocMonad m, ToSources a)
=> ReaderOptions
-> a
-> m Pandoc
readFB2 :: forall (m :: * -> *) a.
(PandocMonad m, ToSources a) =>
ReaderOptions -> a -> m Pandoc
readFB2 ReaderOptions
_ a
inp =
case Text -> Either Text Element
parseXMLElement (Text -> Either Text Element) -> Text -> Either Text Element
forall a b. (a -> b) -> a -> b
$ Text -> Text
TL.fromStrict (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Sources -> Text
sourcesToText (Sources -> Text) -> Sources -> Text
forall a b. (a -> b) -> a -> b
$ a -> Sources
forall a. ToSources a => a -> Sources
toSources a
inp of
Left Text
msg -> PandocError -> m Pandoc
forall a. PandocError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError -> m Pandoc) -> PandocError -> m Pandoc
forall a b. (a -> b) -> a -> b
$ Text -> Text -> PandocError
PandocXMLError Text
"" Text
msg
Right Element
el -> do
(Blocks
bs, FB2State
st) <- StateT FB2State m Blocks -> FB2State -> m (Blocks, FB2State)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (Element -> StateT FB2State m Blocks
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseRootElement Element
el) FB2State
forall a. Default a => a
def
let authors :: Meta -> Meta
authors = if [Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Text] -> Bool) -> [Text] -> Bool
forall a b. (a -> b) -> a -> b
$ FB2State -> [Text]
fb2Authors FB2State
st
then Meta -> Meta
forall a. a -> a
id
else Text -> [Inlines] -> Meta -> Meta
forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
forall b. ToMetaValue b => Text -> b -> Meta -> Meta
setMeta Text
"author" ((Text -> Inlines) -> [Text] -> [Inlines]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Inlines
text ([Text] -> [Inlines]) -> [Text] -> [Inlines]
forall a b. (a -> b) -> a -> b
$ [Text] -> [Text]
forall a. [a] -> [a]
reverse ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ FB2State -> [Text]
fb2Authors FB2State
st)
Pandoc -> m Pandoc
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pandoc -> m Pandoc) -> Pandoc -> m Pandoc
forall a b. (a -> b) -> a -> b
$ Meta -> [Block] -> Pandoc
Pandoc (Meta -> Meta
authors (Meta -> Meta) -> Meta -> Meta
forall a b. (a -> b) -> a -> b
$ FB2State -> Meta
fb2Meta FB2State
st) ([Block] -> Pandoc) -> [Block] -> Pandoc
forall a b. (a -> b) -> a -> b
$ Blocks -> [Block]
forall a. Many a -> [a]
toList Blocks
bs
trim :: Text -> Text
trim :: Text -> Text
trim = Text -> Text
T.strip
removeHash :: Text -> Text
removeHash :: Text -> Text
removeHash Text
t = case Text -> Maybe (Char, Text)
T.uncons Text
t of
Just (Char
'#', Text
xs) -> Text
xs
Maybe (Char, Text)
_ -> Text
t
convertEntity :: Text -> Text
convertEntity :: Text -> Text
convertEntity Text
e = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe (Text -> Text
T.toUpper Text
e) (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
lookupEntity Text
e
parseInline :: PandocMonad m => Content -> FB2 m Inlines
parseInline :: forall (m :: * -> *). PandocMonad m => Content -> FB2 m Inlines
parseInline (Elem Element
e) =
case QName -> Text
qName (QName -> Text) -> QName -> Text
forall a b. (a -> b) -> a -> b
$ Element -> QName
elName Element
e of
Text
"strong" -> Inlines -> Inlines
strong (Inlines -> Inlines) -> FB2 m Inlines -> FB2 m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> FB2 m Inlines
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Inlines
parseStyleType Element
e
Text
"emphasis" -> Inlines -> Inlines
emph (Inlines -> Inlines) -> FB2 m Inlines -> FB2 m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> FB2 m Inlines
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Inlines
parseStyleType Element
e
Text
"style" -> Element -> FB2 m Inlines
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Inlines
parseNamedStyle Element
e
Text
"a" -> Element -> FB2 m Inlines
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Inlines
parseLinkType Element
e
Text
"strikethrough" -> Inlines -> Inlines
strikeout (Inlines -> Inlines) -> FB2 m Inlines -> FB2 m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> FB2 m Inlines
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Inlines
parseStyleType Element
e
Text
"sub" -> Inlines -> Inlines
subscript (Inlines -> Inlines) -> FB2 m Inlines -> FB2 m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> FB2 m Inlines
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Inlines
parseStyleType Element
e
Text
"sup" -> Inlines -> Inlines
superscript (Inlines -> Inlines) -> FB2 m Inlines -> FB2 m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> FB2 m Inlines
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Inlines
parseStyleType Element
e
Text
"code" -> Inlines -> FB2 m Inlines
forall a. a -> StateT FB2State m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inlines -> FB2 m Inlines) -> Inlines -> FB2 m Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Inlines
code (Text -> Inlines) -> Text -> Inlines
forall a b. (a -> b) -> a -> b
$ Element -> Text
strContent Element
e
Text
"image" -> Element -> FB2 m Inlines
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Inlines
parseInlineImageElement Element
e
Text
name -> do
LogMessage -> StateT FB2State m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> StateT FB2State m ())
-> LogMessage -> StateT FB2State m ()
forall a b. (a -> b) -> a -> b
$ Text -> LogMessage
IgnoredElement Text
name
Inlines -> FB2 m Inlines
forall a. a -> StateT FB2State m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Inlines
forall a. Monoid a => a
mempty
parseInline (Text CData
x) = Inlines -> FB2 m Inlines
forall a. a -> StateT FB2State m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inlines -> FB2 m Inlines) -> Inlines -> FB2 m Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Inlines
text (Text -> Inlines) -> Text -> Inlines
forall a b. (a -> b) -> a -> b
$ CData -> Text
cdData CData
x
parseInline (CRef Text
r) = Inlines -> FB2 m Inlines
forall a. a -> StateT FB2State m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inlines -> FB2 m Inlines) -> Inlines -> FB2 m Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Inlines
str (Text -> Inlines) -> Text -> Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Text
convertEntity Text
r
parseSubtitle :: PandocMonad m => Element -> FB2 m Blocks
parseSubtitle :: forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseSubtitle Element
e = Attr -> Int -> Inlines -> Blocks
headerWith (Text
"", [Text
"unnumbered"], []) (Int -> Inlines -> Blocks)
-> StateT FB2State m Int -> StateT FB2State m (Inlines -> Blocks)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FB2State -> Int) -> StateT FB2State m Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets FB2State -> Int
fb2SectionLevel StateT FB2State m (Inlines -> Blocks)
-> StateT FB2State m Inlines -> StateT FB2State m Blocks
forall a b.
StateT FB2State m (a -> b)
-> StateT FB2State m a -> StateT FB2State m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Element -> StateT FB2State m Inlines
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Inlines
parsePType Element
e
parseRootElement :: PandocMonad m => Element -> FB2 m Blocks
parseRootElement :: forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseRootElement Element
e =
case QName -> Text
qName (QName -> Text) -> QName -> Text
forall a b. (a -> b) -> a -> b
$ Element -> QName
elName Element
e of
Text
"FictionBook" -> do
case (Element -> Bool) -> Element -> Maybe Element
filterChild Element -> Bool
isNotesBody Element
e of
Maybe Element
Nothing -> () -> StateT FB2State m ()
forall a. a -> StateT FB2State m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Just Element
notesBody -> Element -> StateT FB2State m ()
forall (m :: * -> *). PandocMonad m => Element -> FB2 m ()
parseNotesBody Element
notesBody
[Blocks] -> Blocks
forall a. Monoid a => [a] -> a
mconcat ([Blocks] -> Blocks) -> StateT FB2State m [Blocks] -> FB2 m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Element -> FB2 m Blocks)
-> [Element] -> StateT FB2State m [Blocks]
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 Element -> FB2 m Blocks
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseFictionBookChild (Element -> [Element]
elChildren Element
e)
Text
name -> LogMessage -> StateT FB2State m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (Text -> Text -> LogMessage
UnexpectedXmlElement Text
name Text
"root") StateT FB2State m () -> Blocks -> FB2 m Blocks
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Blocks
forall a. Monoid a => a
mempty
parseNotesBody :: PandocMonad m => Element -> FB2 m ()
parseNotesBody :: forall (m :: * -> *). PandocMonad m => Element -> FB2 m ()
parseNotesBody Element
e = ()
forall a. Monoid a => a
mempty () -> StateT FB2State m [()] -> StateT FB2State m ()
forall a b. a -> StateT FB2State m b -> StateT FB2State m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Element -> StateT FB2State m ())
-> [Element] -> StateT FB2State m [()]
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 Element -> StateT FB2State m ()
forall (m :: * -> *). PandocMonad m => Element -> FB2 m ()
parseNotesBodyChild (Element -> [Element]
elChildren Element
e)
parseNotesBodyChild :: PandocMonad m => Element -> FB2 m ()
parseNotesBodyChild :: forall (m :: * -> *). PandocMonad m => Element -> FB2 m ()
parseNotesBodyChild Element
e =
case QName -> Text
qName (QName -> Text) -> QName -> Text
forall a b. (a -> b) -> a -> b
$ Element -> QName
elName Element
e of
Text
"section" -> Element -> FB2 m ()
forall (m :: * -> *). PandocMonad m => Element -> FB2 m ()
parseNote Element
e
Text
_ -> () -> FB2 m ()
forall a. a -> StateT FB2State m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
isNotesBody :: Element -> Bool
isNotesBody :: Element -> Bool
isNotesBody Element
e =
QName -> Text
qName (Element -> QName
elName Element
e) Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"body" Bool -> Bool -> Bool
&&
QName -> Element -> Maybe Text
findAttr (Text -> QName
unqual Text
"name") Element
e Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"notes"
parseNote :: PandocMonad m => Element -> FB2 m ()
parseNote :: forall (m :: * -> *). PandocMonad m => Element -> FB2 m ()
parseNote Element
e =
case QName -> Element -> Maybe Text
findAttr (Text -> QName
unqual Text
"id") Element
e of
Maybe Text
Nothing -> () -> FB2 m ()
forall a. a -> StateT FB2State m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Just Text
sectionId -> do
Blocks
content <- [Blocks] -> Blocks
forall a. Monoid a => [a] -> a
mconcat ([Blocks] -> Blocks)
-> StateT FB2State m [Blocks] -> StateT FB2State m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Element -> StateT FB2State m Blocks)
-> [Element] -> StateT FB2State m [Blocks]
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 Element -> StateT FB2State m Blocks
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseSectionChild ([Element] -> [Element]
dropTitle ([Element] -> [Element]) -> [Element] -> [Element]
forall a b. (a -> b) -> a -> b
$ Element -> [Element]
elChildren Element
e)
Map Text Blocks
oldNotes <- (FB2State -> Map Text Blocks)
-> StateT FB2State m (Map Text Blocks)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets FB2State -> Map Text Blocks
fb2Notes
(FB2State -> FB2State) -> FB2 m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((FB2State -> FB2State) -> FB2 m ())
-> (FB2State -> FB2State) -> FB2 m ()
forall a b. (a -> b) -> a -> b
$ \FB2State
s -> FB2State
s { fb2Notes = M.insert ("#" <> sectionId) content oldNotes }
() -> FB2 m ()
forall a. a -> StateT FB2State m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
where
isTitle :: Element -> Bool
isTitle Element
x = QName -> Text
qName (Element -> QName
elName Element
x) Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"title"
dropTitle :: [Element] -> [Element]
dropTitle (Element
x:[Element]
xs) = if Element -> Bool
isTitle Element
x
then [Element]
xs
else Element
xElement -> [Element] -> [Element]
forall a. a -> [a] -> [a]
:[Element]
xs
dropTitle [] = []
parseFictionBookChild :: PandocMonad m => Element -> FB2 m Blocks
parseFictionBookChild :: forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseFictionBookChild Element
e =
case QName -> Text
qName (QName -> Text) -> QName -> Text
forall a b. (a -> b) -> a -> b
$ Element -> QName
elName Element
e of
Text
"stylesheet" -> Blocks -> FB2 m Blocks
forall a. a -> StateT FB2State m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
forall a. Monoid a => a
mempty
Text
"description" -> Blocks
forall a. Monoid a => a
mempty Blocks -> StateT FB2State m () -> FB2 m Blocks
forall a b. a -> StateT FB2State m b -> StateT FB2State m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Element -> StateT FB2State m ())
-> [Element] -> StateT FB2State m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Element -> StateT FB2State m ()
forall (m :: * -> *). PandocMonad m => Element -> FB2 m ()
parseDescriptionChild (Element -> [Element]
elChildren Element
e)
Text
"body" -> if Element -> Bool
isNotesBody Element
e
then Blocks -> FB2 m Blocks
forall a. a -> StateT FB2State m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
forall a. Monoid a => a
mempty
else [Blocks] -> Blocks
forall a. Monoid a => [a] -> a
mconcat ([Blocks] -> Blocks) -> StateT FB2State m [Blocks] -> FB2 m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Element -> FB2 m Blocks)
-> [Element] -> StateT FB2State m [Blocks]
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 Element -> FB2 m Blocks
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseBodyChild (Element -> [Element]
elChildren Element
e)
Text
"binary" -> Blocks
forall a. Monoid a => a
mempty Blocks -> StateT FB2State m () -> FB2 m Blocks
forall a b. a -> StateT FB2State m b -> StateT FB2State m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Element -> StateT FB2State m ()
forall (m :: * -> *). PandocMonad m => Element -> FB2 m ()
parseBinaryElement Element
e
Text
name -> LogMessage -> StateT FB2State m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (Text -> Text -> LogMessage
UnexpectedXmlElement Text
name Text
"FictionBook") StateT FB2State m () -> Blocks -> FB2 m Blocks
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Blocks
forall a. Monoid a => a
mempty
parseDescriptionChild :: PandocMonad m => Element -> FB2 m ()
parseDescriptionChild :: forall (m :: * -> *). PandocMonad m => Element -> FB2 m ()
parseDescriptionChild Element
e =
case QName -> Text
qName (QName -> Text) -> QName -> Text
forall a b. (a -> b) -> a -> b
$ Element -> QName
elName Element
e of
Text
"title-info" -> (Element -> FB2 m ()) -> [Element] -> FB2 m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Element -> FB2 m ()
forall (m :: * -> *). PandocMonad m => Element -> FB2 m ()
parseTitleInfoChild (Element -> [Element]
elChildren Element
e)
Text
"src-title-info" -> () -> FB2 m ()
forall a. a -> StateT FB2State m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Text
"document-info" -> () -> FB2 m ()
forall a. a -> StateT FB2State m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Text
"publish-info" -> () -> FB2 m ()
forall a. a -> StateT FB2State m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Text
"custom-info" -> () -> FB2 m ()
forall a. a -> StateT FB2State m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Text
"output" -> () -> FB2 m ()
forall a. a -> StateT FB2State m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Text
name -> do
LogMessage -> FB2 m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> FB2 m ()) -> LogMessage -> FB2 m ()
forall a b. (a -> b) -> a -> b
$ Text -> LogMessage
IgnoredElement (Text -> LogMessage) -> Text -> LogMessage
forall a b. (a -> b) -> a -> b
$ Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" in description"
() -> FB2 m ()
forall a. a -> StateT FB2State m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
forall a. Monoid a => a
mempty
parseBodyChild :: PandocMonad m => Element -> FB2 m Blocks
parseBodyChild :: forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseBodyChild Element
e =
case QName -> Text
qName (QName -> Text) -> QName -> Text
forall a b. (a -> b) -> a -> b
$ Element -> QName
elName Element
e of
Text
"image" -> Element -> FB2 m Blocks
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseImageElement Element
e
Text
"title" -> Int -> Inlines -> Blocks
header (Int -> Inlines -> Blocks)
-> StateT FB2State m Int -> StateT FB2State m (Inlines -> Blocks)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FB2State -> Int) -> StateT FB2State m Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets FB2State -> Int
fb2SectionLevel StateT FB2State m (Inlines -> Blocks)
-> StateT FB2State m Inlines -> FB2 m Blocks
forall a b.
StateT FB2State m (a -> b)
-> StateT FB2State m a -> StateT FB2State m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Content] -> StateT FB2State m Inlines
forall (m :: * -> *). PandocMonad m => [Content] -> FB2 m Inlines
parseTitleType (Element -> [Content]
elContent Element
e)
Text
"epigraph" -> Element -> FB2 m Blocks
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseEpigraph Element
e
Text
"section" -> Element -> FB2 m Blocks
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseSection Element
e
Text
name -> LogMessage -> StateT FB2State m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (Text -> Text -> LogMessage
UnexpectedXmlElement Text
name Text
"body") StateT FB2State m () -> Blocks -> FB2 m Blocks
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Blocks
forall a. Monoid a => a
mempty
parseBinaryElement :: PandocMonad m => Element -> FB2 m ()
parseBinaryElement :: forall (m :: * -> *). PandocMonad m => Element -> FB2 m ()
parseBinaryElement Element
e =
case (QName -> Element -> Maybe Text
findAttr (Text -> QName
unqual Text
"id") Element
e, QName -> Element -> Maybe Text
findAttr (Text -> QName
unqual Text
"content-type") Element
e) of
(Maybe Text
Nothing, Maybe Text
_) -> LogMessage -> FB2 m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> FB2 m ()) -> LogMessage -> FB2 m ()
forall a b. (a -> b) -> a -> b
$ Text -> LogMessage
IgnoredElement Text
"binary without id attribute"
(Just Text
_, Maybe Text
Nothing) ->
LogMessage -> FB2 m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> FB2 m ()) -> LogMessage -> FB2 m ()
forall a b. (a -> b) -> a -> b
$ Text -> LogMessage
IgnoredElement Text
"binary without content-type attribute"
(Just Text
filename, Maybe Text
contentType) ->
String -> Maybe Text -> ByteString -> FB2 m ()
forall (m :: * -> *).
PandocMonad m =>
String -> Maybe Text -> ByteString -> m ()
insertMedia (Text -> String
T.unpack Text
filename) Maybe Text
contentType
(ByteString -> ByteString
decodeLenient
(Text -> ByteString
UTF8.fromTextLazy (Text -> ByteString) -> (Element -> Text) -> Element -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
TL.fromStrict (Text -> Text) -> (Element -> Text) -> Element -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> Text
strContent (Element -> ByteString) -> Element -> ByteString
forall a b. (a -> b) -> a -> b
$ Element
e))
parseAuthor :: PandocMonad m => Element -> FB2 m Text
parseAuthor :: forall (m :: * -> *). PandocMonad m => Element -> FB2 m Text
parseAuthor Element
e = [Text] -> Text
T.unwords ([Text] -> Text)
-> ([Maybe Text] -> [Text]) -> [Maybe Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe Text] -> [Text]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Text] -> Text)
-> StateT FB2State m [Maybe Text] -> StateT FB2State m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Element -> StateT FB2State m (Maybe Text))
-> [Element] -> StateT FB2State m [Maybe 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 Element -> StateT FB2State m (Maybe Text)
forall (m :: * -> *).
PandocMonad m =>
Element -> FB2 m (Maybe Text)
parseAuthorChild (Element -> [Element]
elChildren Element
e)
parseAuthorChild :: PandocMonad m => Element -> FB2 m (Maybe Text)
parseAuthorChild :: forall (m :: * -> *).
PandocMonad m =>
Element -> FB2 m (Maybe Text)
parseAuthorChild Element
e =
case QName -> Text
qName (QName -> Text) -> QName -> Text
forall a b. (a -> b) -> a -> b
$ Element -> QName
elName Element
e of
Text
"first-name" -> Maybe Text -> FB2 m (Maybe Text)
forall a. a -> StateT FB2State m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Text -> FB2 m (Maybe Text))
-> Maybe Text -> FB2 m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Element -> Text
strContent Element
e
Text
"middle-name" -> Maybe Text -> FB2 m (Maybe Text)
forall a. a -> StateT FB2State m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Text -> FB2 m (Maybe Text))
-> Maybe Text -> FB2 m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Element -> Text
strContent Element
e
Text
"last-name" -> Maybe Text -> FB2 m (Maybe Text)
forall a. a -> StateT FB2State m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Text -> FB2 m (Maybe Text))
-> Maybe Text -> FB2 m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Element -> Text
strContent Element
e
Text
"nickname" -> Maybe Text -> FB2 m (Maybe Text)
forall a. a -> StateT FB2State m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Text -> FB2 m (Maybe Text))
-> Maybe Text -> FB2 m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Element -> Text
strContent Element
e
Text
"home-page" -> Maybe Text -> FB2 m (Maybe Text)
forall a. a -> StateT FB2State m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Text -> FB2 m (Maybe Text))
-> Maybe Text -> FB2 m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Element -> Text
strContent Element
e
Text
"email" -> Maybe Text -> FB2 m (Maybe Text)
forall a. a -> StateT FB2State m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Text -> FB2 m (Maybe Text))
-> Maybe Text -> FB2 m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Element -> Text
strContent Element
e
Text
name -> do
LogMessage -> StateT FB2State m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> StateT FB2State m ())
-> LogMessage -> StateT FB2State m ()
forall a b. (a -> b) -> a -> b
$ Text -> LogMessage
IgnoredElement (Text -> LogMessage) -> Text -> LogMessage
forall a b. (a -> b) -> a -> b
$ Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" in author"
Maybe Text -> FB2 m (Maybe Text)
forall a. a -> StateT FB2State m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Text
forall a. Maybe a
Nothing
parseTitle :: PandocMonad m => Element -> FB2 m Blocks
parseTitle :: forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseTitle Element
e = Int -> Inlines -> Blocks
header (Int -> Inlines -> Blocks)
-> StateT FB2State m Int -> StateT FB2State m (Inlines -> Blocks)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FB2State -> Int) -> StateT FB2State m Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets FB2State -> Int
fb2SectionLevel StateT FB2State m (Inlines -> Blocks)
-> StateT FB2State m Inlines -> StateT FB2State m Blocks
forall a b.
StateT FB2State m (a -> b)
-> StateT FB2State m a -> StateT FB2State m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Content] -> StateT FB2State m Inlines
forall (m :: * -> *). PandocMonad m => [Content] -> FB2 m Inlines
parseTitleType (Element -> [Content]
elContent Element
e)
parseTitleType :: PandocMonad m => [Content] -> FB2 m Inlines
parseTitleType :: forall (m :: * -> *). PandocMonad m => [Content] -> FB2 m Inlines
parseTitleType [Content]
c = [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines)
-> ([Maybe Inlines] -> [Inlines]) -> [Maybe Inlines] -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> [Inlines] -> [Inlines]
forall a. a -> [a] -> [a]
intersperse Inlines
linebreak ([Inlines] -> [Inlines])
-> ([Maybe Inlines] -> [Inlines]) -> [Maybe Inlines] -> [Inlines]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe Inlines] -> [Inlines]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Inlines] -> Inlines)
-> StateT FB2State m [Maybe Inlines] -> StateT FB2State m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Content -> StateT FB2State m (Maybe Inlines))
-> [Content] -> StateT FB2State m [Maybe Inlines]
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 Content -> StateT FB2State m (Maybe Inlines)
forall (m :: * -> *).
PandocMonad m =>
Content -> FB2 m (Maybe Inlines)
parseTitleContent [Content]
c
parseTitleContent :: PandocMonad m => Content -> FB2 m (Maybe Inlines)
parseTitleContent :: forall (m :: * -> *).
PandocMonad m =>
Content -> FB2 m (Maybe Inlines)
parseTitleContent (Elem Element
e) =
case QName -> Text
qName (QName -> Text) -> QName -> Text
forall a b. (a -> b) -> a -> b
$ Element -> QName
elName Element
e of
Text
"p" -> Inlines -> Maybe Inlines
forall a. a -> Maybe a
Just (Inlines -> Maybe Inlines)
-> StateT FB2State m Inlines -> FB2 m (Maybe Inlines)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> StateT FB2State m Inlines
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Inlines
parsePType Element
e
Text
"empty-line" -> Maybe Inlines -> FB2 m (Maybe Inlines)
forall a. a -> StateT FB2State m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Inlines -> FB2 m (Maybe Inlines))
-> Maybe Inlines -> FB2 m (Maybe Inlines)
forall a b. (a -> b) -> a -> b
$ Inlines -> Maybe Inlines
forall a. a -> Maybe a
Just Inlines
forall a. Monoid a => a
mempty
Text
_ -> Maybe Inlines -> FB2 m (Maybe Inlines)
forall a. a -> StateT FB2State m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Inlines
forall a. Monoid a => a
mempty
parseTitleContent Content
_ = Maybe Inlines -> FB2 m (Maybe Inlines)
forall a. a -> StateT FB2State m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Inlines
forall a. Maybe a
Nothing
parseImageElement :: PandocMonad m => Element -> FB2 m Blocks
parseImageElement :: forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseImageElement Element
e =
case Maybe Text
href of
Just Text
src -> Blocks -> FB2 m Blocks
forall a. a -> StateT FB2State m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Blocks -> FB2 m Blocks) -> Blocks -> FB2 m Blocks
forall a b. (a -> b) -> a -> b
$ Inlines -> Blocks
para (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Text -> Inlines -> Inlines
imageWith (Text
imgId, [], []) (Text -> Text
removeHash Text
src) Text
title Inlines
alt
Maybe Text
Nothing -> do
LogMessage -> StateT FB2State m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> StateT FB2State m ())
-> LogMessage -> StateT FB2State m ()
forall a b. (a -> b) -> a -> b
$ Text -> LogMessage
IgnoredElement Text
" image without href"
Blocks -> FB2 m Blocks
forall a. a -> StateT FB2State m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
forall a. Monoid a => a
mempty
where alt :: Inlines
alt = Inlines -> (Text -> Inlines) -> Maybe Text -> Inlines
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Inlines
forall a. Monoid a => a
mempty Text -> Inlines
str (Maybe Text -> Inlines) -> Maybe Text -> Inlines
forall a b. (a -> b) -> a -> b
$ QName -> Element -> Maybe Text
findAttr (Text -> QName
unqual Text
"alt") Element
e
title :: Text
title = 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
$ QName -> Element -> Maybe Text
findAttr (Text -> QName
unqual Text
"title") Element
e
imgId :: Text
imgId = 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
$ QName -> Element -> Maybe Text
findAttr (Text -> QName
unqual Text
"id") Element
e
href :: Maybe Text
href = QName -> Element -> Maybe Text
findAttr (Text -> Maybe Text -> Maybe Text -> QName
QName Text
"href" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"http://www.w3.org/1999/xlink") Maybe Text
forall a. Maybe a
Nothing) Element
e
parsePType :: PandocMonad m => Element -> FB2 m Inlines
parsePType :: forall (m :: * -> *). PandocMonad m => Element -> FB2 m Inlines
parsePType = Element -> FB2 m Inlines
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Inlines
parseStyleType
parseCite :: PandocMonad m => Element -> FB2 m Blocks
parseCite :: forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseCite Element
e = Blocks -> Blocks
blockQuote (Blocks -> Blocks) -> ([Blocks] -> Blocks) -> [Blocks] -> Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Blocks] -> Blocks
forall a. Monoid a => [a] -> a
mconcat ([Blocks] -> Blocks)
-> StateT FB2State m [Blocks] -> StateT FB2State m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Element -> StateT FB2State m Blocks)
-> [Element] -> StateT FB2State m [Blocks]
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 Element -> StateT FB2State m Blocks
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseCiteChild (Element -> [Element]
elChildren Element
e)
parseCiteChild :: PandocMonad m => Element -> FB2 m Blocks
parseCiteChild :: forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseCiteChild Element
e =
case QName -> Text
qName (QName -> Text) -> QName -> Text
forall a b. (a -> b) -> a -> b
$ Element -> QName
elName Element
e of
Text
"p" -> Inlines -> Blocks
para (Inlines -> Blocks) -> StateT FB2State m Inlines -> FB2 m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> StateT FB2State m Inlines
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Inlines
parsePType Element
e
Text
"poem" -> Element -> FB2 m Blocks
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parsePoem Element
e
Text
"empty-line" -> Blocks -> FB2 m Blocks
forall a. a -> StateT FB2State m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
horizontalRule
Text
"subtitle" -> Element -> FB2 m Blocks
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseSubtitle Element
e
Text
"table" -> Element -> FB2 m Blocks
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseTable Element
e
Text
"text-author" -> Inlines -> Blocks
para (Inlines -> Blocks) -> StateT FB2State m Inlines -> FB2 m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> StateT FB2State m Inlines
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Inlines
parsePType Element
e
Text
name -> LogMessage -> StateT FB2State m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (Text -> Text -> LogMessage
UnexpectedXmlElement Text
name Text
"cite") StateT FB2State m () -> Blocks -> FB2 m Blocks
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Blocks
forall a. Monoid a => a
mempty
parsePoem :: PandocMonad m => Element -> FB2 m Blocks
parsePoem :: forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parsePoem Element
e = [Blocks] -> Blocks
forall a. Monoid a => [a] -> a
mconcat ([Blocks] -> Blocks)
-> StateT FB2State m [Blocks] -> StateT FB2State m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Element -> StateT FB2State m Blocks)
-> [Element] -> StateT FB2State m [Blocks]
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 Element -> StateT FB2State m Blocks
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parsePoemChild (Element -> [Element]
elChildren Element
e)
parsePoemChild :: PandocMonad m => Element -> FB2 m Blocks
parsePoemChild :: forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parsePoemChild Element
e =
case QName -> Text
qName (QName -> Text) -> QName -> Text
forall a b. (a -> b) -> a -> b
$ Element -> QName
elName Element
e of
Text
"title" -> Element -> FB2 m Blocks
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseTitle Element
e
Text
"subtitle" -> Element -> FB2 m Blocks
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseSubtitle Element
e
Text
"epigraph" -> Element -> FB2 m Blocks
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseEpigraph Element
e
Text
"stanza" -> Element -> FB2 m Blocks
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseStanza Element
e
Text
"text-author" -> Inlines -> Blocks
para (Inlines -> Blocks) -> StateT FB2State m Inlines -> FB2 m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> StateT FB2State m Inlines
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Inlines
parsePType Element
e
Text
"date" -> Blocks -> FB2 m Blocks
forall a. a -> StateT FB2State m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Blocks -> FB2 m Blocks) -> Blocks -> FB2 m Blocks
forall a b. (a -> b) -> a -> b
$ Inlines -> Blocks
para (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Text -> Inlines
text (Text -> Inlines) -> Text -> Inlines
forall a b. (a -> b) -> a -> b
$ Element -> Text
strContent Element
e
Text
name -> LogMessage -> StateT FB2State m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (Text -> Text -> LogMessage
UnexpectedXmlElement Text
name Text
"poem") StateT FB2State m () -> Blocks -> FB2 m Blocks
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Blocks
forall a. Monoid a => a
mempty
parseStanza :: PandocMonad m => Element -> FB2 m Blocks
parseStanza :: forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseStanza Element
e = [Block] -> Blocks
forall a. [a] -> Many a
fromList ([Block] -> Blocks) -> ([Blocks] -> [Block]) -> [Blocks] -> Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Block] -> [Block]
joinLineBlocks ([Block] -> [Block])
-> ([Blocks] -> [Block]) -> [Blocks] -> [Block]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Blocks -> [Block]
forall a. Many a -> [a]
toList (Blocks -> [Block]) -> ([Blocks] -> Blocks) -> [Blocks] -> [Block]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Blocks] -> Blocks
forall a. Monoid a => [a] -> a
mconcat ([Blocks] -> Blocks)
-> StateT FB2State m [Blocks] -> StateT FB2State m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Element -> StateT FB2State m Blocks)
-> [Element] -> StateT FB2State m [Blocks]
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 Element -> StateT FB2State m Blocks
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseStanzaChild (Element -> [Element]
elChildren Element
e)
joinLineBlocks :: [Block] -> [Block]
joinLineBlocks :: [Block] -> [Block]
joinLineBlocks (LineBlock [[Inline]]
xs:LineBlock [[Inline]]
ys:[Block]
zs) = [Block] -> [Block]
joinLineBlocks ([[Inline]] -> Block
LineBlock ([[Inline]]
xs [[Inline]] -> [[Inline]] -> [[Inline]]
forall a. [a] -> [a] -> [a]
++ [[Inline]]
ys) Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
zs)
joinLineBlocks (Block
x:[Block]
xs) = Block
xBlock -> [Block] -> [Block]
forall a. a -> [a] -> [a]
:[Block] -> [Block]
joinLineBlocks [Block]
xs
joinLineBlocks [] = []
parseStanzaChild :: PandocMonad m => Element -> FB2 m Blocks
parseStanzaChild :: forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseStanzaChild Element
e =
case QName -> Text
qName (QName -> Text) -> QName -> Text
forall a b. (a -> b) -> a -> b
$ Element -> QName
elName Element
e of
Text
"title" -> Element -> FB2 m Blocks
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseTitle Element
e
Text
"subtitle" -> Element -> FB2 m Blocks
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseSubtitle Element
e
Text
"v" -> [Inlines] -> Blocks
lineBlock ([Inlines] -> Blocks)
-> (Inlines -> [Inlines]) -> Inlines -> Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Inlines -> [Inlines] -> [Inlines]
forall a. a -> [a] -> [a]
:[]) (Inlines -> Blocks) -> StateT FB2State m Inlines -> FB2 m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> StateT FB2State m Inlines
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Inlines
parsePType Element
e
Text
name -> LogMessage -> StateT FB2State m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (Text -> Text -> LogMessage
UnexpectedXmlElement Text
name Text
"stanza") StateT FB2State m () -> Blocks -> FB2 m Blocks
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Blocks
forall a. Monoid a => a
mempty
parseEpigraph :: PandocMonad m => Element -> FB2 m Blocks
parseEpigraph :: forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseEpigraph Element
e =
Attr -> Blocks -> Blocks
divWith (Text
divId, [Text
"epigraph"], []) (Blocks -> Blocks) -> ([Blocks] -> Blocks) -> [Blocks] -> Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Blocks] -> Blocks
forall a. Monoid a => [a] -> a
mconcat ([Blocks] -> Blocks)
-> StateT FB2State m [Blocks] -> StateT FB2State m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Element -> StateT FB2State m Blocks)
-> [Element] -> StateT FB2State m [Blocks]
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 Element -> StateT FB2State m Blocks
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseEpigraphChild (Element -> [Element]
elChildren Element
e)
where divId :: Text
divId = 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
$ QName -> Element -> Maybe Text
findAttr (Text -> QName
unqual Text
"id") Element
e
parseEpigraphChild :: PandocMonad m => Element -> FB2 m Blocks
parseEpigraphChild :: forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseEpigraphChild Element
e =
case QName -> Text
qName (QName -> Text) -> QName -> Text
forall a b. (a -> b) -> a -> b
$ Element -> QName
elName Element
e of
Text
"p" -> Inlines -> Blocks
para (Inlines -> Blocks) -> StateT FB2State m Inlines -> FB2 m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> StateT FB2State m Inlines
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Inlines
parsePType Element
e
Text
"poem" -> Element -> FB2 m Blocks
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parsePoem Element
e
Text
"cite" -> Element -> FB2 m Blocks
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseCite Element
e
Text
"empty-line" -> Blocks -> FB2 m Blocks
forall a. a -> StateT FB2State m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
horizontalRule
Text
"text-author" -> Inlines -> Blocks
para (Inlines -> Blocks) -> StateT FB2State m Inlines -> FB2 m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> StateT FB2State m Inlines
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Inlines
parsePType Element
e
Text
name -> LogMessage -> StateT FB2State m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (Text -> Text -> LogMessage
UnexpectedXmlElement Text
name Text
"epigraph") StateT FB2State m () -> Blocks -> FB2 m Blocks
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Blocks
forall a. Monoid a => a
mempty
parseAnnotation :: PandocMonad m => Element -> FB2 m Blocks
parseAnnotation :: forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseAnnotation Element
e = [Blocks] -> Blocks
forall a. Monoid a => [a] -> a
mconcat ([Blocks] -> Blocks)
-> StateT FB2State m [Blocks] -> StateT FB2State m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Element -> StateT FB2State m Blocks)
-> [Element] -> StateT FB2State m [Blocks]
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 Element -> StateT FB2State m Blocks
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseAnnotationChild (Element -> [Element]
elChildren Element
e)
parseAnnotationChild :: PandocMonad m => Element -> FB2 m Blocks
parseAnnotationChild :: forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseAnnotationChild Element
e =
case QName -> Text
qName (QName -> Text) -> QName -> Text
forall a b. (a -> b) -> a -> b
$ Element -> QName
elName Element
e of
Text
"p" -> Inlines -> Blocks
para (Inlines -> Blocks) -> StateT FB2State m Inlines -> FB2 m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> StateT FB2State m Inlines
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Inlines
parsePType Element
e
Text
"poem" -> Element -> FB2 m Blocks
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parsePoem Element
e
Text
"cite" -> Element -> FB2 m Blocks
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseCite Element
e
Text
"subtitle" -> Element -> FB2 m Blocks
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseSubtitle Element
e
Text
"table" -> Element -> FB2 m Blocks
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseTable Element
e
Text
"empty-line" -> Blocks -> FB2 m Blocks
forall a. a -> StateT FB2State m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
horizontalRule
Text
name -> LogMessage -> StateT FB2State m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (Text -> Text -> LogMessage
UnexpectedXmlElement Text
name Text
"annotation") StateT FB2State m () -> Blocks -> FB2 m Blocks
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Blocks
forall a. Monoid a => a
mempty
parseSection :: PandocMonad m => Element -> FB2 m Blocks
parseSection :: forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseSection Element
e = do
Int
n <- (FB2State -> Int) -> StateT FB2State m Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets FB2State -> Int
fb2SectionLevel
(FB2State -> FB2State) -> StateT FB2State m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((FB2State -> FB2State) -> StateT FB2State m ())
-> (FB2State -> FB2State) -> StateT FB2State m ()
forall a b. (a -> b) -> a -> b
$ \FB2State
st -> FB2State
st{ fb2SectionLevel = n + 1 }
let sectionId :: Text
sectionId = 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
$ QName -> Element -> Maybe Text
findAttr (Text -> QName
unqual Text
"id") Element
e
Blocks
bs <- Attr -> Blocks -> Blocks
divWith (Text
sectionId, [Text
"section"], []) (Blocks -> Blocks) -> ([Blocks] -> Blocks) -> [Blocks] -> Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Blocks] -> Blocks
forall a. Monoid a => [a] -> a
mconcat ([Blocks] -> Blocks) -> StateT FB2State m [Blocks] -> FB2 m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Element -> FB2 m Blocks)
-> [Element] -> StateT FB2State m [Blocks]
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 Element -> FB2 m Blocks
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseSectionChild (Element -> [Element]
elChildren Element
e)
(FB2State -> FB2State) -> StateT FB2State m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((FB2State -> FB2State) -> StateT FB2State m ())
-> (FB2State -> FB2State) -> StateT FB2State m ()
forall a b. (a -> b) -> a -> b
$ \FB2State
st -> FB2State
st{ fb2SectionLevel = n }
Blocks -> FB2 m Blocks
forall a. a -> StateT FB2State m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
bs
parseSectionChild :: PandocMonad m => Element -> FB2 m Blocks
parseSectionChild :: forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseSectionChild Element
e =
case QName -> Text
qName (QName -> Text) -> QName -> Text
forall a b. (a -> b) -> a -> b
$ Element -> QName
elName Element
e of
Text
"title" -> Element -> FB2 m Blocks
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseBodyChild Element
e
Text
"epigraph" -> Element -> FB2 m Blocks
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseEpigraph Element
e
Text
"image" -> Element -> FB2 m Blocks
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseImageElement Element
e
Text
"annotation" -> Element -> FB2 m Blocks
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseAnnotation Element
e
Text
"poem" -> Element -> FB2 m Blocks
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parsePoem Element
e
Text
"cite" -> Element -> FB2 m Blocks
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseCite Element
e
Text
"empty-line" -> Blocks -> FB2 m Blocks
forall a. a -> StateT FB2State m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
horizontalRule
Text
"table" -> Element -> FB2 m Blocks
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseTable Element
e
Text
"subtitle" -> Element -> FB2 m Blocks
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseSubtitle Element
e
Text
"p" -> Inlines -> Blocks
para (Inlines -> Blocks) -> StateT FB2State m Inlines -> FB2 m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> StateT FB2State m Inlines
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Inlines
parsePType Element
e
Text
"section" -> Element -> FB2 m Blocks
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseSection Element
e
Text
name -> LogMessage -> StateT FB2State m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (Text -> Text -> LogMessage
UnexpectedXmlElement Text
name Text
"section") StateT FB2State m () -> Blocks -> FB2 m Blocks
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Blocks
forall a. Monoid a => a
mempty
parseStyleType :: PandocMonad m => Element -> FB2 m Inlines
parseStyleType :: forall (m :: * -> *). PandocMonad m => Element -> FB2 m Inlines
parseStyleType Element
e = [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines)
-> StateT FB2State m [Inlines] -> StateT FB2State m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Content -> StateT FB2State m Inlines)
-> [Content] -> StateT FB2State m [Inlines]
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 Content -> StateT FB2State m Inlines
forall (m :: * -> *). PandocMonad m => Content -> FB2 m Inlines
parseInline (Element -> [Content]
elContent Element
e)
parseNamedStyle :: PandocMonad m => Element -> FB2 m Inlines
parseNamedStyle :: forall (m :: * -> *). PandocMonad m => Element -> FB2 m Inlines
parseNamedStyle Element
e = do
Inlines
content <- [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines)
-> StateT FB2State m [Inlines] -> FB2 m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Content -> FB2 m Inlines)
-> [Content] -> StateT FB2State m [Inlines]
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 Content -> FB2 m Inlines
forall (m :: * -> *). PandocMonad m => Content -> FB2 m Inlines
parseNamedStyleChild (Element -> [Content]
elContent Element
e)
let lang :: [(Text, Text)]
lang = Maybe (Text, Text) -> [(Text, Text)]
forall a. Maybe a -> [a]
maybeToList (Maybe (Text, Text) -> [(Text, Text)])
-> Maybe (Text, Text) -> [(Text, Text)]
forall a b. (a -> b) -> a -> b
$ (Text
"lang",) (Text -> (Text, Text)) -> Maybe Text -> Maybe (Text, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QName -> Element -> Maybe Text
findAttr (Text -> Maybe Text -> Maybe Text -> QName
QName Text
"lang" Maybe Text
forall a. Maybe a
Nothing (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"xml")) Element
e
case QName -> Element -> Maybe Text
findAttr (Text -> QName
unqual Text
"name") Element
e of
Just Text
name -> Inlines -> FB2 m Inlines
forall a. a -> StateT FB2State m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inlines -> FB2 m Inlines) -> Inlines -> FB2 m Inlines
forall a b. (a -> b) -> a -> b
$ Attr -> Inlines -> Inlines
spanWith (Text
"", [Text
name], [(Text, Text)]
lang) Inlines
content
Maybe Text
Nothing -> do
LogMessage -> StateT FB2State m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> StateT FB2State m ())
-> LogMessage -> StateT FB2State m ()
forall a b. (a -> b) -> a -> b
$ Text -> LogMessage
IgnoredElement Text
"link without required name"
Inlines -> FB2 m Inlines
forall a. a -> StateT FB2State m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Inlines
forall a. Monoid a => a
mempty
parseNamedStyleChild :: PandocMonad m => Content -> FB2 m Inlines
parseNamedStyleChild :: forall (m :: * -> *). PandocMonad m => Content -> FB2 m Inlines
parseNamedStyleChild (Elem Element
e) =
case QName -> Text
qName (Element -> QName
elName Element
e) of
Text
"strong" -> Inlines -> Inlines
strong (Inlines -> Inlines) -> FB2 m Inlines -> FB2 m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> FB2 m Inlines
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Inlines
parseStyleType Element
e
Text
"emphasis" -> Inlines -> Inlines
emph (Inlines -> Inlines) -> FB2 m Inlines -> FB2 m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> FB2 m Inlines
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Inlines
parseStyleType Element
e
Text
"style" -> Element -> FB2 m Inlines
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Inlines
parseNamedStyle Element
e
Text
"a" -> Element -> FB2 m Inlines
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Inlines
parseLinkType Element
e
Text
"strikethrough" -> Inlines -> Inlines
strikeout (Inlines -> Inlines) -> FB2 m Inlines -> FB2 m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> FB2 m Inlines
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Inlines
parseStyleType Element
e
Text
"sub" -> Inlines -> Inlines
subscript (Inlines -> Inlines) -> FB2 m Inlines -> FB2 m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> FB2 m Inlines
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Inlines
parseStyleType Element
e
Text
"sup" -> Inlines -> Inlines
superscript (Inlines -> Inlines) -> FB2 m Inlines -> FB2 m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> FB2 m Inlines
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Inlines
parseStyleType Element
e
Text
"code" -> Inlines -> FB2 m Inlines
forall a. a -> StateT FB2State m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inlines -> FB2 m Inlines) -> Inlines -> FB2 m Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Inlines
code (Text -> Inlines) -> Text -> Inlines
forall a b. (a -> b) -> a -> b
$ Element -> Text
strContent Element
e
Text
"image" -> Element -> FB2 m Inlines
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Inlines
parseInlineImageElement Element
e
Text
name -> do
LogMessage -> StateT FB2State m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> StateT FB2State m ())
-> LogMessage -> StateT FB2State m ()
forall a b. (a -> b) -> a -> b
$ Text -> LogMessage
IgnoredElement (Text -> LogMessage) -> Text -> LogMessage
forall a b. (a -> b) -> a -> b
$ Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" in style"
Inlines -> FB2 m Inlines
forall a. a -> StateT FB2State m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Inlines
forall a. Monoid a => a
mempty
parseNamedStyleChild Content
x = Content -> FB2 m Inlines
forall (m :: * -> *). PandocMonad m => Content -> FB2 m Inlines
parseInline Content
x
parseLinkType :: PandocMonad m => Element -> FB2 m Inlines
parseLinkType :: forall (m :: * -> *). PandocMonad m => Element -> FB2 m Inlines
parseLinkType Element
e = do
Inlines
content <- [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines)
-> StateT FB2State m [Inlines] -> FB2 m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Content -> FB2 m Inlines)
-> [Content] -> StateT FB2State m [Inlines]
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 Content -> FB2 m Inlines
forall (m :: * -> *). PandocMonad m => Content -> FB2 m Inlines
parseStyleLinkType (Element -> [Content]
elContent Element
e)
Map Text Blocks
notes <- (FB2State -> Map Text Blocks)
-> StateT FB2State m (Map Text Blocks)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets FB2State -> Map Text Blocks
fb2Notes
case QName -> Element -> Maybe Text
findAttr (Text -> Maybe Text -> Maybe Text -> QName
QName Text
"href" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"http://www.w3.org/1999/xlink") Maybe Text
forall a. Maybe a
Nothing) Element
e of
Just Text
href -> case QName -> Element -> Maybe Text
findAttr (Text -> Maybe Text -> Maybe Text -> QName
QName Text
"type" Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing) Element
e of
Just Text
"note" -> case Text -> Map Text Blocks -> Maybe Blocks
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
href Map Text Blocks
notes of
Maybe Blocks
Nothing -> Inlines -> FB2 m Inlines
forall a. a -> StateT FB2State m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inlines -> FB2 m Inlines) -> Inlines -> FB2 m Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Inlines -> Inlines
link Text
href Text
"" Inlines
content
Just Blocks
contents -> Inlines -> FB2 m Inlines
forall a. a -> StateT FB2State m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inlines -> FB2 m Inlines) -> Inlines -> FB2 m Inlines
forall a b. (a -> b) -> a -> b
$ Blocks -> Inlines
note Blocks
contents
Maybe Text
_ -> Inlines -> FB2 m Inlines
forall a. a -> StateT FB2State m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inlines -> FB2 m Inlines) -> Inlines -> FB2 m Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Inlines -> Inlines
link Text
href Text
"" Inlines
content
Maybe Text
Nothing -> do
LogMessage -> StateT FB2State m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> StateT FB2State m ())
-> LogMessage -> StateT FB2State m ()
forall a b. (a -> b) -> a -> b
$ Text -> LogMessage
IgnoredElement Text
"link without required href"
Inlines -> FB2 m Inlines
forall a. a -> StateT FB2State m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Inlines
forall a. Monoid a => a
mempty
parseStyleLinkType :: PandocMonad m => Content -> FB2 m Inlines
parseStyleLinkType :: forall (m :: * -> *). PandocMonad m => Content -> FB2 m Inlines
parseStyleLinkType x :: Content
x@(Elem Element
e) =
case QName -> Text
qName (Element -> QName
elName Element
e) of
Text
"a" -> do
LogMessage -> StateT FB2State m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> StateT FB2State m ())
-> LogMessage -> StateT FB2State m ()
forall a b. (a -> b) -> a -> b
$ Text -> LogMessage
IgnoredElement Text
"nested link"
Inlines -> FB2 m Inlines
forall a. a -> StateT FB2State m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Inlines
forall a. Monoid a => a
mempty
Text
_ -> Content -> FB2 m Inlines
forall (m :: * -> *). PandocMonad m => Content -> FB2 m Inlines
parseInline Content
x
parseStyleLinkType Content
x = Content -> FB2 m Inlines
forall (m :: * -> *). PandocMonad m => Content -> FB2 m Inlines
parseInline Content
x
parseTable :: PandocMonad m => Element -> FB2 m Blocks
parseTable :: forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseTable Element
_ = Blocks -> StateT FB2State m Blocks
forall a. a -> StateT FB2State m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
forall a. Monoid a => a
mempty
parseTitleInfoChild :: PandocMonad m => Element -> FB2 m ()
parseTitleInfoChild :: forall (m :: * -> *). PandocMonad m => Element -> FB2 m ()
parseTitleInfoChild Element
e =
case QName -> Text
qName (Element -> QName
elName Element
e) of
Text
"genre" -> () -> FB2 m ()
forall a. a -> StateT FB2State m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Text
"author" -> Element -> FB2 m Text
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Text
parseAuthor Element
e FB2 m Text -> (Text -> FB2 m ()) -> FB2 m ()
forall a b.
StateT FB2State m a
-> (a -> StateT FB2State m b) -> StateT FB2State m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Text
author -> (FB2State -> FB2State) -> FB2 m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\FB2State
st -> FB2State
st {fb2Authors = author:fb2Authors st})
Text
"book-title" -> (FB2State -> FB2State) -> FB2 m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (Text -> Inlines -> FB2State -> FB2State
forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
forall b. ToMetaValue b => Text -> b -> FB2State -> FB2State
setMeta Text
"title" (Text -> Inlines
text (Text -> Inlines) -> Text -> Inlines
forall a b. (a -> b) -> a -> b
$ Element -> Text
strContent Element
e))
Text
"annotation" -> Element -> FB2 m Blocks
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseAnnotation Element
e FB2 m Blocks -> (Blocks -> FB2 m ()) -> FB2 m ()
forall a b.
StateT FB2State m a
-> (a -> StateT FB2State m b) -> StateT FB2State m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (FB2State -> FB2State) -> FB2 m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((FB2State -> FB2State) -> FB2 m ())
-> (Blocks -> FB2State -> FB2State) -> Blocks -> FB2 m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Blocks -> FB2State -> FB2State
forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
forall b. ToMetaValue b => Text -> b -> FB2State -> FB2State
setMeta Text
"abstract"
Text
"keywords" -> (FB2State -> FB2State) -> FB2 m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (Text -> [MetaValue] -> FB2State -> FB2State
forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
forall b. ToMetaValue b => Text -> b -> FB2State -> FB2State
setMeta Text
"keywords" ((Text -> MetaValue) -> [Text] -> [MetaValue]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> MetaValue
MetaString (Text -> MetaValue) -> (Text -> Text) -> Text -> MetaValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
trim) ([Text] -> [MetaValue]) -> [Text] -> [MetaValue]
forall a b. (a -> b) -> a -> b
$ HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
","
(Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Element -> Text
strContent Element
e))
Text
"date" -> (FB2State -> FB2State) -> FB2 m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (Text -> Inlines -> FB2State -> FB2State
forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
forall b. ToMetaValue b => Text -> b -> FB2State -> FB2State
setMeta Text
"date" (Text -> Inlines
text (Text -> Inlines) -> Text -> Inlines
forall a b. (a -> b) -> a -> b
$ Element -> Text
strContent Element
e))
Text
"coverpage" -> Element -> FB2 m ()
forall (m :: * -> *). PandocMonad m => Element -> FB2 m ()
parseCoverPage Element
e
Text
"lang" -> () -> FB2 m ()
forall a. a -> StateT FB2State m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Text
"src-lang" -> () -> FB2 m ()
forall a. a -> StateT FB2State m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Text
"translator" -> () -> FB2 m ()
forall a. a -> StateT FB2State m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Text
"sequence" -> () -> FB2 m ()
forall a. a -> StateT FB2State m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Text
name -> LogMessage -> FB2 m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> FB2 m ()) -> LogMessage -> FB2 m ()
forall a b. (a -> b) -> a -> b
$ Text -> LogMessage
IgnoredElement (Text -> LogMessage) -> Text -> LogMessage
forall a b. (a -> b) -> a -> b
$ Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" in title-info"
parseCoverPage :: PandocMonad m => Element -> FB2 m ()
parseCoverPage :: forall (m :: * -> *). PandocMonad m => Element -> FB2 m ()
parseCoverPage Element
e =
case QName -> Element -> Maybe Element
findChild (Text -> Maybe Text -> Maybe Text -> QName
QName Text
"image" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"http://www.gribuser.ru/xml/fictionbook/2.0") Maybe Text
forall a. Maybe a
Nothing) Element
e of
Just Element
img -> case Maybe Text
href of
Just Text
src -> (FB2State -> FB2State) -> FB2 m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (Text -> MetaValue -> FB2State -> FB2State
forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
forall b. ToMetaValue b => Text -> b -> FB2State -> FB2State
setMeta Text
"cover-image" (Text -> MetaValue
MetaString (Text -> MetaValue) -> Text -> MetaValue
forall a b. (a -> b) -> a -> b
$ Text -> Text
removeHash Text
src))
Maybe Text
Nothing -> () -> FB2 m ()
forall a. a -> StateT FB2State m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
where href :: Maybe Text
href = QName -> Element -> Maybe Text
findAttr (Text -> Maybe Text -> Maybe Text -> QName
QName Text
"href" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"http://www.w3.org/1999/xlink") Maybe Text
forall a. Maybe a
Nothing) Element
img
Maybe Element
Nothing -> () -> FB2 m ()
forall a. a -> StateT FB2State m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
parseInlineImageElement :: PandocMonad m
=> Element
-> FB2 m Inlines
parseInlineImageElement :: forall (m :: * -> *). PandocMonad m => Element -> FB2 m Inlines
parseInlineImageElement Element
e =
case Maybe Text
href of
Just Text
src -> Inlines -> FB2 m Inlines
forall a. a -> StateT FB2State m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inlines -> FB2 m Inlines) -> Inlines -> FB2 m Inlines
forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Text -> Inlines -> Inlines
imageWith (Text
"", [], []) (Text -> Text
removeHash Text
src) Text
"" Inlines
alt
Maybe Text
Nothing -> do
LogMessage -> StateT FB2State m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> StateT FB2State m ())
-> LogMessage -> StateT FB2State m ()
forall a b. (a -> b) -> a -> b
$ Text -> LogMessage
IgnoredElement Text
"inline image without href"
Inlines -> FB2 m Inlines
forall a. a -> StateT FB2State m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Inlines
forall a. Monoid a => a
mempty
where alt :: Inlines
alt = Inlines -> (Text -> Inlines) -> Maybe Text -> Inlines
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Inlines
forall a. Monoid a => a
mempty Text -> Inlines
str (Maybe Text -> Inlines) -> Maybe Text -> Inlines
forall a b. (a -> b) -> a -> b
$ QName -> Element -> Maybe Text
findAttr (Text -> QName
unqual Text
"alt") Element
e
href :: Maybe Text
href = QName -> Element -> Maybe Text
findAttr (Text -> Maybe Text -> Maybe Text -> QName
QName Text
"href" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"http://www.w3.org/1999/xlink") Maybe Text
forall a. Maybe a
Nothing) Element
e