{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE OverloadedStrings #-}
{- |
   Module      : Text.Pandoc.Readers.FB2
   Copyright   : Copyright (C) 2018-2020 Alexander Krotov
   License     : GNU GPL, version 2 or above

   Maintainer  : Alexander Krotov <ilabdsf@gmail.com>
   Stability   : alpha
   Portability : portable

Conversion of FB2 to 'Pandoc' document.
-}

{-

TODO:
 - Tables
 - Named styles
 - Parse ID attribute for all elements that have it

-}

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
      (bs, 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 = 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 -> [Many Inline] -> Meta -> Meta
forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
forall b. ToMetaValue b => Text -> b -> Meta -> Meta
setMeta Text
"author" ((Text -> Many Inline) -> [Text] -> [Many Inline]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Many Inline
text ([Text] -> [Many Inline]) -> [Text] -> [Many Inline]
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)
      pure $ Pandoc (authors $ fb2Meta st) $ toList bs

-- * Utility functions

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 (Many Inline)
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" -> Many Inline -> Many Inline
strong (Many Inline -> Many Inline)
-> FB2 m (Many Inline) -> FB2 m (Many Inline)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> FB2 m (Many Inline)
forall (m :: * -> *).
PandocMonad m =>
Element -> FB2 m (Many Inline)
parseStyleType Element
e
    Text
"emphasis" -> Many Inline -> Many Inline
emph (Many Inline -> Many Inline)
-> FB2 m (Many Inline) -> FB2 m (Many Inline)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> FB2 m (Many Inline)
forall (m :: * -> *).
PandocMonad m =>
Element -> FB2 m (Many Inline)
parseStyleType Element
e
    Text
"style" -> Element -> FB2 m (Many Inline)
forall (m :: * -> *).
PandocMonad m =>
Element -> FB2 m (Many Inline)
parseNamedStyle Element
e
    Text
"a" -> Element -> FB2 m (Many Inline)
forall (m :: * -> *).
PandocMonad m =>
Element -> FB2 m (Many Inline)
parseLinkType Element
e
    Text
"strikethrough" -> Many Inline -> Many Inline
strikeout (Many Inline -> Many Inline)
-> FB2 m (Many Inline) -> FB2 m (Many Inline)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> FB2 m (Many Inline)
forall (m :: * -> *).
PandocMonad m =>
Element -> FB2 m (Many Inline)
parseStyleType Element
e
    Text
"sub" -> Many Inline -> Many Inline
subscript (Many Inline -> Many Inline)
-> FB2 m (Many Inline) -> FB2 m (Many Inline)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> FB2 m (Many Inline)
forall (m :: * -> *).
PandocMonad m =>
Element -> FB2 m (Many Inline)
parseStyleType Element
e
    Text
"sup" -> Many Inline -> Many Inline
superscript (Many Inline -> Many Inline)
-> FB2 m (Many Inline) -> FB2 m (Many Inline)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> FB2 m (Many Inline)
forall (m :: * -> *).
PandocMonad m =>
Element -> FB2 m (Many Inline)
parseStyleType Element
e
    Text
"code" -> Many Inline -> FB2 m (Many Inline)
forall a. a -> StateT FB2State m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Many Inline -> FB2 m (Many Inline))
-> Many Inline -> FB2 m (Many Inline)
forall a b. (a -> b) -> a -> b
$ Text -> Many Inline
code (Text -> Many Inline) -> Text -> Many Inline
forall a b. (a -> b) -> a -> b
$ Element -> Text
strContent Element
e
    Text
"image" -> Element -> FB2 m (Many Inline)
forall (m :: * -> *).
PandocMonad m =>
Element -> FB2 m (Many Inline)
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
      Many Inline -> FB2 m (Many Inline)
forall a. a -> StateT FB2State m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Many Inline
forall a. Monoid a => a
mempty
parseInline (Text CData
x) = Many Inline -> FB2 m (Many Inline)
forall a. a -> StateT FB2State m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Many Inline -> FB2 m (Many Inline))
-> Many Inline -> FB2 m (Many Inline)
forall a b. (a -> b) -> a -> b
$ Text -> Many Inline
text (Text -> Many Inline) -> Text -> Many Inline
forall a b. (a -> b) -> a -> b
$ CData -> Text
cdData CData
x
parseInline (CRef Text
r) = Many Inline -> FB2 m (Many Inline)
forall a. a -> StateT FB2State m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Many Inline -> FB2 m (Many Inline))
-> Many Inline -> FB2 m (Many Inline)
forall a b. (a -> b) -> a -> b
$ Text -> Many Inline
str (Text -> Many Inline) -> Text -> Many Inline
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 -> Many Inline -> Blocks
headerWith (Text
"", [Text
"unnumbered"], []) (Int -> Many Inline -> Blocks)
-> StateT FB2State m Int
-> StateT FB2State m (Many Inline -> 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 (Many Inline -> Blocks)
-> StateT FB2State m (Many Inline) -> 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 (Many Inline)
forall (m :: * -> *).
PandocMonad m =>
Element -> FB2 m (Many Inline)
parsePType Element
e

-- * Root element parser

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
      -- Parse notes before parsing the rest of the content.
      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
      -- Parse metadata and content
      [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

-- | Parse notes
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)

-- | Parse a child of @\<body name="notes">@ element.
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
      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)
      oldNotes <- gets fb2Notes
      modify $ \FB2State
