{-# 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.Lazy.Base64
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
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{ fb2SectionLevel :: Int
fb2SectionLevel = Int
1
                , fb2Meta :: Meta
fb2Meta = forall a. Monoid a => a
mempty
                , fb2Authors :: [Text]
fb2Authors = []
                , fb2Notes :: Map Text Blocks
fb2Notes = 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 :: Meta
fb2Meta = 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 = forall a. HasMeta a => Text -> a -> a
deleteMeta Text
field (FB2State -> Meta
fb2Meta FB2State
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 forall a b. (a -> b) -> a -> b
$ Text -> Text
TL.fromStrict forall a b. (a -> b) -> a -> b
$ Sources -> Text
sourcesToText forall a b. (a -> b) -> a -> b
$ forall a. ToSources a => a -> Sources
toSources a
inp of
    Left Text
msg -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ Text -> Text -> PandocError
PandocXMLError Text
"" Text
msg
    Right Element
el ->  do
      (Blocks
bs, FB2State
st) <- forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseRootElement Element
el) forall a. Default a => a
def
      let authors :: Meta -> Meta
authors = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall a b. (a -> b) -> a -> b
$ FB2State -> [Text]
fb2Authors FB2State
st
                    then forall a. a -> a
id
                    else forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
setMeta Text
"author" (forall a b. (a -> b) -> [a] -> [b]
map Text -> Inlines
text forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ FB2State -> [Text]
fb2Authors FB2State
st)
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Meta -> [Block] -> Pandoc
Pandoc (Meta -> Meta
authors forall a b. (a -> b) -> a -> b
$ FB2State -> Meta
fb2Meta FB2State
st) forall a b. (a -> b) -> a -> b
$ forall a. Many a -> [a]
toList Blocks
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 = forall a. a -> Maybe a -> a
fromMaybe (Text -> Text
T.toUpper Text
e) forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
lookupEntity Text
e

parseInline :: PandocMonad m => Content -> FB2 m Inlines
parseInline :: forall (m :: * -> *). PandocMonad m => Content -> FB2 m Inlines
parseInline (Elem Element
e) =
  case QName -> Text
qName forall a b. (a -> b) -> a -> b
$ Element -> QName
elName Element
e of
    Text
"strong" -> Inlines -> Inlines
strong forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). PandocMonad m => Element -> FB2 m Inlines
parseStyleType Element
e
    Text
"emphasis" -> Inlines -> Inlines
emph forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). PandocMonad m => Element -> FB2 m Inlines
parseStyleType Element
e
    Text
"style" -> forall (m :: * -> *). PandocMonad m => Element -> FB2 m Inlines
parseNamedStyle Element
e
    Text
"a" -> forall (m :: * -> *). PandocMonad m => Element -> FB2 m Inlines
parseLinkType Element
e
    Text
"strikethrough" -> Inlines -> Inlines
strikeout forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). PandocMonad m => Element -> FB2 m Inlines
parseStyleType Element
e
    Text
"sub" -> Inlines -> Inlines
subscript forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). PandocMonad m => Element -> FB2 m Inlines
parseStyleType Element
e
    Text
"sup" -> Inlines -> Inlines
superscript forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). PandocMonad m => Element -> FB2 m Inlines
parseStyleType Element
e
    Text
"code" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> Inlines
code forall a b. (a -> b) -> a -> b
$ Element -> Text
strContent Element
e
    Text
"image" -> forall (m :: * -> *). PandocMonad m => Element -> FB2 m Inlines
parseInlineImageElement Element
e
    Text
name -> do
      forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report forall a b. (a -> b) -> a -> b
$ Text -> LogMessage
IgnoredElement Text
name
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty
parseInline (Text CData
x) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> Inlines
text forall a b. (a -> b) -> a -> b
$ CData -> Text
cdData CData
x
parseInline (CRef Text
r) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> Inlines
str forall a b. (a -> b) -> a -> b
$ Text -> Text
convertEntity Text
r

parseSubtitle :: PandocMonad m => Element -> FB2 m Blocks
parseSubtitle :: forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseSubtitle Element
e = Attr -> Int -> Inlines -> Blocks
headerWith (Text
"", [Text
"unnumbered"], []) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets FB2State -> Int
fb2SectionLevel forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *). PandocMonad m => Element -> FB2 m Inlines
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 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 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        Just Element
notesBody -> forall (m :: * -> *). PandocMonad m => Element -> FB2 m ()
parseNotesBody Element
notesBody
      -- Parse metadata and content
      forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseFictionBookChild (Element -> [Element]
elChildren Element
e)
    Text
