{-# 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.HTML.TagSoup.Entity (lookupEntity)
import Text.Pandoc.Builder
import Text.Pandoc.Class.PandocMonad (PandocMonad, insertMedia, report)
import Text.Pandoc.Error
import Text.Pandoc.Logging
import Text.Pandoc.Options
import Text.Pandoc.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
showList :: [FB2State] -> ShowS
$cshowList :: [FB2State] -> ShowS
show :: FB2State -> String
$cshow :: FB2State -> String
showsPrec :: Int -> FB2State -> ShowS
$cshowsPrec :: Int -> FB2State -> ShowS
Show

instance Default FB2State where
  def :: FB2State
def = FB2State :: Int -> Meta -> [Text] -> Map Text Blocks -> FB2State
FB2State{ fb2SectionLevel :: Int
fb2SectionLevel = Int
1
                , fb2Meta :: Meta
fb2Meta = Meta
forall a. Monoid a => a
mempty
                , fb2Authors :: [Text]
fb2Authors = []
                , fb2Notes :: Map Text Blocks
fb2Notes = Map Text Blocks
forall k a. Map k a
M.empty
                }

instance HasMeta FB2State where
  setMeta :: Text -> b -> FB2State -> FB2State
setMeta Text
field b
v FB2State
s = FB2State
s {fb2Meta :: Meta
fb2Meta = Text -> b -> Meta -> Meta
forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
setMeta Text
field b
v (FB2State -> Meta
fb2Meta FB2State
s)}
  deleteMeta :: Text -> FB2State -> FB2State
deleteMeta Text
field FB2State
s = FB2State
s {fb2Meta :: Meta
fb2Meta = Text -> Meta -> Meta
forall a. HasMeta a => Text -> a -> a
deleteMeta Text
field (FB2State -> Meta
fb2Meta FB2State
s)}

readFB2 :: (PandocMonad m, ToSources a)
        => ReaderOptions
        -> a
        -> m Pandoc
readFB2 :: 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 e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError -> m Pandoc) -> PandocError -> m Pandoc
forall a b. (a -> b) -> a -> b
$ Text -> Text -> PandocError
PandocXMLError Text
"" Text
msg
    Right Element
el ->  do
      (Blocks
bs, FB2State
st) <- StateT FB2State m Blocks -> FB2State -> m (Blocks, FB2State)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (Element -> StateT FB2State m Blocks
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseRootElement Element
el) FB2State
forall a. Default a => a
def
      let authors :: Meta -> Meta
authors = if [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Text] -> Bool) -> [Text] -> Bool
forall a b. (a -> b) -> a -> b
$ FB2State -> [Text]
fb2Authors FB2State
st
                    then Meta -> Meta
forall a. a -> a
id
                    else Text -> [Inlines] -> Meta -> Meta
forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
setMeta Text
"author" ((Text -> Inlines) -> [Text] -> [Inlines]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Inlines
text ([Text] -> [Inlines]) -> [Text] -> [Inlines]
forall a b. (a -> b) -> a -> b
$ [Text] -> [Text]
forall a. [a] -> [a]
reverse ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ FB2State -> [Text]
fb2Authors FB2State
st)
      Pandoc -> m Pandoc
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pandoc -> m Pandoc) -> Pandoc -> m Pandoc
forall a b. (a -> b) -> a -> b
$ Meta -> [Block] -> Pandoc
Pandoc (Meta -> Meta
authors (Meta -> Meta) -> Meta -> Meta
forall a b. (a -> b) -> a -> b
$ FB2State -> Meta
fb2Meta FB2State
st) ([Block] -> Pandoc) -> [Block] -> Pandoc
forall a b. (a -> b) -> a -> b
$ Blocks -> [Block]
forall a. Many a -> [a]
toList Blocks
bs

-- * 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 -> (String -> Text) -> Maybe String -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> Text
T.toUpper Text
e) String -> Text
T.pack (Maybe String -> Text) -> Maybe String -> Text
forall a b. (a -> b) -> a -> b
$ String -> Maybe String
lookupEntity (Text -> String
T.unpack Text
e)

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