s -> FB2State
s { fb2Notes = M.insert ("#" <> sectionId) content oldNotes }
      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 -- Drop note section <title> if present
                         else Element
xElement -> [Element] -> [Element]
forall a. a -> [a] -> [a]
:[Element]
xs
    dropTitle [] = []

-- | Parse a child of @\<FictionBook>@ element.
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 -- stylesheet is ignored
    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

-- | Parse a child of @\<description>@ element.
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 () -- ignore
    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

-- | Parse a child of @\<body>@ element.
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 -> Many Inline -> Blocks
header (Int -> Many Inline -> Blocks)
-> StateT FB2State m Int
-> StateT FB2State m (Many Inline -> 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 (Many Inline -> Blocks)
-> StateT FB2State m (Many Inline) -> 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 (Many Inline)
forall (m :: * -> *).
PandocMonad m =>
[Content] -> FB2 m (Many Inline)
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

-- | Parse a @\<binary>@ element.
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))

-- * Type parsers

-- | Parse @authorType@
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

-- | Parse @titleType@
parseTitle :: PandocMonad m => Element -> FB2 m Blocks
parseTitle :: forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseTitle Element
e = Int -> Many Inline -> Blocks
header (Int -> Many Inline -> Blocks)
-> StateT FB2State m Int
-> StateT FB2State m (Many Inline -> 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 (Many Inline -> Blocks)
-> StateT FB2State m (Many Inline) -> 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 (Many Inline)
forall (m :: * -> *).
PandocMonad m =>
[Content] -> FB2 m (Many Inline)
parseTitleType (Element -> [Content]
elContent Element
e)

parseTitleType :: PandocMonad m => [Content] -> FB2 m Inlines
parseTitleType :: forall (m :: * -> *).
PandocMonad m =>
[Content] -> FB2 m (Many Inline)
parseTitleType [Content]
c = [Many Inline] -> Many Inline
forall a. Monoid a => [a] -> a
mconcat ([Many Inline] -> Many Inline)
-> ([Maybe (Many Inline)] -> [Many Inline])
-> [Maybe (Many Inline)]
-> Many Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Many Inline -> [Many Inline] -> [Many Inline]
forall a. a -> [a] -> [a]
intersperse Many Inline
linebreak ([Many Inline] -> [Many Inline])
-> ([Maybe (Many Inline)] -> [Many Inline])
-> [Maybe (Many Inline)]
-> [Many Inline]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe (Many Inline)] -> [Many Inline]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (Many Inline)] -> Many Inline)
-> StateT FB2State m [Maybe (Many Inline)]
-> StateT FB2State m (Many Inline)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Content -> StateT FB2State m (Maybe (Many Inline)))
-> [Content] -> StateT FB2State m [Maybe (Many Inline)]
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 (Many Inline))
forall (m :: * -> *).
PandocMonad m =>
Content -> FB2 m (Maybe (Many Inline))
parseTitleContent [Content]
c