name -> forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (Text -> Text -> LogMessage
UnexpectedXmlElement Text
name Text
"root") forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> 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 forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM 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 forall a b. (a -> b) -> a -> b
$ Element -> QName
elName Element
e of
    Text
"section" -> forall (m :: * -> *). PandocMonad m => Element -> FB2 m ()
parseNote Element
e
    Text
_ -> 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) forall a. Eq a => a -> a -> Bool
== Text
"body" Bool -> Bool -> Bool
&&
  QName -> Element -> Maybe Text
findAttr (Text -> QName
unqual Text
"name") Element
e forall a. Eq a => a -> a -> Bool
== 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 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Just Text
sectionId -> do
      Blocks
content <- forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseSectionChild ([Element] -> [Element]
dropTitle forall a b. (a -> b) -> a -> b
$ Element -> [Element]
elChildren Element
e)
      Map Text Blocks
oldNotes <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets FB2State -> Map Text Blocks
fb2Notes
      forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \FB2State
s -> FB2State
s { fb2Notes :: Map Text Blocks
fb2Notes = forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (Text
"#" forall a. Semigroup a => a -> a -> a
<> Text
sectionId) Blocks
content Map Text Blocks
oldNotes }
      forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  where
    isTitle :: Element -> Bool
isTitle Element
x = QName -> Text
qName (Element -> QName
elName Element
x) 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
xforall 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 forall a b. (a -> b) -> a -> b
$ Element -> QName
elName Element
e of
    Text
"stylesheet" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty -- stylesheet is ignored
    Text
"description" -> forall a. Monoid a => a
mempty forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall (m :: * -> *). PandocMonad m => Element -> FB2 m ()
parseDescriptionChild (Element -> [Element]
elChildren Element
e)
    Text
"body" -> if Element -> Bool
isNotesBody Element
e
                then forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty
                else forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseBodyChild (Element -> [Element]
elChildren Element
e)
    Text
"binary" -> forall a. Monoid a => a
mempty forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *). PandocMonad m => Element -> FB2 m ()
parseBinaryElement Element
e
    Text
name -> forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (Text -> Text -> LogMessage
UnexpectedXmlElement Text
name Text
"FictionBook") forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> 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 forall a b. (a -> b) -> a -> b
$ Element -> QName
elName Element
e of
    Text
"title-info" -> forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall (m :: * -> *). PandocMonad m => Element -> FB2 m ()
parseTitleInfoChild (Element -> [Element]
elChildren Element
e)
    Text
"src-title-info" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure () -- ignore
    Text
"document-info" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Text
"publish-info" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Text
"custom-info" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Text
"output" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Text
name -> do
      forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report forall a b. (a -> b) -> a -> b
$ Text -> LogMessage
IgnoredElement forall a b. (a -> b) -> a -> b
$ Text
name forall a. Semigroup a => a -> a -> a
<> Text
" in description"
      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 forall a b. (a -> b) -> a -> b
$ Element -> QName
elName Element
e of
    Text
"image" -> forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseImageElement Element
e
    Text
"title" -> Int -> Inlines -> Blocks
header forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets FB2State -> Int
fb2SectionLevel forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *). PandocMonad m => [Content] -> FB2 m Inlines
parseTitleType (Element -> [Content]
elContent Element
e)
    Text
"epigraph" -> forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseEpigraph Element
e
    Text
"section" -> forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseSection Element
e
    Text
name -> forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (Text -> Text -> LogMessage
UnexpectedXmlElement Text
name Text
"body") forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> 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
_) -> forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report forall a b. (a -> b) -> a -> b
$ Text -> LogMessage
IgnoredElement Text
"binary without id attribute"
    (Just Text
_, Maybe Text
Nothing) ->
      forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report forall a b. (a -> b) -> a -> b
$ Text -> LogMessage
IgnoredElement Text
"binary without content-type attribute"
    (Just Text
filename, Maybe Text
contentType) ->
      forall (m :: * -> *).