parseSubtitle :: PandocMonad m => Element -> FB2 m Blocks
parseSubtitle :: Element -> FB2 m Blocks
parseSubtitle Element
e = Attr -> Int -> Inlines -> Blocks
headerWith (Text
"", [Text
"unnumbered"], []) (Int -> Inlines -> Blocks)
-> StateT FB2State m Int -> StateT FB2State m (Inlines -> Blocks)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FB2State -> Int) -> StateT FB2State m Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets FB2State -> Int
fb2SectionLevel StateT FB2State m (Inlines -> Blocks)
-> StateT FB2State m Inlines -> FB2 m Blocks
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Element -> StateT FB2State m Inlines
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Inlines
parsePType Element
e

-- * Root element parser

parseRootElement :: PandocMonad m => Element -> FB2 m Blocks
parseRootElement :: 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 (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)
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 :: Element -> FB2 m ()
parseNotesBody Element
e = ()
forall a. Monoid a => a
mempty () -> StateT FB2State m [()] -> FB2 m ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Element -> FB2 m ()) -> [Element] -> StateT FB2State m [()]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Element -> FB2 m ()
forall (m :: * -> *). PandocMonad m => Element -> FB2 m ()
parseNotesBodyChild (Element -> [Element]
elChildren Element
e)

-- | Parse a child of @\<body name="notes">@ element.
parseNotesBodyChild :: PandocMonad m => Element -> FB2 m ()
parseNotesBodyChild :: 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 (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 :: 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 (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Just Text
sectionId -> do
      Blocks
content <- [Blocks] -> Blocks
forall a. Monoid a => [a] -> a
mconcat ([Blocks] -> Blocks)
-> StateT FB2State m [Blocks] -> StateT FB2State m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Element -> StateT FB2State m Blocks)
-> [Element] -> StateT FB2State m [Blocks]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Element -> StateT FB2State m Blocks
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseSectionChild ([Element] -> [Element]
dropTitle ([Element] -> [Element]) -> [Element] -> [Element]
forall a b. (a -> b) -> a -> b
$ Element -> [Element]
elChildren Element
e)
      Map Text Blocks
oldNotes <- (FB2State -> Map Text Blocks)
-> StateT FB2State m (Map Text Blocks)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets FB2State -> Map Text Blocks
fb2Notes
      (FB2State -> FB2State) -> FB2 m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((FB2State -> FB2State) -> FB2 m ())
-> (FB2State -> FB2State) -> FB2 m ()
forall a b. (a -> b) -> a -> b
$ \FB2State
s -> FB2State
s { fb2Notes :: Map Text Blocks
fb2Notes = Text -> Blocks -> Map Text Blocks -> Map Text Blocks
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (Text
"#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
sectionId) Blocks
content Map Text Blocks
oldNotes }
      () -> FB2 m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  where
    isTitle :: Element -> Bool
isTitle Element
x = QName -> 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 :: 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 (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 (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Element -> StateT FB2State m ())
-> [Element] -> StateT FB2State m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Element -> StateT FB2State m ()
forall (m :: * -> *). PandocMonad m => Element -> FB2 m ()
parseDescriptionChild (Element -> [Element]
elChildren Element
e)
    Text
"body" -> if Element -> Bool
isNotesBody Element
e
                then Blocks -> FB2 m Blocks
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
forall a. Monoid a => a
mempty
                else [Blocks] -> Blocks
forall a. Monoid a => [a] -> a
mconcat ([Blocks] -> Blocks) -> StateT FB2State m [Blocks] -> FB2 m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Element -> FB2 m Blocks)
-> [Element] -> StateT FB2State m [Blocks]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Element -> FB2 m Blocks
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseBodyChild (Element -> [Element]
elChildren Element
e)
    Text
"binary" -> Blocks
forall a. Monoid a => a
mempty Blocks -> StateT FB2State m () -> FB2 m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Element -> StateT FB2State m ()
forall (m :: * -> *). PandocMonad m => Element -> FB2 m ()
parseBinaryElement Element
e
    Text
name -> LogMessage -> StateT FB2State m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (Text -> Text -> LogMessage
UnexpectedXmlElement Text
name Text
"FictionBook") StateT FB2State m () -> Blocks -> FB2 m Blocks
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Blocks
forall a. Monoid a => a
mempty

-- | Parse a child of @\<description>@ element.
parseDescriptionChild :: PandocMonad m => Element -> FB2 m ()
parseDescriptionChild :: 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 (f :: * -> *) a. Applicative f => a -> f a
pure () -- ignore
    Text
"document-info" -> () -> FB2 m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Text
"publish-info" -> () -> FB2 m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Text
"custom-info" -> () -> FB2 m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Text
"output" -> () -> FB2 m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Text
name -> do
      LogMessage -> FB2 m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> FB2 m ()) -> LogMessage -> FB2 m ()