parseTitleContent :: PandocMonad m => Content -> FB2 m (Maybe Inlines)
parseTitleContent :: forall (m :: * -> *).
PandocMonad m =>
Content -> FB2 m (Maybe (Many Inline))
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" -> Many Inline -> Maybe (Many Inline)
forall a. a -> Maybe a
Just (Many Inline -> Maybe (Many Inline))
-> StateT FB2State m (Many Inline) -> FB2 m (Maybe (Many Inline))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> StateT FB2State m (Many Inline)
forall (m :: * -> *).
PandocMonad m =>
Element -> FB2 m (Many Inline)
parsePType Element
e
    Text
"empty-line" -> Maybe (Many Inline) -> FB2 m (Maybe (Many Inline))
forall a. a -> StateT FB2State m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Many Inline) -> FB2 m (Maybe (Many Inline)))
-> Maybe (Many Inline) -> FB2 m (Maybe (Many Inline))
forall a b. (a -> b) -> a -> b
$ Many Inline -> Maybe (Many Inline)
forall a. a -> Maybe a
Just Many Inline
forall a. Monoid a => a
mempty
    Text
_ -> Maybe (Many Inline) -> FB2 m (Maybe (Many Inline))
forall a. a -> StateT FB2State m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Many Inline)
forall a. Monoid a => a
mempty
parseTitleContent Content
_ = Maybe (Many Inline) -> FB2 m (Maybe (Many Inline))
forall a. a -> StateT FB2State m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Many Inline)
forall a. Maybe a
Nothing

-- | Parse @imageType@
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
$ Many Inline -> Blocks
para (Many Inline -> Blocks) -> Many Inline -> Blocks
forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Text -> Many Inline -> Many Inline
imageWith (Text
imgId, [], []) (Text -> Text
removeHash Text
src) Text
title Many Inline
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 :: Many Inline
alt = Many Inline -> (Text -> Many Inline) -> Maybe Text -> Many Inline
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Many Inline
forall a. Monoid a => a
mempty Text -> Many Inline
str (Maybe Text -> Many Inline) -> Maybe Text -> Many Inline
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

-- | Parse @pType@
parsePType :: PandocMonad m => Element -> FB2 m Inlines
parsePType :: forall (m :: * -> *).
PandocMonad m =>
Element -> FB2 m (Many Inline)
parsePType = Element -> FB2 m (Many Inline)
forall (m :: * -> *).
PandocMonad m =>
Element -> FB2 m (Many Inline)
parseStyleType -- TODO add support for optional "id" and "style" attributes

-- | Parse @citeType@
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)

-- | Parse @citeType@ child
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" -> Many Inline -> Blocks
para (Many Inline -> Blocks)
-> StateT FB2State m (Many Inline) -> FB2 m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> StateT FB2State m (Many Inline)
forall (m :: * -> *).
PandocMonad m =>
Element -> FB2 m (Many Inline)
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" -> Many Inline -> Blocks
para (Many Inline -> Blocks)
-> StateT FB2State m (Many Inline) -> FB2 m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> StateT FB2State m (Many Inline)
forall (m :: * -> *).
PandocMonad m =>
Element -> FB2 m (Many Inline)
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

-- | Parse @poemType@
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" -> Many Inline -> Blocks
para (Many Inline -> Blocks)
-> StateT FB2State m (Many Inline) -> FB2 m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> StateT FB2State m (Many Inline)
forall (m :: * -> *).
PandocMonad m =>
Element -> FB2 m (Many Inline)
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
$ Many Inline -> Blocks
para (Many Inline -> Blocks) -> Many Inline -> Blocks
forall a b. (a -> b) -> a -> b
$ Text -> Many Inline
text (Text -> Many Inline) -> Text -> Many Inline
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" -> [Many Inline] -> Blocks
lineBlock ([Many Inline] -> Blocks)
-> (Many Inline -> [Many Inline]) -> Many Inline -> Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Many Inline -> [Many Inline] -> [Many Inline]
forall a. a -> [a] -> [a]
:[]) (Many Inline -> Blocks)
-> StateT FB2State m (Many Inline) -> FB2 m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> StateT FB2State m (Many Inline)
forall (m :: * -> *).
PandocMonad m =>
Element -> FB2 m (Many Inline)
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

