{-# 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.Char8 ( pack )
import Data.ByteString.Base64.Lazy
import Data.Functor
import Data.List (intersperse)
import qualified Data.Map as M
import Data.Text (Text)
import qualified Data.Text as T
import Data.Default
import Data.Maybe
import Text.HTML.TagSoup.Entity (lookupEntity)
import Text.Pandoc.Builder
import Text.Pandoc.Class.PandocMonad (PandocMonad, insertMedia, report)
import Text.Pandoc.Error
import Text.Pandoc.Logging
import Text.Pandoc.Options
import Text.Pandoc.Shared (crFilter)
import Text.XML.Light

type FB2 m = StateT FB2State m

data FB2State = FB2State{ FB2State -> Int
fb2SectionLevel :: Int
                        , FB2State -> Meta
fb2Meta :: Meta
                        , FB2State -> [Text]
fb2Authors :: [Text]
                        , FB2State -> Map Text Blocks
fb2Notes :: M.Map Text Blocks
                        } deriving Int -> FB2State -> ShowS
[FB2State] -> ShowS
FB2State -> String
(Int -> FB2State -> ShowS)
-> (FB2State -> String) -> ([FB2State] -> ShowS) -> Show FB2State
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FB2State] -> ShowS
$cshowList :: [FB2State] -> ShowS
show :: FB2State -> String
$cshow :: FB2State -> String
showsPrec :: Int -> FB2State -> ShowS
$cshowsPrec :: Int -> FB2State -> ShowS
Show

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

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

readFB2 :: PandocMonad m => ReaderOptions -> Text -> m Pandoc
readFB2 :: ReaderOptions -> Text -> m Pandoc
readFB2 ReaderOptions
_ Text
inp =
  case Text -> Maybe Element
forall s. XmlSource s => s -> Maybe Element
parseXMLDoc (Text -> Maybe Element) -> Text -> Maybe Element
forall a b. (a -> b) -> a -> b
$ Text -> Text
crFilter Text
inp of
    Maybe Element
Nothing -> PandocError -> m Pandoc
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError -> m Pandoc) -> PandocError -> m Pandoc
forall a b. (a -> b) -> a -> b
$ Text -> PandocError
PandocParseError Text
"Not an XML document"
    Just Element
e ->  do
      (Blocks
bs, FB2State
st) <- StateT FB2State m Blocks -> FB2State -> m (Blocks, FB2State)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (Element -> StateT FB2State m Blocks
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseRootElement Element
e) FB2State
forall a. Default a => a
def
      let authors :: Meta -> Meta
authors = if [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Text] -> Bool) -> [Text] -> Bool
forall a b. (a -> b) -> a -> b
$ FB2State -> [Text]
fb2Authors FB2State
st
                    then Meta -> Meta
forall a. a -> a
id
                    else Text -> [Inlines] -> Meta -> Meta
forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
setMeta Text
"author" ((Text -> Inlines) -> [Text] -> [Inlines]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Inlines
text ([Text] -> [Inlines]) -> [Text] -> [Inlines]
forall a b. (a -> b) -> a -> b
$ [Text] -> [Text]
forall a. [a] -> [a]
reverse ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ FB2State -> [Text]
fb2Authors FB2State
st)
      Pandoc -> m Pandoc
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pandoc -> m Pandoc) -> Pandoc -> m Pandoc
forall a b. (a -> b) -> a -> b
$ Meta -> [Block] -> Pandoc
Pandoc (Meta -> Meta
authors (Meta -> Meta) -> Meta -> Meta
forall a b. (a -> b) -> a -> b
$ FB2State -> Meta
fb2Meta FB2State
st) ([Block] -> Pandoc) -> [Block] -> Pandoc
forall a b. (a -> b) -> a -> b
$ Blocks -> [Block]
forall a. Many a -> [a]
toList Blocks
bs

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

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

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

-- * Root element parser

parseRootElement :: PandocMonad m => Element -> FB2 m Blocks
parseRootElement :: Element -> FB2 m Blocks
parseRootElement Element
e =
  case String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ QName -> String
qName (QName -> String) -> QName -> String
forall a b. (a -> b) -> a -> b
$ Element -> QName
elName Element
e of
    Text
"FictionBook" -> do
      -- 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 -> String
qName (QName -> String) -> QName -> String
forall a b. (a -> b) -> a -> b
$ Element -> QName
elName Element
e of
    String