forall a b. (a -> b) -> a -> b
$ Text -> LogMessage
IgnoredElement (Text -> LogMessage) -> Text -> LogMessage
forall a b. (a -> b) -> a -> b
$ Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" in description"
      () -> FB2 m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
forall a. Monoid a => a
mempty

-- | Parse a child of @\<body>@ element.
parseBodyChild :: PandocMonad m => Element -> FB2 m Blocks
parseBodyChild :: Element -> FB2 m Blocks
parseBodyChild Element
e =
  case QName -> Text
qName (QName -> Text) -> QName -> Text
forall a b. (a -> b) -> a -> b
$ Element -> QName
elName Element
e of
    Text
"image" -> Element -> FB2 m Blocks
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseImageElement Element
e
    Text
"title" -> Int -> Inlines -> Blocks
header (Int -> Inlines -> Blocks)
-> StateT FB2State m Int -> StateT FB2State m (Inlines -> Blocks)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FB2State -> Int) -> StateT FB2State m Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets FB2State -> Int
fb2SectionLevel StateT FB2State m (Inlines -> Blocks)
-> StateT FB2State m Inlines -> FB2 m Blocks
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Content] -> StateT FB2State m Inlines
forall (m :: * -> *). PandocMonad m => [Content] -> FB2 m Inlines
parseTitleType (Element -> [Content]
elContent Element
e)
    Text
"epigraph" -> Element -> FB2 m Blocks
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseEpigraph Element
e
    Text
"section" -> Element -> FB2 m Blocks
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseSection Element
e
    Text
name -> LogMessage -> StateT FB2State m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (Text -> Text -> LogMessage
UnexpectedXmlElement Text
name Text
"body") StateT FB2State m () -> Blocks -> FB2 m Blocks
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Blocks
forall a. Monoid a => a
mempty