-- | Parse @epigraphType@
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" -> Many Inline -> Blocks
para (Many Inline -> Blocks)
-> StateT FB2State m (Many Inline) -> FB2 m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> StateT FB2State m (Many Inline)
forall (m :: * -> *).
PandocMonad m =>
Element -> FB2 m (Many Inline)
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" -> Many Inline -> Blocks
para (Many Inline -> Blocks)
-> StateT FB2State m (Many Inline) -> FB2 m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> StateT FB2State m (Many Inline)
forall (m :: * -> *).
PandocMonad m =>
Element -> FB2 m (Many Inline)
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

-- | Parse @annotationType@
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" -> Many Inline -> Blocks
para (Many Inline -> Blocks)
-> StateT FB2State m (Many Inline) -> FB2 m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> StateT FB2State m (Many Inline)
forall (m :: * -> *).
PandocMonad m =>
Element -> FB2 m (Many Inline)
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

-- | Parse @sectionType@
parseSection :: PandocMonad m => Element -> FB2 m Blocks
parseSection :: forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseSection Element
e = do
  n <- (FB2State -> Int) -> StateT FB2State m Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets FB2State -> Int
fb2SectionLevel
  modify $ \FB2State
st -> FB2State
st{ fb2SectionLevel = n + 1 }
  let 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
  bs <- divWith (sectionId, ["section"], []) . mconcat <$> mapM parseSectionChild (elChildren e)
  modify $ \FB2State
st -> FB2State
st{ fb2SectionLevel = n }
  pure 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" -> Many Inline -> Blocks
para (Many Inline -> Blocks)
-> StateT FB2State m (Many Inline) -> FB2 m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> StateT FB2State m (Many Inline)
forall (m :: * -> *).
PandocMonad m =>
Element -> FB2 m (Many Inline)
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

-- | parse @styleType@
parseStyleType :: PandocMonad m => Element -> FB2 m Inlines
parseStyleType :: forall (m :: * -> *).
PandocMonad m =>
Element -> FB2 m (Many Inline)
parseStyleType Element
e = [Many Inline] -> Many Inline
forall a. Monoid a => [a] -> a
mconcat ([Many Inline] -> Many Inline)
-> StateT FB2State m [Many Inline]
-> StateT FB2State m (Many Inline)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Content -> StateT FB2State m (Many Inline))
-> [Content] -> StateT FB2State m [Many Inline]
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 (Many Inline)
forall (m :: * -> *).
PandocMonad m =>
Content -> FB2 m (Many Inline)
parseInline (Element -> [Content]
elContent Element
e)

-- | Parse @namedStyleType@
parseNamedStyle :: PandocMonad m => Element -> FB2 m Inlines
parseNamedStyle :: forall (m :: * -> *).
PandocMonad m =>
Element -> FB2 m (Many Inline)
parseNamedStyle Element
e = do
  content <- [Many Inline] -> Many Inline
forall a. Monoid a => [a] -> a
mconcat ([Many Inline] -> Many Inline)
-> StateT FB2State m [Many Inline]
-> StateT FB2State m (Many Inline)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Content -> StateT FB2State m (Many Inline))
-> [Content] -> StateT FB2State m [Many Inline]
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 (Many Inline)
forall (m :: * -> *).
PandocMonad m =>
Content -> FB2 m (Many Inline)
parseNamedStyleChild (Element -> [Content]
elContent Element
e)
  let 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 findAttr (unqual "name") e of
    Just Text