PandocMonad m =>
String -> Maybe Text -> ByteString -> m ()
insertMedia (Text -> String
T.unpack Text
filename) Maybe Text
contentType
                    (ByteString -> ByteString
decodeBase64Lenient
                      (Text -> ByteString
UTF8.fromTextLazy forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
TL.fromStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> Text
strContent 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Maybe a] -> [a]
catMaybes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM 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 forall a b. (a -> b) -> a -> b
$ Element -> QName
elName Element
e of
    Text
"first-name" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Element -> Text
strContent Element
e
    Text
"middle-name" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Element -> Text
strContent Element
e
    Text
"last-name" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Element -> Text
strContent Element
e
    Text
"nickname" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Element -> Text
strContent Element
e
    Text
"home-page" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Element -> Text
strContent Element
e
    Text
"email" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Element -> Text
strContent Element
e
    Text
name -> do
      forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report forall a b. (a -> b) -> a -> b
$ Text -> LogMessage
IgnoredElement forall a b. (a -> b) -> a -> b
$ Text
name forall a. Semigroup a => a -> a -> a
<> Text
" in author"
      forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 -> Inlines -> Blocks
header forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets FB2State -> Int
fb2SectionLevel forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *). PandocMonad m => [Content] -> FB2 m Inlines
parseTitleType (Element -> [Content]
elContent Element
e)

parseTitleType :: PandocMonad m => [Content] -> FB2 m Inlines
parseTitleType :: forall (m :: * -> *). PandocMonad m => [Content] -> FB2 m Inlines
parseTitleType [Content]
c = forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> [a] -> [a]
intersperse Inlines
linebreak forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Maybe a] -> [a]
catMaybes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *).
PandocMonad m =>
Content -> FB2 m (Maybe Inlines)
parseTitleContent [Content]
c

parseTitleContent :: PandocMonad m => Content -> FB2 m (Maybe Inlines)
parseTitleContent :: forall (m :: * -> *).
PandocMonad m =>
Content -> FB2 m (Maybe Inlines)
parseTitleContent (Elem Element
e) =
  case QName -> Text
qName forall a b. (a -> b) -> a -> b
$ Element -> QName
elName Element
e of
    Text
"p" -> forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). PandocMonad m => Element -> FB2 m Inlines
parsePType Element
e
    Text
"empty-line" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a. Monoid a => a
mempty
    Text
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty
parseTitleContent Content
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Inlines -> Blocks
para forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Text -> Inlines -> Inlines
imageWith (Text
imgId, [], []) (Text -> Text
removeHash Text
src) Text
title Inlines
alt
    Maybe Text
Nothing -> do
      forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report forall a b. (a -> b) -> a -> b
$ Text -> LogMessage
IgnoredElement Text
" image without href"
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty
  where alt :: Inlines
alt = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty Text -> Inlines
str forall a b. (a -> b) -> a -> b
$ QName -> Element -> Maybe Text
findAttr (Text -> QName
unqual Text
"alt") Element
e
        title :: Text
title = forall a. a -> Maybe a -> a
fromMaybe Text
"" forall a b. (a -> b) -> a -> b
$ QName -> Element -> Maybe Text
findAttr (Text -> QName
unqual Text
"title") Element
e
        imgId :: Text
imgId = forall a. a -> Maybe a -> a
fromMaybe 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" (forall a. a -> Maybe a
Just Text
"http://www.w3.org/1999/xlink") forall a. Maybe a
Nothing) Element
e

-- | Parse @pType@
parsePType :: PandocMonad m => Element -> FB2 m Inlines
parsePType :: forall (m :: * -> *). PandocMonad m => Element -> FB2 m Inlines
parsePType = forall (m :: * -> *). PandocMonad m => Element -> FB2 m Inlines
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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (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 forall a b. (a -> b) -> a -> b
$ Element -> QName
elName Element
e of
    Text
"p" -> Inlines -> Blocks
para forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). PandocMonad m => Element -> FB2 m Inlines
parsePType Element
e
    Text
"poem" -> forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parsePoem Element
e
    Text
"empty-line" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
horizontalRule
    Text
"subtitle" -> forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseSubtitle Element
e
    Text
"table" -> forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseTable Element
e
    Text
"text-author" -> Inlines -> Blocks
para forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). PandocMonad m => Element -> FB2 m Inlines
parsePType Element
e
    Text
name -> forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (Text -> Text -> LogMessage
UnexpectedXmlElement Text
name Text
"cite") forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> 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 = forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (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 forall a b. (a -> b) -> a -> b
$ Element -> QName
elName Element
e of
    Text
"title" -> forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseTitle Element
e
    Text
"subtitle" -> forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseSubtitle Element
e
    Text
"epigraph" -> forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseEpigraph Element
e
    Text
"stanza" -> forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseStanza Element
e
    Text
"text-author" -> Inlines -> Blocks
para forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). PandocMonad m => Element -> FB2 m Inlines
parsePType Element
e
    Text