-- | Parse a @\<binary>@ element.
parseBinaryElement :: PandocMonad m => Element -> FB2 m ()
parseBinaryElement :: 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 :: Element -> FB2 m Text
parseAuthor Element
e = [Text] -> Text
T.unwords ([Text] -> Text)
-> ([Maybe Text] -> [Text]) -> [Maybe Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe Text] -> [Text]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Text] -> Text)
-> StateT FB2State m [Maybe Text] -> FB2 m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Element -> StateT FB2State m (Maybe Text))
-> [Element] -> StateT FB2State m [Maybe Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Element -> StateT FB2State m (Maybe Text)
forall (m :: * -> *).
PandocMonad m =>
Element -> FB2 m (Maybe Text)
parseAuthorChild (Element -> [Element]
elChildren Element
e)

parseAuthorChild :: PandocMonad m => Element -> FB2 m (Maybe Text)
parseAuthorChild :: Element -> FB2 m (Maybe Text)
parseAuthorChild Element
e =
  case 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 (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 (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 (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 (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 (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 (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 (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 :: Element -> FB2 m Blocks
parseTitle Element
e = Int -> Inlines -> Blocks
header (Int -> Inlines -> Blocks)
-> StateT FB2State m Int -> StateT FB2State m (Inlines -> Blocks)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FB2State -> Int) -> StateT FB2State m Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets FB2State -> Int
fb2SectionLevel StateT FB2State m (Inlines -> Blocks)
-> StateT FB2State m Inlines -> FB2 m Blocks
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Content] -> StateT FB2State m Inlines
forall (m :: * -> *). PandocMonad m => [Content] -> FB2 m Inlines
parseTitleType (Element -> [Content]
elContent Element
e)

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

parseTitleContent :: PandocMonad m => Content -> FB2 m (Maybe Inlines)
parseTitleContent :: Content -> FB2 m (Maybe Inlines)
parseTitleContent (Elem Element
e) =
  case QName -> Text
qName (QName -> Text) -> QName -> Text
forall a b. (a -> b) -> a -> b
$ Element -> QName
elName Element
e of
    Text
"p" -> Inlines -> Maybe Inlines
forall a. a -> Maybe a
Just (Inlines -> Maybe Inlines)
-> StateT FB2State m Inlines -> FB2 m (Maybe Inlines)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> StateT FB2State m Inlines
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Inlines
parsePType Element
e
    Text
"empty-line" -> Maybe Inlines -> FB2 m (Maybe Inlines)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Inlines -> FB2 m (Maybe Inlines))
-> Maybe Inlines -> FB2 m (Maybe Inlines)
forall a b. (a -> b) -> a -> b
$ Inlines -> Maybe Inlines
forall a. a -> Maybe a
Just Inlines
forall a. Monoid a => a
mempty
    Text
_ -> Maybe Inlines -> FB2 m (Maybe Inlines)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Inlines
forall a. Monoid a => a
mempty
parseTitleContent Content
_ = Maybe Inlines -> FB2 m (Maybe Inlines)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Inlines
forall a. Maybe a
Nothing

-- | Parse @imageType@
parseImageElement :: PandocMonad m => Element -> FB2 m Blocks
parseImageElement :: Element -> FB2 m Blocks
parseImageElement Element
e =
  case Maybe Text
href of
    Just Text
src -> Blocks -> FB2 m Blocks
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Blocks -> FB2 m Blocks) -> Blocks -> FB2 m Blocks
forall a b. (a -> b) -> a -> b
$ Inlines -> Blocks
para (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Text -> Inlines -> Inlines
imageWith (Text
imgId, [], []) (Text -> Text
removeHash Text
src) Text
title Inlines
alt
    Maybe Text
Nothing -> do
      LogMessage -> StateT FB2State m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> StateT FB2State m ())
-> LogMessage -> StateT FB2State m ()
forall a b. (a -> b) -> a -> b
$ Text -> LogMessage
IgnoredElement Text
" image without href"
      Blocks -> FB2 m Blocks
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
forall a. Monoid a => a
mempty
  where alt :: Inlines
alt = Inlines -> (Text -> Inlines) -> Maybe Text -> Inlines
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Inlines
forall a. Monoid a => a
mempty Text -> Inlines
str (Maybe Text -> Inlines) -> Maybe Text -> Inlines
forall a b. (a -> b) -> a -> b
$ QName -> Element -> Maybe Text
findAttr (Text -> QName
unqual Text
"alt") Element
e
        title :: Text
title = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ QName -> Element -> Maybe Text
findAttr (Text -> QName
unqual Text
"title") Element
e
        imgId :: Text
imgId = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ QName -> Element -> Maybe Text
findAttr (Text -> QName
unqual Text
"id") Element
e
        href :: Maybe Text
href = QName -> Element -> Maybe Text
findAttr (Text -> Maybe Text -> Maybe Text -> QName
QName Text
"href" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"http://www.w3.org/1999/xlink") Maybe Text
forall a. Maybe a
Nothing) Element
e

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

-- | Parse @citeType@
parseCite :: PandocMonad m => Element -> FB2 m Blocks
parseCite :: Element -> FB2 m Blocks
parseCite Element
e = Blocks -> Blocks
blockQuote (Blocks -> Blocks) -> ([Blocks] -> Blocks) -> [Blocks] -> Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Blocks] -> Blocks
forall a. Monoid a => [a] -> a
mconcat ([Blocks] -> Blocks) -> StateT FB2State m [Blocks] -> FB2 m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Element -> FB2 m Blocks)
-> [Element] -> StateT FB2State m [Blocks]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Element -> FB2 m Blocks
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseCiteChild (Element -> [Element]
elChildren Element
e)

-- | Parse @citeType@ child
parseCiteChild :: PandocMonad m => Element -> FB2 m Blocks
parseCiteChild :: Element -> FB2 m Blocks
parseCiteChild Element
e =
  case QName -> Text
qName (QName -> Text) -> QName -> Text
forall a b. (a -> b) -> a -> b
$ Element -> QName
elName Element
e of
    Text
"p" -> Inlines -> Blocks
para (Inlines -> Blocks) -> StateT FB2State m Inlines -> FB2 m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> StateT FB2State m Inlines
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Inlines
parsePType Element
e
    Text
"poem" -> Element -> FB2 m Blocks
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parsePoem Element
e
    Text
"empty-line" -> Blocks -> FB2 m Blocks
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
horizontalRule
    Text
"subtitle" -> Element -> FB2 m Blocks
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseSubtitle Element
e
    Text
"table" -> Element -> FB2 m Blocks
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseTable Element
e
    Text
"text-author" -> Inlines -> Blocks
para (Inlines -> Blocks) -> StateT FB2State m Inlines -> FB2 m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> StateT FB2State m Inlines
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Inlines
parsePType Element
e
    Text
name -> LogMessage -> StateT FB2State m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (Text -> Text -> LogMessage
UnexpectedXmlElement Text
name Text
"cite") StateT FB2State m () -> Blocks -> FB2 m Blocks
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Blocks
forall a. Monoid a => a
mempty

-- | Parse @poemType@
parsePoem :: PandocMonad m => Element -> FB2 m Blocks
parsePoem :: Element -> FB2 m Blocks
parsePoem Element
e = [Blocks] -> Blocks
forall a. Monoid a => [a] -> a
mconcat ([Blocks] -> Blocks) -> StateT FB2State m [Blocks] -> FB2 m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Element -> FB2 m Blocks)
-> [Element] -> StateT FB2State m [Blocks]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Element -> FB2 m Blocks
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parsePoemChild (Element -> [Element]
elChildren Element
e)