name -> Many Inline -> StateT FB2State m (Many Inline)
forall a. a -> StateT FB2State m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Many Inline -> StateT FB2State m (Many Inline))
-> Many Inline -> StateT FB2State m (Many Inline)
forall a b. (a -> b) -> a -> b
$ Attr -> Many Inline -> Many Inline
spanWith (Text
"", [Text
name], [(Text, Text)]
lang) Many Inline
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"
      Many Inline -> StateT FB2State m (Many Inline)
forall a. a -> StateT FB2State m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Many Inline
forall a. Monoid a => a
mempty

parseNamedStyleChild :: PandocMonad m => Content -> FB2 m Inlines
parseNamedStyleChild :: forall (m :: * -> *).
PandocMonad m =>
Content -> FB2 m (Many Inline)
parseNamedStyleChild (Elem Element
e) =
  case QName -> Text
qName (Element -> QName
elName Element
e) of
    Text
"strong" -> Many Inline -> Many Inline
strong (Many Inline -> Many Inline)
-> FB2 m (Many Inline) -> FB2 m (Many Inline)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> FB2 m (Many Inline)
forall (m :: * -> *).
PandocMonad m =>
Element -> FB2 m (Many Inline)
parseStyleType Element
e
    Text
"emphasis" -> Many Inline -> Many Inline
emph (Many Inline -> Many Inline)
-> FB2 m (Many Inline) -> FB2 m (Many Inline)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> FB2 m (Many Inline)
forall (m :: * -> *).
PandocMonad m =>
Element -> FB2 m (Many Inline)
parseStyleType Element
e
    Text
"style" -> Element -> FB2 m (Many Inline)
forall (m :: * -> *).
PandocMonad m =>
Element -> FB2 m (Many Inline)
parseNamedStyle Element
e
    Text
"a" -> Element -> FB2 m (Many Inline)
forall (m :: * -> *).
PandocMonad m =>
Element -> FB2 m (Many Inline)
parseLinkType Element
e
    Text
"strikethrough" -> Many Inline -> Many Inline
strikeout (Many Inline -> Many Inline)
-> FB2 m (Many Inline) -> FB2 m (Many Inline)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> FB2 m (Many Inline)
forall (m :: * -> *).
PandocMonad m =>
Element -> FB2 m (Many Inline)
parseStyleType Element
e
    Text
"sub" -> Many Inline -> Many Inline
subscript (Many Inline -> Many Inline)
-> FB2 m (Many Inline) -> FB2 m (Many Inline)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> FB2 m (Many Inline)
forall (m :: * -> *).
PandocMonad m =>
Element -> FB2 m (Many Inline)
parseStyleType Element
e
    Text
"sup" -> Many Inline -> Many Inline
superscript (Many Inline -> Many Inline)
-> FB2 m (Many Inline) -> FB2 m (Many Inline)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> FB2 m (Many Inline)
forall (m :: * -> *).
PandocMonad m =>
Element -> FB2 m (Many Inline)
parseStyleType Element
e
    Text
"code" -> Many Inline -> FB2 m (Many Inline)
forall a. a -> StateT FB2State m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Many Inline -> FB2 m (Many Inline))
-> Many Inline -> FB2 m (Many Inline)
forall a b. (a -> b) -> a -> b
$ Text -> Many Inline
code (Text -> Many Inline) -> Text -> Many Inline
forall a b. (a -> b) -> a -> b
$ Element -> Text
strContent Element
e
    Text
"image" -> Element -> FB2 m (Many Inline)
forall (m :: * -> *).
PandocMonad m =>
Element -> FB2 m (Many Inline)
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"
      Many Inline -> FB2 m (Many Inline)
forall a. a -> StateT FB2State m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Many Inline
forall a. Monoid a => a
mempty
parseNamedStyleChild Content
x = Content -> FB2 m (Many Inline)
forall (m :: * -> *).
PandocMonad m =>
Content -> FB2 m (Many Inline)
parseInline Content
x

-- | Parse @linkType@
parseLinkType :: PandocMonad m => Element -> FB2 m Inlines
parseLinkType :: forall (m :: * -> *).
PandocMonad m =>
Element -> FB2 m (Many Inline)
parseLinkType Element
e = do
  content <- [Many Inline] -> Many Inline
