{-# 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.Lazy.Char8 ( pack )
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 Data.Default
import Data.Maybe
import Text.HTML.TagSoup.Entity (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.Shared (crFilter)
import Text.XML.Light
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
showList :: [FB2State] -> ShowS
$cshowList :: [FB2State] -> ShowS
show :: FB2State -> String
$cshow :: FB2State -> String
showsPrec :: Int -> FB2State -> ShowS
$cshowsPrec :: Int -> FB2State -> ShowS
Show
instance Default FB2State where
def :: FB2State
def = FB2State :: Int -> Meta -> [Text] -> Map Text Blocks -> FB2State
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 :: Text -> b -> FB2State -> FB2State
setMeta Text
field b
v FB2State
s = FB2State
s {fb2Meta :: Meta
fb2Meta = Text -> b -> Meta -> Meta
forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
setMeta Text
field b
v (FB2State -> Meta
fb2Meta FB2State
s)}
deleteMeta :: Text -> FB2State -> FB2State
deleteMeta Text
field FB2State
s = FB2State
s {fb2Meta :: Meta
fb2Meta = Text -> Meta -> Meta
forall a. HasMeta a => Text -> a -> a
deleteMeta Text
field (FB2State -> Meta
fb2Meta FB2State
s)}
readFB2 :: PandocMonad m => ReaderOptions -> Text -> m Pandoc
readFB2 :: ReaderOptions -> Text -> m Pandoc
readFB2 ReaderOptions
_ Text
inp =
case Text -> Maybe Element
forall s. XmlSource s => s -> Maybe Element
parseXMLDoc (Text -> Maybe Element) -> Text -> Maybe Element
forall a b. (a -> b) -> a -> b
$ Text -> Text
crFilter Text
inp of
Maybe Element
Nothing -> PandocError -> m Pandoc
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 -> PandocError
PandocParseError Text
"Not an XML document"
Just Element
e -> 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
e) FB2State
forall a. Default a => a
def
let authors :: Meta -> Meta
authors = if [Text] -> 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
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 (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 :: String -> Text
convertEntity :: String -> Text
convertEntity String
e = Text -> (String -> Text) -> Maybe String -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> Text
T.toUpper (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
e) String -> Text
T.pack (Maybe String -> Text) -> Maybe String -> Text
forall a b. (a -> b) -> a -> b
$ String -> Maybe String
lookupEntity String
e
parseInline :: PandocMonad m => Content -> FB2 m Inlines
parseInline :: Content -> FB2 m Inlines
parseInline (Elem Element
e) =
case String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ QName -> String
qName (QName -> String) -> QName -> String
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 (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
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Element -> String
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 (f :: * -> *) a. Applicative f => a -> f a
pure Inlines
forall a. Monoid a => a
mempty
parseInline (Text CData
x) = Inlines -> FB2 m Inlines
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
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ CData -> String
cdData CData
x
parseInline (CRef String
r) = Inlines -> FB2 m Inlines
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
$ String -> Text
convertEntity String
r
parseSubtitle :: PandocMonad m => Element -> FB2 m Blocks
parseSubtitle :: 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 -> FB2 m Blocks
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 :: Element -> FB2 m Blocks
parseRootElement Element
e =
case String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ QName -> String
qName (QName -> String) -> QName -> String
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 (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)
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 :: Element -> FB2 m ()
parseNotesBody Element
e = ()
forall a. Monoid a => a
mempty () -> StateT FB2State m [()] -> FB2 m ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Element -> FB2 m ()) -> [Element] -> StateT FB2State m [()]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Element -> FB2 m ()
forall (m :: * -> *). PandocMonad m => Element -> FB2 m ()
parseNotesBodyChild (Element -> [Element]
elChildren Element
e)
parseNotesBodyChild :: PandocMonad m => Element -> FB2 m ()
parseNotesBodyChild :: Element -> FB2 m ()
parseNotesBodyChild Element
e =
case QName -> String
qName (QName -> String) -> QName -> String
forall a b. (a -> b) -> a -> b
$ Element -> QName
elName Element
e of
String
"section" -> Element -> FB2 m ()
forall (m :: * -> *). PandocMonad m => Element -> FB2 m ()
parseNote Element
e
String
_ -> () -> FB2 m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
isNotesBody :: Element -> Bool
isNotesBody :: Element -> Bool
isNotesBody Element
e =
QName -> String
qName (Element -> QName
elName Element
e) String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"body" Bool -> Bool -> Bool
&&
QName -> Element -> Maybe String
findAttr (String -> QName
unqual String
"name") Element
e Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Maybe String
forall a. a -> Maybe a
Just String
"notes"
parseNote :: PandocMonad m => Element -> FB2 m ()
parseNote :: Element -> FB2 m ()
parseNote Element
e =
case QName -> Element -> Maybe String
findAttr (String -> QName
unqual String
"id") Element
e of
Maybe String
Nothing -> () -> FB2 m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Just String
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)
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 :: Map Text Blocks
fb2Notes = Text -> Blocks -> Map Text Blocks -> Map Text Blocks
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (Text
"#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
sectionId) Blocks
content Map Text Blocks
oldNotes }
() -> FB2 m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
where
isTitle :: Element -> Bool
isTitle Element
x = QName -> String
qName (Element -> QName
elName Element
x) String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"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 :: Element -> FB2 m Blocks
parseFictionBookChild Element
e =
case String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ QName -> String
qName (QName -> String) -> QName -> String
forall a b. (a -> b) -> a -> b
$ Element -> QName
elName Element
e of
Text
"stylesheet" -> Blocks -> FB2 m Blocks
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 (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 (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)
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 (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 :: Element -> FB2 m ()
parseDescriptionChild Element
e =
case String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ QName -> String
qName (QName -> String) -> QName -> String
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 (f :: * -> *) a. Applicative f => a -> f a
pure ()
Text
"document-info" -> () -> FB2 m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Text
"publish-info" -> () -> FB2 m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Text
"custom-info" -> () -> FB2 m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Text
"output" -> () -> FB2 m ()
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 (f :: * -> *) a. Applicative f => a -> f a
pure ()
forall a. Monoid a => a
mempty
parseBodyChild :: PandocMonad m => Element -> FB2 m Blocks
parseBodyChild :: Element -> FB2 m Blocks
parseBodyChild Element
e =
case String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ QName -> String
qName (QName -> String) -> QName -> String
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 (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 :: Element -> FB2 m ()
parseBinaryElement Element
e =
case (QName -> Element -> Maybe String
findAttr (String -> QName
unqual String
"id") Element
e, QName -> Element -> Maybe String
findAttr (String -> QName
unqual String
"content-type") Element
e) of
(Maybe String
Nothing, Maybe String
_) -> 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 String
_, Maybe String
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 String
filename, Maybe String
contentType) -> String -> Maybe Text -> ByteString -> FB2 m ()
forall (m :: * -> *).
PandocMonad m =>
String -> Maybe Text -> ByteString -> m ()
insertMedia String
filename (String -> Text
T.pack (String -> Text) -> Maybe String -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String
contentType) (ByteString -> ByteString
decodeLenient (String -> ByteString
pack (Element -> String
strContent Element
e)))
parseAuthor :: PandocMonad m => Element -> FB2 m Text
parseAuthor :: 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] -> FB2 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)
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 :: Element -> FB2 m (Maybe Text)
parseAuthorChild Element
e =
case String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ QName -> String
qName (QName -> String) -> QName -> String
forall a b. (a -> b) -> a -> b
$ Element -> QName
elName Element
e of
Text
"first-name" -> Maybe Text -> FB2 m (Maybe Text)
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
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Element -> String
strContent Element
e
Text
"middle-name" -> Maybe Text -> FB2 m (Maybe Text)
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
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Element -> String
strContent Element
e
Text
"last-name" -> Maybe Text -> FB2 m (Maybe Text)
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
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Element -> String
strContent Element
e
Text
"nickname" -> Maybe Text -> FB2 m (Maybe Text)
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
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Element -> String
strContent Element
e
Text
"home-page" -> Maybe Text -> FB2 m (Maybe Text)
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
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Element -> String
strContent Element
e
Text
"email" -> Maybe Text -> FB2 m (Maybe Text)
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
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Element -> String
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 (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Text
forall a. Maybe a
Nothing
parseTitle :: PandocMonad m => Element -> FB2 m Blocks
parseTitle :: 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 -> FB2 m Blocks
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 :: [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] -> FB2 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)
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 :: Content -> FB2 m (Maybe Inlines)
parseTitleContent (Elem Element
e) =
case QName -> String
qName (QName -> String) -> QName -> String
forall a b. (a -> b) -> a -> b
$ Element -> QName
elName Element
e of
String
"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
String
"empty-line" -> Maybe Inlines -> FB2 m (Maybe Inlines)
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
String
_ -> Maybe Inlines -> FB2 m (Maybe Inlines)
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 (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Inlines
forall a. Maybe a
Nothing
parseImageElement :: PandocMonad m => Element -> FB2 m Blocks
parseImageElement :: Element -> FB2 m Blocks
parseImageElement Element
e =
case Maybe String
href of
Just String
src -> Blocks -> FB2 m Blocks
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 -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
src) Text
title Inlines
alt
Maybe String
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 (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
forall a. Monoid a => a
mempty
where alt :: Inlines
alt = Inlines -> (String -> Inlines) -> Maybe String -> Inlines
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Inlines
forall a. Monoid a => a
mempty (Text -> Inlines
str (Text -> Inlines) -> (String -> Text) -> String -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack) (Maybe String -> Inlines) -> Maybe String -> Inlines
forall a b. (a -> b) -> a -> b
$ QName -> Element -> Maybe String
findAttr (String -> QName
unqual String
"alt") Element
e
title :: Text
title = Text -> (String -> Text) -> Maybe String -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" String -> Text
T.pack (Maybe String -> Text) -> Maybe String -> Text
forall a b. (a -> b) -> a -> b
$ QName -> Element -> Maybe String
findAttr (String -> QName
unqual String
"title") Element
e
imgId :: Text
imgId = Text -> (String -> Text) -> Maybe String -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" String -> Text
T.pack (Maybe String -> Text) -> Maybe String -> Text
forall a b. (a -> b) -> a -> b
$ QName -> Element -> Maybe String
findAttr (String -> QName
unqual String
"id") Element
e
href :: Maybe String
href = QName -> Element -> Maybe String
findAttr (String -> Maybe String -> Maybe String -> QName
QName String
"href" (String -> Maybe String
forall a. a -> Maybe a
Just String
"http://www.w3.org/1999/xlink") Maybe String
forall a. Maybe a
Nothing) Element
e
parsePType :: PandocMonad m => Element -> FB2 m Inlines
parsePType :: 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 :: 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] -> 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)
mapM Element -> FB2 m Blocks
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseCiteChild (Element -> [Element]
elChildren Element
e)
parseCiteChild :: PandocMonad m => Element -> FB2 m Blocks
parseCiteChild :: Element -> FB2 m Blocks
parseCiteChild Element
e =
case String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ QName -> String
qName (QName -> String) -> QName -> String
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 (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 :: Element -> FB2 m Blocks
parsePoem Element
e = [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)
mapM Element -> FB2 m Blocks
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parsePoemChild (Element -> [Element]
elChildren Element
e)
parsePoemChild :: PandocMonad m => Element -> FB2 m Blocks
parsePoemChild :: Element -> FB2 m Blocks
parsePoemChild Element
e =
case String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ QName -> String
qName (QName -> String) -> QName -> String
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 (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
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Element -> String
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 :: 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] -> 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)
mapM Element -> FB2 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 :: Element -> FB2 m Blocks
parseStanzaChild Element
e =
case String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ QName -> String
qName (QName -> String) -> QName -> String
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 :: 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] -> 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)
mapM Element -> FB2 m Blocks
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseEpigraphChild (Element -> [Element]
elChildren Element
e)
where divId :: Text
divId = Text -> (String -> Text) -> Maybe String -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" String -> Text
T.pack (Maybe String -> Text) -> Maybe String -> Text
forall a b. (a -> b) -> a -> b
$ QName -> Element -> Maybe String
findAttr (String -> QName
unqual String
"id") Element
e
parseEpigraphChild :: PandocMonad m => Element -> FB2 m Blocks
parseEpigraphChild :: Element -> FB2 m Blocks
parseEpigraphChild Element
e =
case String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ QName -> String
qName (QName -> String) -> QName -> String
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 (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 :: Element -> FB2 m Blocks
parseAnnotation Element
e = [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)
mapM Element -> FB2 m Blocks
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseAnnotationChild (Element -> [Element]
elChildren Element
e)
parseAnnotationChild :: PandocMonad m => Element -> FB2 m Blocks
parseAnnotationChild :: Element -> FB2 m Blocks
parseAnnotationChild Element
e =
case String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ QName -> String
qName (QName -> String) -> QName -> String
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 (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 :: 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 :: Int
fb2SectionLevel = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 }
let sectionId :: Text
sectionId = Text -> (String -> Text) -> Maybe String -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" String -> Text
T.pack (Maybe String -> Text) -> Maybe String -> Text
forall a b. (a -> b) -> a -> b
$ QName -> Element -> Maybe String
findAttr (String -> QName
unqual String
"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)
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 :: Int
fb2SectionLevel = Int
n }
Blocks -> FB2 m Blocks
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
bs
parseSectionChild :: PandocMonad m => Element -> FB2 m Blocks
parseSectionChild :: Element -> FB2 m Blocks
parseSectionChild Element
e =
case String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ QName -> String
qName (QName -> String) -> QName -> String
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 (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 :: Element -> FB2 m Inlines
parseStyleType Element
e = [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)
mapM Content -> FB2 m Inlines
forall (m :: * -> *). PandocMonad m => Content -> FB2 m Inlines
parseInline (Element -> [Content]
elContent Element
e)
parseNamedStyle :: PandocMonad m => Element -> FB2 m Inlines
parseNamedStyle :: 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)
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))
-> (String -> Text) -> String -> (Text, Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> (Text, Text)) -> Maybe String -> Maybe (Text, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QName -> Element -> Maybe String
findAttr (String -> Maybe String -> Maybe String -> QName
QName String
"lang" Maybe String
forall a. Maybe a
Nothing (String -> Maybe String
forall a. a -> Maybe a
Just String
"xml")) Element
e
case QName -> Element -> Maybe String
findAttr (String -> QName
unqual String
"name") Element
e of
Just String
name -> Inlines -> FB2 m Inlines
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
"", [String -> Text
T.pack String
name], [(Text, Text)]
lang) Inlines
content
Maybe String
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 (f :: * -> *) a. Applicative f => a -> f a
pure Inlines
forall a. Monoid a => a
mempty
parseNamedStyleChild :: PandocMonad m => Content -> FB2 m Inlines
parseNamedStyleChild :: Content -> FB2 m Inlines
parseNamedStyleChild (Elem Element
e) =
case String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ QName -> String
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 (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
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Element -> String
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 (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 :: 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)
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 String -> Text
T.pack (String -> Text) -> Maybe String -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QName -> Element -> Maybe String
findAttr (String -> Maybe String -> Maybe String -> QName
QName String
"href" (String -> Maybe String
forall a. a -> Maybe a
Just String
"http://www.w3.org/1999/xlink") Maybe String
forall a. Maybe a
Nothing) Element
e of
Just Text
href -> case QName -> Element -> Maybe String
findAttr (String -> Maybe String -> Maybe String -> QName
QName String
"type" Maybe String
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing) Element
e of
Just String
"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 (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 (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 String
_ -> Inlines -> FB2 m Inlines
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 (f :: * -> *) a. Applicative f => a -> f a
pure Inlines
forall a. Monoid a => a
mempty
parseStyleLinkType :: PandocMonad m => Content -> FB2 m Inlines
parseStyleLinkType :: Content -> FB2 m Inlines
parseStyleLinkType x :: Content
x@(Elem Element
e) =
case QName -> String
qName (Element -> QName
elName Element
e) of
String
"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 (f :: * -> *) a. Applicative f => a -> f a
pure Inlines
forall a. Monoid a => a
mempty
String
_ -> 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 :: Element -> FB2 m Blocks
parseTable Element
_ = Blocks -> FB2 m Blocks
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
forall a. Monoid a => a
mempty
parseTitleInfoChild :: PandocMonad m => Element -> FB2 m ()
parseTitleInfoChild :: Element -> FB2 m ()
parseTitleInfoChild Element
e =
case String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ QName -> String
qName (Element -> QName
elName Element
e) of
Text
"genre" -> () -> FB2 m ()
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 (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 :: [Text]
fb2Authors = Text
authorText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:FB2State -> [Text]
fb2Authors FB2State
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
setMeta Text
"title" (Text -> Inlines
text (Text -> Inlines) -> Text -> Inlines
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Element -> String
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 (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
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
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
$ Text -> Text -> [Text]
T.splitOn Text
","
(Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack
(String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Element -> String
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
setMeta Text
"date" (Text -> Inlines
text (Text -> Inlines) -> Text -> Inlines
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Element -> String
strContent Element
e))
Text
"coverpage" -> Element -> FB2 m ()
forall (m :: * -> *). PandocMonad m => Element -> FB2 m ()
parseCoverPage Element
e
Text
"lang" -> () -> FB2 m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Text
"src-lang" -> () -> FB2 m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Text
"translator" -> () -> FB2 m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Text
"sequence" -> () -> FB2 m ()
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 :: Element -> FB2 m ()
parseCoverPage Element
e =
case QName -> Element -> Maybe Element
findChild (String -> Maybe String -> Maybe String -> QName
QName String
"image" (String -> Maybe String
forall a. a -> Maybe a
Just String
"http://www.gribuser.ru/xml/fictionbook/2.0") Maybe String
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
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 (f :: * -> *) a. Applicative f => a -> f a
pure ()
where href :: Maybe Text
href = String -> Text
T.pack (String -> Text) -> Maybe String -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QName -> Element -> Maybe String
findAttr (String -> Maybe String -> Maybe String -> QName
QName String
"href" (String -> Maybe String
forall a. a -> Maybe a
Just String
"http://www.w3.org/1999/xlink") Maybe String
forall a. Maybe a
Nothing) Element
img
Maybe Element
Nothing -> () -> FB2 m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
parseInlineImageElement :: PandocMonad m
=> Element
-> FB2 m Inlines
parseInlineImageElement :: Element -> FB2 m Inlines
parseInlineImageElement Element
e =
case Maybe Text
href of
Just Text
src -> Inlines -> FB2 m Inlines
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 (f :: * -> *) a. Applicative f => a -> f a
pure Inlines
forall a. Monoid a => a
mempty
where alt :: Inlines
alt = Inlines -> (String -> Inlines) -> Maybe String -> Inlines
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Inlines
forall a. Monoid a => a
mempty (Text -> Inlines
str (Text -> Inlines) -> (String -> Text) -> String -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack) (Maybe String -> Inlines) -> Maybe String -> Inlines
forall a b. (a -> b) -> a -> b
$ QName -> Element -> Maybe String
findAttr (String -> QName
unqual String
"alt") Element
e
href :: Maybe Text
href = String -> Text
T.pack (String -> Text) -> Maybe String -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QName -> Element -> Maybe String
findAttr (String -> Maybe String -> Maybe String -> QName
QName String
"href" (String -> Maybe String
forall a. a -> Maybe a
Just String
"http://www.w3.org/1999/xlink") Maybe String
forall a. Maybe a
Nothing) Element
e