parsePoemChild :: PandocMonad m => Element -> FB2 m Blocks
parsePoemChild :: Element -> FB2 m Blocks
parsePoemChild Element
e =
  case QName -> Text
qName (QName -> Text) -> QName -> Text
forall a b. (a -> b) -> a -> b
$ Element -> QName
elName Element
e of
    Text
"title" -> Element -> FB2 m Blocks
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseTitle Element
e
    Text
"subtitle" -> Element -> FB2 m Blocks
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseSubtitle Element
e
    Text
"epigraph" -> Element -> FB2 m Blocks
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseEpigraph Element
e
    Text
"stanza" -> Element -> FB2 m Blocks
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseStanza Element
e
    Text
"text-author" -> Inlines -> Blocks
para (Inlines -> Blocks) -> StateT FB2State m Inlines -> FB2 m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> StateT FB2State m Inlines
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Inlines
parsePType Element
e
    Text
"date" -> Blocks -> FB2 m Blocks
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Blocks -> FB2 m Blocks) -> Blocks -> FB2 m Blocks
forall a b. (a -> b) -> a -> b
$ Inlines -> Blocks
para (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Text -> Inlines
text (Text -> Inlines) -> Text -> Inlines
forall a b. (a -> b) -> a -> b
$ Element -> Text
strContent Element
e
    Text
name -> LogMessage -> StateT FB2State m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (Text -> Text -> LogMessage
UnexpectedXmlElement Text
name Text
"poem") StateT FB2State m () -> Blocks -> FB2 m Blocks
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Blocks
forall a. Monoid a => a
mempty

parseStanza :: PandocMonad m => Element -> FB2 m Blocks
parseStanza :: Element -> FB2 m Blocks
parseStanza Element
e = [Block] -> Blocks
forall a. [a] -> Many a
fromList ([Block] -> Blocks) -> ([Blocks] -> [Block]) -> [Blocks] -> Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Block] -> [Block]
joinLineBlocks ([Block] -> [Block])
-> ([Blocks] -> [Block]) -> [Blocks] -> [Block]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Blocks -> [Block]
forall a. Many a -> [a]
toList (Blocks -> [Block]) -> ([Blocks] -> Blocks) -> [Blocks] -> [Block]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Blocks] -> Blocks
forall a. Monoid a => [a] -> a
mconcat ([Blocks] -> Blocks) -> StateT FB2State m [Blocks] -> FB2 m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Element -> FB2 m Blocks)
-> [Element] -> StateT FB2State m [Blocks]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Element -> FB2 m Blocks
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseStanzaChild (Element -> [Element]
elChildren Element
e)

joinLineBlocks :: [Block] -> [Block]
joinLineBlocks :: [Block] -> [Block]
joinLineBlocks (LineBlock [[Inline]]
xs:LineBlock [[Inline]]
ys:[Block]
zs) = [Block] -> [Block]
joinLineBlocks ([[Inline]] -> Block
LineBlock ([[Inline]]
xs [[Inline]] -> [[Inline]] -> [[Inline]]
forall a. [a] -> [a] -> [a]
++ [[Inline]]
ys) Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
zs)
joinLineBlocks (Block
x:[Block]
xs) = Block
xBlock -> [Block] -> [Block]
forall a. a -> [a] -> [a]
:[Block] -> [Block]
joinLineBlocks [Block]
xs
joinLineBlocks [] = []