"section" -> Element -> FB2 m ()
forall (m :: * -> *). PandocMonad m => Element -> FB2 m ()
parseNote Element
e
    String
_ -> () -> FB2 m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

isNotesBody :: Element -> Bool
isNotesBody :: Element -> Bool
isNotesBody Element
e =
  QName -> String
qName (Element -> QName
elName Element
e) String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"body" Bool -> Bool -> Bool
&&
  QName -> Element -> Maybe String
findAttr (String -> QName
unqual String
"name") Element
e Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Maybe String
forall a. a -> Maybe a
Just String
"notes"

parseNote :: PandocMonad m => Element -> FB2 m ()
parseNote :: Element -> FB2 m ()
parseNote Element
e =
  case QName -> Element -> Maybe String
findAttr (String -> QName
unqual String
"id") Element
e of
    Maybe String
Nothing -> () -> FB2 m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Just String
sectionId -> do
      Blocks
content <- [Blocks] -> Blocks
forall a. Monoid a => [a] -> a
mconcat ([Blocks] -> Blocks)
-> StateT FB2State m [Blocks] -> StateT FB2State m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Element -> StateT FB2State m Blocks)
-> [Element] -> StateT FB2State m [Blocks]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Element -> StateT FB2State m Blocks
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseSectionChild ([Element] -> [Element]
dropTitle ([Element] -> [Element]) -> [Element] -> [Element]
forall a b. (a -> b) -> a -> b
$ Element -> [Element]
elChildren Element
e)
      Map Text Blocks
oldNotes <- (FB2State -> Map Text Blocks)
-> StateT FB2State m (Map Text Blocks)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets FB2State -> Map Text Blocks
fb2Notes
      (FB2State -> FB2State) -> FB2 m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((FB2State -> FB2State) -> FB2 m ())
-> (FB2State -> FB2State) -> FB2 m ()
forall a b. (a -> b) -> a -> b
$ \FB2State
s -> FB2State
s { fb2Notes :: Map Text Blocks
fb2Notes = Text -> Blocks -> Map Text Blocks -> Map Text Blocks
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (Text
"#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
sectionId) Blocks
content Map Text Blocks
oldNotes }
      () -> FB2 m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  where
    isTitle :: Element -> Bool
isTitle Element
x = QName -> String
qName (Element -> QName
elName Element
x) String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"title"
    dropTitle :: [Element] -> [Element]
dropTitle (Element
x:[Element]
xs) = if Element -> Bool
isTitle Element
x
                         then [Element]
xs -- 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 String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ QName -> String
qName (QName -> String) -> QName -> String
forall a b. (a -> b) -> a -> b
$ Element -> QName
elName Element
e of
    Text
"stylesheet" -> Blocks -> FB2 m Blocks
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
forall a. Monoid a => a
mempty -- 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 String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ QName -> String
qName (QName -> String) -> QName -> String
forall a b. (a -> b) -> a -> b
$ Element -> QName
elName Element
e of
    Text
"title-info" -> (Element -> FB2 m ()) -> [Element] -> FB2 m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Element -> FB2 m ()
forall (m :: * -> *). PandocMonad m => Element -> FB2 m ()
parseTitleInfoChild (Element -> [Element]
elChildren Element
e)
    Text
"src-title-info" -> () -> FB2 m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure () -- 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 String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ QName -> String
qName (QName -> String) -> QName -> String
forall a b. (a -> b) -> a -> b
$ Element -> QName
elName Element
e of
    Text
"image" -> Element -> FB2 m Blocks
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseImageElement Element
e
    Text
"title" -> Int -> Inlines -> Blocks
header (Int -> Inlines -> Blocks)
-> StateT FB2State m Int -> StateT FB2State m (Inlines -> Blocks)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FB2State -> Int) -> StateT FB2State m Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets FB2State -> Int
fb2SectionLevel StateT FB2State m (Inlines -> Blocks)
-> StateT FB2State m Inlines -> FB2 m Blocks
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Content] -> StateT FB2State m Inlines
forall (m :: * -> *). PandocMonad m => [Content] -> FB2 m Inlines
parseTitleType (Element -> [Content]
elContent Element
e)
    Text
"epigraph" -> Element -> FB2 m Blocks
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseEpigraph Element
e
    Text