"date" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Inlines -> Blocks
para forall a b. (a -> b) -> a -> b
$ Text -> Inlines
text forall a b. (a -> b) -> a -> b
$ Element -> Text
strContent Element
e
    Text
name -> forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (Text -> Text -> LogMessage
UnexpectedXmlElement Text
name Text
"poem") forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> 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 = forall a. [a] -> Many a
fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Block] -> [Block]
joinLineBlocks forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Many a -> [a]
toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (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 forall a. [a] -> [a] -> [a]
++ [[Inline]]
ys) forall a. a -> [a] -> [a]
: [Block]
zs)
joinLineBlocks (Block
x:[Block]
xs) = Block
xforall 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 forall a b. (a -> b) -> a -> b
$ Element -> QName
elName Element
e of
    Text
"title" -> forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseTitle Element
e
    Text
"subtitle" -> forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseSubtitle Element
e
    Text
"v" -> [Inlines] -> Blocks
lineBlock forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> [a] -> [a]
:[]) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). PandocMonad m => Element -> FB2 m Inlines
parsePType Element
e
    Text
name -> forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (Text -> Text -> LogMessage
UnexpectedXmlElement Text
name Text
"stanza") forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> 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"], []) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseEpigraphChild (Element -> [Element]
elChildren Element
e)
  where divId :: Text
divId = forall a. a -> Maybe a -> a
fromMaybe 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 forall a b. (a -> b) -> a -> b
$ Element -> QName
elName Element
e of
    Text
"p" -> Inlines -> Blocks
para forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). PandocMonad m => Element -> FB2 m Inlines
parsePType Element
e
    Text
"poem" -> forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parsePoem Element
e
    Text
"cite" -> forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseCite Element
e
    Text
"empty-line" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
horizontalRule
    Text
"text-author" -> Inlines -> Blocks
para forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). PandocMonad m => Element -> FB2 m Inlines
parsePType Element
e
    Text
name -> forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (Text -> Text -> LogMessage
UnexpectedXmlElement Text
name Text
"epigraph") forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> 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 = forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (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 forall a b. (a -> b) -> a -> b
$ Element -> QName
elName Element
e of
    Text
"p" -> Inlines -> Blocks
para forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). PandocMonad m => Element -> FB2 m Inlines
parsePType Element
e
    Text
"poem" -> forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parsePoem Element
e
    Text
"cite" -> forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseCite Element
e
    Text
"subtitle" -> forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseSubtitle Element
e
    Text
"table" -> forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseTable Element
e
    Text
"empty-line" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
horizontalRule
    Text
name -> forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (Text -> Text -> LogMessage
UnexpectedXmlElement Text
name Text
"annotation") forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> 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
  Int
n <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets FB2State -> Int
fb2SectionLevel
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \FB2State
st -> FB2State
st{ fb2SectionLevel :: Int
fb2SectionLevel = Int
n forall a. Num a => a -> a -> a
+ Int
1 }
  let sectionId :: Text
sectionId = forall a. a -> Maybe a -> a
fromMaybe Text
"" forall a b. (a -> b) -> a -> b
$ QName -> Element -> Maybe Text
findAttr (Text -> QName
unqual Text
"id") Element
e
  Blocks
bs <- Attr -> Blocks -> Blocks
divWith (Text
sectionId, [Text
"section"], []) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseSectionChild (Element -> [Element]
elChildren Element
e)
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \FB2State
st -> FB2State
st{ fb2SectionLevel :: Int
fb2SectionLevel = Int
n }
  forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
bs

parseSectionChild :: PandocMonad m => Element -> FB2 m Blocks
parseSectionChild :: forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseSectionChild Element
e =
  case QName -> Text
qName forall a b. (a -> b) -> a -> b
$ Element -> QName
elName Element
e of
    Text
"title" -> forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseBodyChild Element
e
    Text
"epigraph" -> forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseEpigraph Element
e
    Text
"image" -> forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseImageElement Element
e
    Text
"annotation" -> forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseAnnotation Element
e
    Text
"poem" -> forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parsePoem Element
e
    Text
"cite" -> forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseCite Element
e
    Text
"empty-line" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
horizontalRule
    Text
"table" -> forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseTable Element
e
    Text
"subtitle" -> forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseSubtitle Element
e
    Text
"p" -> Inlines -> Blocks
para forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). PandocMonad m => Element -> FB2 m Inlines
parsePType Element
e
    Text