parseStanzaChild :: PandocMonad m => Element -> FB2 m Blocks
parseStanzaChild :: Element -> FB2 m Blocks
parseStanzaChild Element
e =
  case QName -> Text
qName (QName -> Text) -> QName -> Text
forall a b. (a -> b) -> a -> b
$ Element -> QName
elName Element
e of
    Text
"title" -> Element -> FB2 m Blocks
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseTitle Element
e
    Text
"subtitle" -> Element -> FB2 m Blocks
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseSubtitle Element
e
    Text
"v" -> [Inlines] -> Blocks
lineBlock ([Inlines] -> Blocks)
-> (Inlines -> [Inlines]) -> Inlines -> Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Inlines -> [Inlines] -> [Inlines]
forall a. a -> [a] -> [a]
:[]) (Inlines -> Blocks) -> StateT FB2State m Inlines -> FB2 m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> StateT FB2State m Inlines
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Inlines
parsePType Element
e
    Text
name -> LogMessage -> StateT FB2State m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (Text -> Text -> LogMessage
UnexpectedXmlElement Text
name Text
"stanza") StateT FB2State m () -> Blocks -> FB2 m Blocks
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Blocks
forall a. Monoid a => a
mempty

-- | Parse @epigraphType@
parseEpigraph :: PandocMonad m => Element -> FB2 m Blocks
parseEpigraph :: Element -> FB2 m Blocks
parseEpigraph Element
e =
  Attr -> Blocks -> Blocks
divWith (Text
divId, [Text
"epigraph"], []) (Blocks -> Blocks) -> ([Blocks] -> Blocks) -> [Blocks] -> Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Blocks] -> Blocks
forall a. Monoid a => [a] -> a
mconcat ([Blocks] -> Blocks) -> StateT FB2State m [Blocks] -> FB2 m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Element -> FB2 m Blocks)
-> [Element] -> StateT FB2State m [Blocks]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Element -> FB2 m Blocks
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseEpigraphChild (Element -> [Element]
elChildren Element
e)
  where divId :: Text
divId = Text -> 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 :: Element -> FB2 m Blocks
parseEpigraphChild Element
e =
  case QName -> Text
qName (QName -> Text) -> QName -> Text
forall a b. (a -> b) -> a -> b
$ Element -> QName
elName Element
e of
    Text
"p" -> Inlines -> Blocks
para (Inlines -> Blocks) -> StateT FB2State m Inlines -> FB2 m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> StateT FB2State m Inlines
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Inlines
parsePType Element
e
    Text
"poem" -> Element -> FB2 m Blocks
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parsePoem Element
e
    Text
"cite" -> Element -> FB2 m Blocks
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseCite Element
e
    Text
"empty-line" -> Blocks -> FB2 m Blocks
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
horizontalRule
    Text
"text-author" -> Inlines -> Blocks
para (Inlines -> Blocks) -> StateT FB2State m Inlines -> FB2 m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> StateT FB2State m Inlines
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Inlines
parsePType Element
e
    Text
name -> LogMessage -> StateT FB2State m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (Text -> Text -> LogMessage
UnexpectedXmlElement Text
name Text
"epigraph") StateT FB2State m () -> Blocks -> FB2 m Blocks
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Blocks
forall a. Monoid a => a
mempty

-- | Parse @annotationType@
parseAnnotation :: PandocMonad m => Element -> FB2 m Blocks
parseAnnotation :: Element -> FB2 m Blocks
parseAnnotation Element
e = [Blocks] -> Blocks
forall a. Monoid a => [a] -> a
mconcat ([Blocks] -> Blocks) -> StateT FB2State m [Blocks] -> FB2 m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Element -> FB2 m Blocks)
-> [Element] -> StateT FB2State m [Blocks]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Element -> FB2 m Blocks
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseAnnotationChild (Element -> [Element]
elChildren Element
e)

parseAnnotationChild :: PandocMonad m => Element -> FB2 m Blocks
parseAnnotationChild :: Element -> FB2 m Blocks
parseAnnotationChild Element
e =
  case QName -> Text
qName (QName -> Text) -> QName -> Text
forall a b. (a -> b) -> a -> b
$ Element -> QName
elName Element
e of
    Text
"p" -> Inlines -> Blocks
para (Inlines -> Blocks) -> StateT FB2State m Inlines -> FB2 m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> StateT FB2State m Inlines
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Inlines
parsePType Element
e
    Text