forall a. Monoid a => [a] -> a
mconcat ([Many Inline] -> Many Inline)
-> StateT FB2State m [Many Inline]
-> StateT FB2State m (Many Inline)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Content -> StateT FB2State m (Many Inline))
-> [Content] -> StateT FB2State m [Many Inline]
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 (Many Inline)
forall (m :: * -> *).
PandocMonad m =>
Content -> FB2 m (Many Inline)
parseStyleLinkType (Element -> [Content]
elContent Element
e)
  notes <- gets fb2Notes
  case findAttr (QName "href" (Just "http://www.w3.org/1999/xlink") Nothing) 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 -> Many Inline -> StateT FB2State m (Many Inline)
forall a. a -> StateT FB2State m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Many Inline -> StateT FB2State m (Many Inline))
-> Many Inline -> StateT FB2State m (Many Inline)
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Many Inline -> Many Inline
link Text
href Text
"" Many Inline
content
                                    Just Blocks
contents -> Many Inline -> StateT FB2State m (Many Inline)
forall a. a -> StateT FB2State m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Many Inline -> StateT FB2State m (Many Inline))
-> Many Inline -> StateT FB2State m (Many Inline)
forall a b. (a -> b) -> a -> b
$ Blocks -> Many Inline
note Blocks
contents
                   Maybe Text
_ -> Many Inline -> StateT FB2State m (Many Inline)
forall a. a -> StateT FB2State m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Many Inline -> StateT FB2State m (Many Inline))
-> Many Inline -> StateT FB2State m (Many Inline)
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Many Inline -> Many Inline
link Text
href Text
"" Many Inline
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"
      Many Inline -> StateT FB2State m (Many Inline)
forall a. a -> StateT FB2State m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Many Inline
forall a. Monoid a => a
mempty

-- | Parse @styleLinkType@
parseStyleLinkType :: PandocMonad m => Content -> FB2 m Inlines
parseStyleLinkType :: forall (m :: * -> *).
PandocMonad m =>
Content -> FB2 m (Many Inline)
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"
      Many Inline -> FB2 m (Many Inline)
forall a. a -> StateT FB2State m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Many Inline
forall a. Monoid a => a
mempty
    Text
_ -> Content -> FB2 m (Many Inline)
forall (m :: * -> *).
PandocMonad m =>
Content -> FB2 m (Many Inline)
parseInline Content
x
parseStyleLinkType Content
x = Content -> FB2 m (Many Inline)
forall (m :: * -> *).
PandocMonad m =>
Content -> FB2 m (Many Inline)
parseInline Content
x

-- | Parse @tableType@
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 -- TODO: tables are not supported yet

-- | Parse @title-infoType@
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 -> Many Inline -> 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 -> Many Inline
text (Text -> Many Inline) -> Text -> Many Inline
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 -> Many Inline -> 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 -> Many Inline
text (Text -> Many Inline) -> Text -> Many Inline
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 ()

-- | Parse @inlineImageType@ element
parseInlineImageElement :: PandocMonad m
                        => Element
                        -> FB2 m Inlines
parseInlineImageElement :: forall (m :: * -> *).
PandocMonad m =>
Element -> FB2 m (Many Inline)
parseInlineImageElement Element
e =
  case Maybe Text
href of
    Just Text
src -> Many Inline -> FB2 m (Many Inline)
forall a. a -> StateT FB2State m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Many Inline -> FB2 m (Many Inline))
-> Many Inline -> FB2 m (Many Inline)
forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Text -> Many Inline -> Many Inline
imageWith (Text
"", [], []) (Text -> Text
removeHash Text
src) Text
"" Many Inline
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"
      Many Inline -> FB2 m (Many Inline)
forall a. a -> StateT FB2State m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Many Inline
forall a. Monoid a => a
mempty
  where alt :: Many Inline
alt = Many Inline -> (Text -> Many Inline) -> Maybe Text -> Many Inline
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Many Inline
forall a. Monoid a => a
mempty Text -> Many Inline
str (Maybe Text -> Many Inline) -> Maybe Text -> Many Inline
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