"section" -> forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseSection Element
e
    Text
name -> forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (Text -> Text -> LogMessage
UnexpectedXmlElement Text
name Text
"section") forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> forall a. Monoid a => a
mempty

-- | parse @styleType@
parseStyleType :: PandocMonad m => Element -> FB2 m Inlines
parseStyleType :: forall (m :: * -> *). PandocMonad m => Element -> FB2 m Inlines
parseStyleType Element
e = forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *). PandocMonad m => Content -> FB2 m Inlines
parseInline (Element -> [Content]
elContent Element
e)

-- | Parse @namedStyleType@
parseNamedStyle :: PandocMonad m => Element -> FB2 m Inlines
parseNamedStyle :: forall (m :: * -> *). PandocMonad m => Element -> FB2 m Inlines
parseNamedStyle Element
e = do
  Inlines
content <- forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *). PandocMonad m => Content -> FB2 m Inlines
parseNamedStyleChild (Element -> [Content]
elContent Element
e)
  let lang :: [(Text, Text)]
lang = forall a. Maybe a -> [a]
maybeToList forall a b. (a -> b) -> a -> b
$ (Text
"lang",) 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" forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just Text
"xml")) Element
e
  case QName -> Element -> Maybe Text
findAttr (Text -> QName
unqual Text
"name") Element
e of
    Just Text
name -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Attr -> Inlines -> Inlines
spanWith (Text
"", [Text
name], [(Text, Text)]
lang) Inlines
content
    Maybe Text
Nothing -> do
      forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report forall a b. (a -> b) -> a -> b
$ Text -> LogMessage
IgnoredElement Text
"link without required name"
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty

parseNamedStyleChild :: PandocMonad m => Content -> FB2 m Inlines
parseNamedStyleChild :: forall (m :: * -> *). PandocMonad m => Content -> FB2 m Inlines
parseNamedStyleChild (Elem Element
e) =
  case QName -> Text
qName (Element -> QName
elName Element
e) of
    Text
"strong" -> Inlines -> Inlines
strong forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). PandocMonad m => Element -> FB2 m Inlines
parseStyleType Element
e
    Text
"emphasis" -> Inlines -> Inlines
emph forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). PandocMonad m => Element -> FB2 m Inlines
parseStyleType Element
e
    Text
"style" -> forall (m :: * -> *). PandocMonad m => Element -> FB2 m Inlines
parseNamedStyle Element
e
    Text
"a" -> forall (m :: * -> *). PandocMonad m => Element -> FB2 m Inlines
parseLinkType Element
e
    Text
"strikethrough" -> Inlines -> Inlines
strikeout forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). PandocMonad m => Element -> FB2 m Inlines
parseStyleType Element
e
    Text
"sub" -> Inlines -> Inlines
subscript forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). PandocMonad m => Element -> FB2 m Inlines
parseStyleType Element
e
    Text
"sup" -> Inlines -> Inlines
superscript forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). PandocMonad m => Element -> FB2 m Inlines
parseStyleType Element
e
    Text
"code" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> Inlines
code forall a b. (a -> b) -> a -> b
$ Element -> Text
strContent Element
e
    Text
"image" -> forall (m :: * -> *). PandocMonad m => Element -> FB2 m Inlines
parseInlineImageElement Element
e
    Text
name -> do
      forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report forall a b. (a -> b) -> a -> b
$ Text -> LogMessage
IgnoredElement forall a b. (a -> b) -> a -> b
$ Text
name forall a. Semigroup a => a -> a -> a
<> Text
" in style"
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty
parseNamedStyleChild Content
x = forall (m :: * -> *). PandocMonad m => Content -> FB2 m Inlines
parseInline Content
x

-- | Parse @linkType@
parseLinkType :: PandocMonad m => Element -> FB2 m Inlines
parseLinkType :: forall (m :: * -> *). PandocMonad m => Element -> FB2 m Inlines
parseLinkType Element
e = do
  Inlines
content <- forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *). PandocMonad m => Content -> FB2 m Inlines
parseStyleLinkType (Element -> [Content]
elContent Element
e)
  Map Text Blocks
notes <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets FB2State -> Map Text Blocks
fb2Notes
  case QName -> Element -> Maybe Text
findAttr (Text -> Maybe Text -> Maybe Text -> QName
QName Text
"href" (forall a. a -> Maybe a
Just Text
"http://www.w3.org/1999/xlink") forall a. Maybe a
Nothing) Element
e of
    Just Text