"poem" -> Element -> FB2 m Blocks
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parsePoem Element
e
    Text
"cite" -> Element -> FB2 m Blocks
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseCite Element
e
    Text
"subtitle" -> Element -> FB2 m Blocks
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseSubtitle Element
e
    Text
"table" -> Element -> FB2 m Blocks
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseTable Element
e
    Text
"empty-line" -> Blocks -> FB2 m Blocks
forall (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 :: Element -> FB2 m Blocks
parseSection Element
e = do
  Int
n <- (FB2State -> Int) -> StateT FB2State m Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets FB2State -> Int
fb2SectionLevel
  (FB2State -> FB2State) -> StateT FB2State m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((FB2State -> FB2State) -> StateT FB2State m ())
-> (FB2State -> FB2State) -> StateT FB2State m ()
forall a b. (a -> b) -> a -> b
$ \FB2State
st -> FB2State
st{ fb2SectionLevel :: Int
fb2SectionLevel = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 }
  let sectionId :: Text
sectionId = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ QName -> Element -> Maybe Text
findAttr (Text -> QName
unqual Text
"id") Element
e
  Blocks
bs <- Attr -> Blocks -> Blocks
divWith (Text
sectionId, [Text
"section"], []) (Blocks -> Blocks) -> ([Blocks] -> Blocks) -> [Blocks] -> Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Blocks] -> Blocks
forall a. Monoid a => [a] -> a
mconcat ([Blocks] -> Blocks) -> StateT FB2State m [Blocks] -> FB2 m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Element -> FB2 m Blocks)
-> [Element] -> StateT FB2State m [Blocks]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Element -> FB2 m Blocks
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseSectionChild (Element -> [Element]
elChildren Element
e)
  (FB2State -> FB2State) -> StateT FB2State m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((FB2State -> FB2State) -> StateT FB2State m ())
-> (FB2State -> FB2State) -> StateT FB2State m ()
forall a b. (a -> b) -> a -> b
$ \FB2State
st -> FB2State
st{ fb2SectionLevel :: Int
fb2SectionLevel = Int
n }
  Blocks -> FB2 m Blocks
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
bs

parseSectionChild :: PandocMonad m => Element -> FB2 m Blocks
parseSectionChild :: Element -> FB2 m Blocks
parseSectionChild Element
e =
  case 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 (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
horizontalRule
    Text
"table" -> Element -> FB2 m Blocks
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseTable Element
e
    Text
"subtitle" -> Element -> FB2 m Blocks
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseSubtitle Element
e
    Text
"p" -> Inlines -> Blocks
para (Inlines -> Blocks) -> StateT FB2State m Inlines -> FB2 m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> StateT FB2State m Inlines
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Inlines
parsePType Element
e
    Text
"section" -> Element -> FB2 m Blocks
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseSection Element
e
    Text
name -> LogMessage -> StateT FB2State m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (Text -> Text -> LogMessage
UnexpectedXmlElement Text
name Text
"section") StateT FB2State m () -> Blocks -> FB2 m Blocks
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Blocks
forall a. Monoid a => a
mempty

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

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

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

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

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

-- | Parse @tableType@
parseTable :: PandocMonad m => Element -> FB2 m Blocks
parseTable :: Element -> FB2 m Blocks
parseTable Element
_ = Blocks -> FB2 m Blocks
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
forall a. Monoid a => a
mempty -- TODO: tables are not supported yet

-- | Parse @title-infoType@
parseTitleInfoChild :: PandocMonad m => Element -> FB2 m ()
parseTitleInfoChild :: Element -> FB2 m ()
parseTitleInfoChild Element
e =
  case QName -> Text
qName (Element -> QName
elName Element
e) of
    Text
"genre" -> () -> FB2 m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Text
"author" -> Element -> FB2 m Text
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Text
parseAuthor Element
e FB2 m Text -> (Text -> FB2 m ()) -> FB2 m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Text
author -> (FB2State -> FB2State) -> FB2 m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\FB2State
st -> FB2State
st {fb2Authors :: [Text]
fb2Authors = Text
authorText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:FB2State -> [Text]
fb2Authors FB2State
st})
    Text