"section" -> Element -> FB2 m Blocks
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseSection Element
e
    Text
name -> LogMessage -> StateT FB2State m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (Text -> Text -> LogMessage
UnexpectedXmlElement Text
name Text
"body") StateT FB2State m () -> Blocks -> FB2 m Blocks
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Blocks
forall a. Monoid a => a
mempty

-- | Parse a @\<binary>@ element.
parseBinaryElement :: PandocMonad m => Element -> FB2 m ()
parseBinaryElement :: Element -> FB2 m ()
parseBinaryElement Element
e =
  case (QName -> Element -> Maybe String
findAttr (String -> QName
unqual String
"id") Element
e, QName -> Element -> Maybe String
findAttr (String -> QName
unqual String
"content-type") Element
e) of
    (Maybe String
Nothing, Maybe String
_) -> LogMessage -> FB2 m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> FB2 m ()) -> LogMessage -> FB2 m ()
forall a b. (a -> b) -> a -> b
$ Text -> LogMessage
IgnoredElement Text
"binary without id attribute"
    (Just String
_, Maybe String
Nothing) ->
      LogMessage -> FB2 m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> FB2 m ()) -> LogMessage -> FB2 m ()
forall a b. (a -> b) -> a -> b
$ Text -> LogMessage
IgnoredElement Text
"binary without content-type attribute"
    (Just String
filename, Maybe String
contentType) -> String -> Maybe Text -> ByteString -> FB2 m ()
forall (m :: * -> *).
PandocMonad m =>
String -> Maybe Text -> ByteString -> m ()
insertMedia String
filename (String -> Text
T.pack (String -> Text) -> Maybe String -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String
contentType) (ByteString -> ByteString
decodeLenient (String -> ByteString
pack (Element -> String
strContent Element
e)))

-- * 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 String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ QName -> String
qName (QName -> String) -> QName -> String
forall a b. (a -> b) -> a -> b
$ Element -> QName
elName Element
e of
    Text
"first-name" -> Maybe Text -> FB2 m (Maybe Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Text -> FB2 m (Maybe Text))
-> Maybe Text -> FB2 m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Element -> String
strContent Element
e
    Text
"middle-name" -> Maybe Text -> FB2 m (Maybe Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Text -> FB2 m (Maybe Text))
-> Maybe Text -> FB2 m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Element -> String
strContent Element
e
    Text
"last-name" -> Maybe Text -> FB2 m (Maybe Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Text -> FB2 m (Maybe Text))
-> Maybe Text -> FB2 m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Element -> String
strContent Element
e
    Text
"nickname" -> Maybe Text -> FB2 m (Maybe Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Text -> FB2 m (Maybe Text))
-> Maybe Text -> FB2 m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Element -> String
strContent Element
e
    Text
"home-page" -> Maybe Text -> FB2 m (Maybe Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Text -> FB2 m (Maybe Text))
-> Maybe Text -> FB2 m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Element -> String
strContent Element
e
    Text
"email" -> Maybe Text -> FB2 m (Maybe Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Text -> FB2 m (Maybe Text))
-> Maybe Text -> FB2 m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Element -> String
strContent Element
e
    Text
name -> do
      LogMessage -> StateT FB2State m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> StateT FB2State m ())