href -> case QName -> Element -> Maybe Text
findAttr (Text -> Maybe Text -> Maybe Text -> QName
QName Text
"type" forall a. Maybe a
Nothing forall a. Maybe a
Nothing) Element
e of
                   Just Text
"note" -> case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
href Map Text Blocks
notes of
                                    Maybe Blocks
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> Text -> Inlines -> Inlines
link Text
href Text
"" Inlines
content
                                    Just Blocks
contents -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Blocks -> Inlines
note Blocks
contents
                   Maybe Text
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> Text -> Inlines -> Inlines
link Text
href Text
"" Inlines
content
    Maybe Text
Nothing -> do
      forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report forall a b. (a -> b) -> a -> b
$ Text -> LogMessage
IgnoredElement Text
"link without required href"
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty

-- | Parse @styleLinkType@
parseStyleLinkType :: PandocMonad m => Content -> FB2 m Inlines
parseStyleLinkType :: forall (m :: * -> *). PandocMonad m => Content -> FB2 m Inlines
parseStyleLinkType x :: Content
x@(Elem Element
e) =
  case QName -> Text
qName (Element -> QName
elName Element
e) of
    Text
"a" -> do
      forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report forall a b. (a -> b) -> a -> b
$ Text -> LogMessage
IgnoredElement Text
"nested link"
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty
    Text
_ -> forall (m :: * -> *). PandocMonad m => Content -> FB2 m Inlines
parseInline Content
x
parseStyleLinkType Content
x = forall (m :: * -> *). PandocMonad m => Content -> FB2 m Inlines
parseInline Content
x

-- | Parse @tableType@
parseTable :: PandocMonad m => Element -> FB2 m Blocks
parseTable :: forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseTable Element
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure 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" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Text
"author" -> forall (m :: * -> *). PandocMonad m => Element -> FB2 m Text
parseAuthor Element
e forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Text
author -> forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\FB2State
st -> FB2State
st {fb2Authors :: [Text]
fb2Authors = Text
authorforall a. a -> [a] -> [a]
:FB2State -> [Text]
fb2Authors FB2State
st})
    Text
"book-title" -> forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
setMeta Text
"title" (Text -> Inlines
text forall a b. (a -> b) -> a -> b
$ Element -> Text
strContent Element
e))
    Text
"annotation" -> forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseAnnotation Element
e forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
setMeta Text
"abstract"
    Text
"keywords" -> forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
setMeta Text
"keywords" (forall a b. (a -> b) -> [a] -> [b]
map (Text -> MetaValue
MetaString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
trim) forall a b. (a -> b) -> a -> b
$ Text -> Text -> [Text]
T.splitOn Text
","
                                                                      forall a b. (a -> b) -> a -> b
$ Element -> Text
strContent Element
e))
    Text
"date" -> forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
setMeta Text
"date" (Text -> Inlines
text forall a b. (a -> b) -> a -> b
$ Element -> Text
strContent Element
e))
    Text
"coverpage" -> forall (m :: * -> *). PandocMonad m => Element -> FB2 m ()
parseCoverPage Element
e
    Text
"lang" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Text
"src-lang" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Text
"translator" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Text
"sequence" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Text
name -> forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report forall a b. (a -> b) -> a -> b
$ Text -> LogMessage
IgnoredElement forall a b. (a -> b) -> a -> b
$ Text
name 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" (forall a. a -> Maybe a
Just Text
"http://www.gribuser.ru/xml/fictionbook/2.0") forall a. Maybe a
Nothing) Element
e of
    Just Element
img -> case Maybe Text
href of
                  Just Text
src -> forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
setMeta Text
"cover-image" (Text -> MetaValue
MetaString forall a b. (a -> b) -> a -> b
$ Text -> Text
removeHash Text
src))
                  Maybe Text
Nothing -> 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" (forall a. a -> Maybe a
Just Text
"http://www.w3.org/1999/xlink") forall a. Maybe a
Nothing) Element
img
    Maybe Element
Nothing -> 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 Inlines
parseInlineImageElement Element
e =
  case Maybe Text
href of
    Just Text
src -> forall (f :: * -> *) a. Applicative f => a -> f a
pure 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
      forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report forall a b. (a -> b) -> a -> b
$ Text -> LogMessage
IgnoredElement Text
"inline image without href"
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty
  where alt :: Inlines
alt = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty Text -> Inlines
str 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" (forall a. a -> Maybe a
Just Text
"http://www.w3.org/1999/xlink") forall a. Maybe a
Nothing) Element
e