"book-title" -> (FB2State -> FB2State) -> FB2 m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (Text -> Inlines -> FB2State -> FB2State
forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
setMeta Text
"title" (Text -> Inlines
text (Text -> Inlines) -> Text -> Inlines
forall a b. (a -> b) -> a -> b
$ 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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (FB2State -> FB2State) -> FB2 m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((FB2State -> FB2State) -> FB2 m ())
-> (Blocks -> FB2State -> FB2State) -> Blocks -> FB2 m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Blocks -> FB2State -> FB2State
forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
setMeta Text
"abstract"
    Text
"keywords" -> (FB2State -> FB2State) -> FB2 m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (Text -> [MetaValue] -> FB2State -> FB2State
forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
setMeta Text
"keywords" ((Text -> MetaValue) -> [Text] -> [MetaValue]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> MetaValue
MetaString (Text -> MetaValue) -> (Text -> Text) -> Text -> MetaValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
trim) ([Text] -> [MetaValue]) -> [Text] -> [MetaValue]
forall a b. (a -> b) -> a -> b
$ Text -> Text -> [Text]
T.splitOn Text
","
                                                                      (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Element -> Text
strContent Element
e))
    Text
"date" -> (FB2State -> FB2State) -> FB2 m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (Text -> Inlines -> FB2State -> FB2State
forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
setMeta Text
"date" (Text -> Inlines
text (Text -> Inlines) -> Text -> Inlines
forall a b. (a -> b) -> a -> b
$ Element -> Text
strContent Element
e))
    Text
"coverpage" -> Element -> FB2 m ()
forall (m :: * -> *). PandocMonad m => Element -> FB2 m ()
parseCoverPage Element
e
    Text
"lang" -> () -> FB2 m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Text
"src-lang" -> () -> FB2 m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Text
"translator" -> () -> FB2 m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Text
"sequence" -> () -> FB2 m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Text
name -> LogMessage -> FB2 m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> FB2 m ()) -> LogMessage -> FB2 m ()
forall a b. (a -> b) -> a -> b
$ Text -> LogMessage
IgnoredElement (Text -> LogMessage) -> Text -> LogMessage
forall a b. (a -> b) -> a -> b
$ Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" in title-info"

parseCoverPage :: PandocMonad m => Element -> FB2 m ()
parseCoverPage :: Element -> FB2 m ()
parseCoverPage Element
e =
  case QName -> Element -> Maybe Element
findChild (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
setMeta Text
"cover-image" (Text -> MetaValue
MetaString (Text -> MetaValue) -> Text -> MetaValue
forall a b. (a -> b) -> a -> b
$ Text -> Text
removeHash Text
src))
                  Maybe Text
Nothing -> () -> FB2 m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                where href :: Maybe Text
href = 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 (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | Parse @inlineImageType@ element
parseInlineImageElement :: PandocMonad m
                        => Element
                        -> FB2 m Inlines
parseInlineImageElement :: Element -> FB2 m Inlines
parseInlineImageElement Element
e =
  case Maybe Text
href of
    Just Text
src -> Inlines -> FB2 m Inlines
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inlines -> FB2 m Inlines) -> Inlines -> FB2 m Inlines
forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Text -> Inlines -> Inlines
imageWith (Text
"", [], []) (Text -> Text
removeHash Text
src) Text
"" Inlines
alt
    Maybe Text
Nothing -> do
      LogMessage -> StateT FB2State m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> StateT FB2State m ())
-> LogMessage -> StateT FB2State m ()
forall a b. (a -> b) -> a -> b
$ Text -> LogMessage
IgnoredElement Text
"inline image without href"
      Inlines -> FB2 m Inlines
forall (f :: * -> *) a. Applicative f => a -> f a
pure Inlines
forall a. Monoid a => a
mempty
  where alt :: Inlines
alt = Inlines -> (Text -> Inlines) -> Maybe Text -> Inlines
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Inlines
forall a. Monoid a => a
mempty Text -> Inlines
str (Maybe Text -> Inlines) -> Maybe Text -> Inlines
forall a b. (a -> b) -> a -> b
$ QName -> Element -> Maybe Text
findAttr (Text -> QName
unqual Text
"alt") Element
e
        href :: Maybe Text
href = QName -> Element -> Maybe Text
findAttr (Text -> Maybe Text -> Maybe Text -> QName
QName Text
"href" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"http://www.w3.org/1999/xlink") Maybe Text
forall a. Maybe a
Nothing) Element
e