-> LogMessage -> StateT FB2State m ()
forall a b. (a -> b) -> a -> b
$ Text -> LogMessage
IgnoredElement (Text -> LogMessage) -> Text -> LogMessage
forall a b. (a -> b) -> a -> b
$ Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" in author"
      Maybe Text -> FB2 m (Maybe Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Text
forall a. Maybe a
Nothing

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

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

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

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

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

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

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

-- | 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 -> (String -> Text) -> Maybe String -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" String -> Text
T.pack (Maybe String -> Text) -> Maybe String -> Text
forall a b. (a -> b) -> a -> b
$ QName -> Element -> Maybe String
findAttr (String -> QName
unqual String
"id") Element
e

parseEpigraphChild :: PandocMonad m => Element -> FB2 m Blocks
parseEpigraphChild :: Element -> FB2 m Blocks
parseEpigraphChild Element
e =
  case String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ QName -> String
qName (QName -> String) -> QName -> String
forall a b. (a -> b) -> a -> b
$ Element -> QName
elName Element
e of
    Text
"p" -> Inlines -> Blocks
para (Inlines -> Blocks) -> StateT FB2State m Inlines -> FB2 m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> StateT FB2State m Inlines
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Inlines
parsePType Element
e
    Text
"poem" -> Element -> FB2 m Blocks
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parsePoem Element
e
    Text
"cite" -> Element -> FB2 m Blocks
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseCite Element
e
    Text
"empty-line" -> Blocks -> FB2 m Blocks
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
horizontalRule
    Text
"text-author" -> Inlines -> Blocks
para (Inlines -> Blocks) -> StateT FB2State m Inlines -> FB2 m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> StateT FB2State m Inlines
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Inlines
parsePType Element
e
    Text
name -> LogMessage -> StateT FB2State m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (Text -> Text -> LogMessage
UnexpectedXmlElement Text
name Text
"epigraph") StateT FB2State m () -> Blocks -> FB2 m Blocks
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Blocks
forall a. Monoid a => a
mempty

-- | 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 String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ QName -> String
qName (QName -> String) -> QName -> String
forall a b. (a -> b) -> a -> b
$ Element -> QName
elName Element
e of
    Text
"p" -> Inlines -> Blocks
para (Inlines -> Blocks) -> StateT FB2State m Inlines -> FB2 m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> StateT FB2State m Inlines
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Inlines
parsePType Element
e
    Text
"poem" -> Element -> FB2 m Blocks
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parsePoem Element
e
    Text
"cite" -> Element -> FB2 m Blocks
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseCite Element
e
    Text
"subtitle" -> Element -> FB2 m Blocks
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseSubtitle Element
e
    Text
"table" -> Element -> FB2 m Blocks
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseTable Element
e
    Text
"empty-line" -> Blocks -> FB2 m Blocks
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
horizontalRule
    Text
name -> LogMessage -> StateT FB2State m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (Text -> Text -> LogMessage
UnexpectedXmlElement Text
name Text
"annotation") StateT FB2State m () -> Blocks -> FB2 m Blocks
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Blocks
forall a. Monoid a => a
mempty

-- | 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 -> (String -> Text) -> Maybe String -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" String -> Text
T.pack (Maybe String -> Text) -> Maybe String -> Text
forall a b. (a -> b) -> a -> b
$ QName -> Element -> Maybe String
findAttr (String -> QName
unqual String
"id") Element
e
  Blocks
bs <- Attr -> Blocks -> Blocks
divWith (Text
sectionId, [Text
"section"], []) (Blocks -> Blocks) -> ([Blocks] -> Blocks) -> [Blocks] -> Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Blocks] -> Blocks
forall a. Monoid a => [a] -> a
mconcat ([Blocks] -> Blocks) -> StateT FB2State m [Blocks] -> FB2 m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Element -> FB2 m Blocks)
-> [Element] -> StateT FB2State m [Blocks]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Element -> FB2 m Blocks
forall (m :: * -> *). PandocMonad m => Element -> FB2 m Blocks
parseSectionChild (Element -> [Element]
elChildren Element
e)
  (FB2State -> FB2State) -> StateT FB2State m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((FB2State -> FB2State) -> StateT FB2State m ())
-> (FB2State -> FB2State) -> StateT FB2State m ()
forall a b. (a -> b) -> a -> b
$ \FB2State
st -> FB2State
st{ fb2SectionLevel :: Int
fb2SectionLevel = Int
n }
  Blocks -> FB2 m Blocks
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
bs

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

-- | 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))
-> (String -> Text) -> String -> (Text, Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> (Text, Text)) -> Maybe String -> Maybe (Text, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QName -> Element -> Maybe String
findAttr (String -> Maybe String -> Maybe String -> QName
QName String
"lang" Maybe String
forall a. Maybe a
Nothing (String -> Maybe String
forall a. a -> Maybe a
Just String
"xml")) Element
e
  case QName -> Element -> Maybe String
findAttr (String -> QName
unqual String
"name") Element
e of
    Just String
name -> Inlines -> FB2 m Inlines
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inlines -> FB2 m Inlines) -> Inlines -> FB2 m Inlines
forall a b. (a -> b) -> a -> b
$ Attr -> Inlines -> Inlines
spanWith (Text
"", [String -> Text
T.pack String
name], [(Text, Text)]
lang) Inlines
content
    Maybe String
Nothing -> do
      LogMessage -> StateT FB2State m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> StateT FB2State m ())
-> LogMessage -> StateT FB2State m ()
forall a b. (a -> b) -> a -> b
$ Text -> LogMessage
IgnoredElement Text
"link without required name"
      Inlines -> FB2 m Inlines
forall (f :: * -> *) a. Applicative f => a -> f a
pure Inlines
forall a. Monoid a => a
mempty

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

-- | 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 String -> Text
T.pack (String -> Text) -> Maybe String -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QName -> Element -> Maybe String
findAttr (String -> Maybe String -> Maybe String -> QName
QName String
"href" (String -> Maybe String
forall a. a -> Maybe a
Just String
"http://www.w3.org/1999/xlink") Maybe String
forall a. Maybe a
Nothing) Element
e of
    Just Text
href -> case QName -> Element -> Maybe String
findAttr (String -> Maybe String -> Maybe String -> QName
QName String
"type" Maybe String
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing) Element
e of
                   Just String
"note" -> case Text -> Map Text Blocks -> Maybe Blocks
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
href Map Text Blocks
notes of
                                    Maybe Blocks
Nothing -> Inlines -> FB2 m Inlines
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inlines -> FB2 m Inlines) -> Inlines -> FB2 m Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Inlines -> Inlines
link Text
href Text
"" Inlines
content
                                    Just Blocks
contents -> Inlines -> FB2 m Inlines
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inlines -> FB2 m Inlines) -> Inlines -> FB2 m Inlines
forall a b. (a -> b) -> a -> b
$ Blocks -> Inlines
note Blocks
contents
                   Maybe String
_ -> Inlines -> FB2 m Inlines
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inlines -> FB2 m Inlines) -> Inlines -> FB2 m Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Inlines -> Inlines
link Text
href Text
"" Inlines
content
    Maybe Text
Nothing -> do
      LogMessage -> StateT FB2State m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> StateT FB2State m ())
-> LogMessage -> StateT FB2State m ()
forall a b. (a -> b) -> a -> b
$ Text -> LogMessage
IgnoredElement Text
"link without required href"
      Inlines -> FB2 m Inlines
forall (f :: * -> *) a. Applicative f => a -> f a
pure Inlines
forall a. Monoid a => a
mempty

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

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

parseCoverPage :: PandocMonad m => Element -> FB2 m ()
parseCoverPage :: Element -> FB2 m ()
parseCoverPage Element
e =
  case QName -> Element -> Maybe Element
findChild (String -> Maybe String -> Maybe String -> QName
QName String
"image" (String -> Maybe String
forall a. a -> Maybe a
Just String
"http://www.gribuser.ru/xml/fictionbook/2.0") Maybe String
forall a. Maybe a
Nothing) Element
e of
    Just Element
img -> case Maybe Text
href of
                  Just Text
src -> (FB2State -> FB2State) -> FB2 m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (Text -> MetaValue -> FB2State -> FB2State
forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
setMeta Text
"cover-image" (Text -> MetaValue
MetaString (Text -> MetaValue) -> Text -> MetaValue
forall a b. (a -> b) -> a -> b
$ Text -> Text
removeHash Text
src))
                  Maybe Text
Nothing -> () -> FB2 m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                where href :: Maybe Text
href = String -> Text
T.pack (String -> Text) -> Maybe String -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QName -> Element -> Maybe String
findAttr (String -> Maybe String -> Maybe String -> QName
QName String
"href" (String -> Maybe String
forall a. a -> Maybe a
Just String
"http://www.w3.org/1999/xlink") Maybe String
forall a. Maybe a
Nothing) Element
img
    Maybe Element
Nothing -> () -> FB2 m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | 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 -> (String -> Inlines) -> Maybe String -> Inlines
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Inlines
forall a. Monoid a => a
mempty (Text -> Inlines
str (Text -> Inlines) -> (String -> Text) -> String -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack) (Maybe String -> Inlines) -> Maybe String -> Inlines
forall a b. (a -> b) -> a -> b
$ QName -> Element -> Maybe String
findAttr (String -> QName
unqual String
"alt") Element
e
        href :: Maybe Text
href = String -> Text
T.pack (String -> Text) -> Maybe String -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QName -> Element -> Maybe String
findAttr (String -> Maybe String -> Maybe String -> QName
QName String
"href" (String -> Maybe String
forall a. a -> Maybe a
Just String
"http://www.w3.org/1999/xlink") Maybe String
forall a. Maybe a
Nothing) Element
e