    {-# LANGUAGE PatternGuards     #-}
    {-# LANGUAGE OverloadedStrings #-}
    {- |
    Module      : Text.Pandoc.Writers.FB2
    Copyright   : Copyright (C) 2011-2012 Sergey Astanin
                                2012-2024 John MacFarlane
    License     : GNU GPL, version 2 or above

    Maintainer  : John MacFarlane
    Stability   : alpha
    Portability : portable

    Conversion of 'Pandoc' documents to FB2 (FictionBook2) format.

    FictionBook is an XML-based e-book format. For more information see:
    <http://www.fictionbook.org/index.php/Eng:XML_Schema_Fictionbook_2.1>

    -}
    module Text.Pandoc.Writers.FB2 (writeFB2)  where

    import Control.Monad (zipWithM, liftM)
    import Control.Monad.Except (catchError, throwError)
    import Control.Monad.State.Strict (StateT, evalStateT, get, gets, lift, modify)
    import Data.ByteString.Base64 (encode)
    import Data.Char (isAscii, isControl, isSpace)
    import Data.Either (lefts, rights)
    import Data.List (intercalate)
    import Data.Text (Text)
    import qualified Data.Text as T
    import qualified Data.Text.Lazy as TL
    import qualified Data.Text.Encoding as TE
    import Text.Pandoc.URI (urlEncode, isURI)
    import Text.Pandoc.XML.Light as X
    import Text.Pandoc.Class.PandocMonad (PandocMonad, report)
    import qualified Text.Pandoc.Class.PandocMonad as P
    import Text.Pandoc.Definition
    import Text.Pandoc.Error (PandocError(..))
    import Text.Pandoc.Logging
    import Text.Pandoc.Options (HTMLMathMethod (..), WriterOptions (..), def)
    import Text.Pandoc.Shared (blocksToInlines, capitalize, orderedListMarkers,
                               makeSections, tshow, stringify)
    import Text.Pandoc.Walk (walk)
    import Text.Pandoc.Writers.Shared (lookupMetaString, toLegacyTable,
                                       ensureValidXmlIdentifiers)
    import Data.Generics (everywhere, mkT)

    -- | Data to be written at the end of the document:
    -- (foot)notes, URLs, references, images.
    data FbRenderState = FbRenderState
        { FbRenderState -> [(Int, Text, [Content])]
    footnotes         :: [ (Int, Text, [Content]) ]  -- ^ #, ID, text
        , FbRenderState -> [(Text, Text)]
    imagesToFetch     :: [ (Text, Text) ]  -- ^ filename, URL or path
        , FbRenderState -> Text
    parentListMarker  :: Text  -- ^ list marker of the parent ordered list
        , FbRenderState -> WriterOptions
    writerOptions     :: WriterOptions
        } deriving (Int -> FbRenderState -> ShowS
    [FbRenderState] -> ShowS
    FbRenderState -> String
    (Int -> FbRenderState -> ShowS)
    -> (FbRenderState -> String)
    -> ([FbRenderState] -> ShowS)
    -> Show FbRenderState
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> FbRenderState -> ShowS
    showsPrec :: Int -> FbRenderState -> ShowS
    $cshow :: FbRenderState -> String
    show :: FbRenderState -> String
    $cshowList :: [FbRenderState] -> ShowS
    showList :: [FbRenderState] -> ShowS
    Show)

    -- | FictionBook building monad.
    type FBM m = StateT FbRenderState m

    newFB :: FbRenderState
    newFB :: FbRenderState
    newFB = FbRenderState { footnotes :: [(Int, Text, [Content])]
    footnotes = [], imagesToFetch :: [(Text, Text)]
    imagesToFetch = []
                          , parentListMarker :: Text
    parentListMarker = Text
    ""
                          , writerOptions :: WriterOptions
    writerOptions = WriterOptions
    forall a. Default a => a
    def }

    data ImageMode = NormalImage | InlineImage deriving (ImageMode -> ImageMode -> Bool
    (ImageMode -> ImageMode -> Bool)
    -> (ImageMode -> ImageMode -> Bool) -> Eq ImageMode
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: ImageMode -> ImageMode -> Bool
    == :: ImageMode -> ImageMode -> Bool
    $c/= :: ImageMode -> ImageMode -> Bool
    /= :: ImageMode -> ImageMode -> Bool
    Eq)
    instance Show ImageMode where
        show :: ImageMode -> String
    show ImageMode
    NormalImage = String
    "imageType"
        show ImageMode
    InlineImage = String
    "inlineImageType"

    -- | Produce an FB2 document from a 'Pandoc' document.
    writeFB2 :: PandocMonad m
             => WriterOptions    -- ^ conversion options
             -> Pandoc           -- ^ document to convert
             -> m Text           -- ^ FictionBook2 document (not encoded yet)
    writeFB2 :: forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> Pandoc -> m Text
    writeFB2 WriterOptions
    opts Pandoc
    doc = (StateT FbRenderState m Text -> FbRenderState -> m Text)
    -> FbRenderState -> StateT FbRenderState m Text -> m Text
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip StateT FbRenderState m Text -> FbRenderState -> m Text
    forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
    evalStateT FbRenderState
    newFB (StateT FbRenderState m Text -> m Text)
    -> StateT FbRenderState m Text -> m Text
    forall a b. (a -> b) -> a -> b
    $ WriterOptions -> Pandoc -> StateT FbRenderState m Text
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> Pandoc -> FBM m Text
    pandocToFB2 WriterOptions
    opts Pandoc
    doc

    pandocToFB2 :: PandocMonad m
                => WriterOptions
                -> Pandoc
                -> FBM m Text
    pandocToFB2 :: forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> Pandoc -> FBM m Text
    pandocToFB2 WriterOptions
    opts Pandoc
    doc = do
         let Pandoc Meta
    meta [Block]
    blocks = Pandoc -> Pandoc
    ensureValidXmlIdentifiers Pandoc
    doc
         (FbRenderState -> FbRenderState) -> StateT FbRenderState m ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify (\FbRenderState
    s -> FbRenderState
    s { writerOptions = opts })
         desc <- Meta -> FBM m Content
    forall (m :: * -> *). PandocMonad m => Meta -> FBM m Content
    description Meta
    meta
         title <- cMapM toXml . docTitle $ meta
         secs <- renderSections 1 blocks
         let body = Text -> [Content] -> Content
    forall t. Node t => Text -> t -> Content
    el Text
    "body" ([Content] -> Content) -> [Content] -> Content
    forall a b. (a -> b) -> a -> b
    $ Text -> Content -> Content
    forall t. Node t => Text -> t -> Content
    el Text
    "title" (Text -> [Content] -> Content
    forall t. Node t => Text -> t -> Content
    el Text
    "p" [Content]
    title) Content -> [Content] -> [Content]
    forall a. a -> [a] -> [a]
    : [Content]
    secs
         notes <- renderFootnotes
         (imgs,missing) <- get >>= (lift . fetchImages . imagesToFetch)
         let body' = [Text] -> Content -> Content
    replaceImagesWithAlt [Text]
    missing Content
    body
         let fb2_xml = Text -> ([Attr], [Content]) -> Content
    forall t. Node t => Text -> t -> Content
    el Text
    "FictionBook" ([Attr]
    fb2_attrs, [Content
    desc, Content
    body'] [Content] -> [Content] -> [Content]
    forall a. [a] -> [a] -> [a]
    ++ [Content]
    notes [Content] -> [Content] -> [Content]
    forall a. [a] -> [a] -> [a]
    ++ [Content]
    imgs)
         return $ xml_head <> showContent fb2_xml <> "\n"
      where
      xml_head :: Text
    xml_head = Text
    "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n"
      fb2_attrs :: [Attr]
    fb2_attrs =
          let xmlns :: Text
    xmlns = Text
    "http://www.gribuser.ru/xml/fictionbook/2.0"
              xlink :: Text
    xlink = Text
    "http://www.w3.org/1999/xlink"
          in  [ Text -> Text -> Attr
    uattr Text
    "xmlns" Text
    xmlns
              , (Text, Text) -> Text -> Attr
    attr (Text
    "xmlns", Text
    "l") Text
    xlink ]

    description :: PandocMonad m => Meta -> FBM m Content
    description :: forall (m :: * -> *). PandocMonad m => Meta -> FBM m Content
    description Meta
    meta' = do
      let genre :: Content
    genre = case Text -> Meta -> Text
    lookupMetaString Text
    "genre" Meta
    meta' of
                    Text
    "" -> Text -> Text -> Content
    forall t. Node t => Text -> t -> Content
    el Text
    "genre" (Text
    "unrecognised" :: Text)
                    Text
    s  -> Text -> Text -> Content
    forall t. Node t => Text -> t -> Content
    el Text
    "genre" Text
    s
      bt <- Meta -> FBM m [Content]
    forall (m :: * -> *). PandocMonad m => Meta -> FBM m [Content]
    booktitle Meta
    meta'
      let as = Meta -> [Content]
    authors Meta
    meta'
      dd <- docdate meta'
      annotation <- case lookupMeta "abstract" meta' of
                      Just (MetaBlocks [Block]
    bs) -> Content -> [Content]
    forall a. a -> [a]
    list (Content -> [Content])
    -> ([Content] -> Content) -> [Content] -> [Content]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> [Content] -> Content
    forall t. Node t => Text -> t -> Content
    el Text
    "annotation" ([Content] -> [Content]) -> FBM m [Content] -> FBM m [Content]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Block -> FBM m [Content]) -> [Block] -> FBM m [Content]
    forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
    cMapM Block -> FBM m [Content]
    forall (m :: * -> *). PandocMonad m => Block -> FBM m [Content]
    blockToXml ((Block -> Block) -> [Block] -> [Block]
    forall a b. (a -> b) -> [a] -> [b]
    map Block -> Block
    unPlain [Block]
    bs)
                      Maybe MetaValue
    _ -> [Content] -> FBM m [Content]
    forall a. a -> StateT FbRenderState m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure [Content]
    forall a. Monoid a => a
    mempty
      let lang = case Text -> Meta -> Maybe MetaValue
    lookupMeta Text
    "lang" Meta
    meta' of
                   Just (MetaInlines [Str Text
    s]) -> [Text -> Text -> Content
    forall t. Node t => Text -> t -> Content
    el Text
    "lang" (Text -> Content) -> Text -> Content
    forall a b. (a -> b) -> a -> b
    $ Text -> Text
    iso639 Text
    s]
                   Just (MetaString Text
    s)        -> [Text -> Text -> Content
    forall t. Node t => Text -> t -> Content
    el Text
    "lang" (Text -> Content) -> Text -> Content
    forall a b. (a -> b) -> a -> b
    $ Text -> Text
    iso639 Text
    s]
                   Maybe MetaValue
    _                          -> []
                 where iso639 :: Text -> Text
    iso639 = (Char -> Bool) -> Text -> Text
    T.takeWhile (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    '-') -- Convert BCP 47 to ISO 639
      let coverimage Text
    url = do
            let img :: Inline
    img = Attr -> [Inline] -> (Text, Text) -> Inline
    Image Attr
    nullAttr [Inline]
    forall a. Monoid a => a
    mempty (Text
    url, Text
    "")
            im <- ImageMode -> Inline -> StateT FbRenderState m [Content]
    forall (m :: * -> *).
    PandocMonad m =>
    ImageMode -> Inline -> FBM m [Content]
    insertImage ImageMode
    InlineImage Inline
    img
            return [el "coverpage" im]
      coverpage <- case lookupMeta "cover-image" meta' of
                        Just (MetaInlines [Inline]
    ils) -> Text -> FBM m [Content]
    forall {m :: * -> *}.
    PandocMonad m =>
    Text -> StateT FbRenderState m [Content]
    coverimage ([Inline] -> Text
    forall a. Walkable Inline a => a -> Text
    stringify [Inline]
    ils)
                        Just (MetaString Text
    s) -> Text -> FBM m [Content]
    forall {m :: * -> *}.
    PandocMonad m =>
    Text -> StateT FbRenderState m [Content]
    coverimage Text
    s
                        Maybe MetaValue
    _       -> [Content] -> FBM m [Content]
    forall a. a -> StateT FbRenderState m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
      return $ el "description"
        [ el "title-info" (genre :
                          (as ++ bt ++ annotation ++ dd ++ coverpage ++ lang))
        , el "document-info" [el "program-used" ("pandoc" :: Text)]
        ]

    booktitle :: PandocMonad m => Meta -> FBM m [Content]
    booktitle :: forall (m :: * -> *). PandocMonad m => Meta -> FBM m [Content]
    booktitle Meta
    meta' = do
      t <- (Inline -> StateT FbRenderState m [Content])
    -> [Inline] -> StateT FbRenderState m [Content]
    forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
    cMapM Inline -> StateT FbRenderState m [Content]
    forall (m :: * -> *). PandocMonad m => Inline -> FBM m [Content]
    toXml ([Inline] -> StateT FbRenderState m [Content])
    -> (Meta -> [Inline]) -> Meta -> StateT FbRenderState m [Content]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Meta -> [Inline]
    docTitle (Meta -> StateT FbRenderState m [Content])
    -> Meta -> StateT FbRenderState m [Content]
    forall a b. (a -> b) -> a -> b
    $ Meta
    meta'
      return $ [el "book-title" t | not (null t)]

    authors :: Meta -> [Content]
    authors :: Meta -> [Content]
    authors Meta
    meta' = ([Inline] -> [Content]) -> [[Inline]] -> [Content]
    forall a b. (a -> [b]) -> [a] -> [b]
    cMap [Inline] -> [Content]
    author (Meta -> [[Inline]]
    docAuthors Meta
    meta')

    author :: [Inline] -> [Content]
    author :: [Inline] -> [Content]
    author [Inline]
    ss =
      let ws :: [Text]
    ws = Text -> [Text]
    T.words (Text -> [Text]) -> Text -> [Text]
    forall a b. (a -> b) -> a -> b
    $ [Text] -> Text
    forall a. Monoid a => [a] -> a
    mconcat ([Text] -> Text) -> [Text] -> Text
    forall a b. (a -> b) -> a -> b
    $ (Inline -> Text) -> [Inline] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map Inline -> Text
    plain [Inline]
    ss
          email :: [Content]
    email = Text -> Text -> Content
    forall t. Node t => Text -> t -> Content
    el Text
    "email" (Text -> Content) -> [Text] -> [Content]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Int -> [Text] -> [Text]
    forall a. Int -> [a] -> [a]
    take Int
    1 ((Text -> Bool) -> [Text] -> [Text]
    forall a. (a -> Bool) -> [a] -> [a]
    filter ((Char -> Bool) -> Text -> Bool
    T.any (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Char
    '@')) [Text]
    ws)
          ws' :: [Text]
    ws' = (Text -> Bool) -> [Text] -> [Text]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char -> Bool) -> Text -> Bool
    T.any (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '@')) [Text]
    ws
          names :: [Content]
    names = case [Text]
    ws' of
                    [Text
    nickname] -> [ Text -> Text -> Content
    forall t. Node t => Text -> t -> Content
    el Text
    "nickname" Text
    nickname ]
                    [Text
    fname, Text
    lname] -> [ Text -> Text -> Content
    forall t. Node t => Text -> t -> Content
    el Text
    "first-name" Text
    fname
                                        , Text -> Text -> Content
    forall t. Node t => Text -> t -> Content
    el Text
    "last-name" Text
    lname ]
                    (Text
    fname:[Text]
    rest) -> [ Text -> Text -> Content
    forall t. Node t => Text -> t -> Content
    el Text
    "first-name" Text
    fname
                                    , Text -> Text -> Content
    forall t. Node t => Text -> t -> Content
    el Text
    "middle-name" ([Text] -> Text
    T.concat ([Text] -> Text) -> ([Text] -> [Text]) -> [Text] -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Text] -> [Text]
    forall a. HasCallStack => [a] -> [a]
    init ([Text] -> Text) -> [Text] -> Text
    forall a b. (a -> b) -> a -> b
    $ [Text]
    rest)
                                    , Text -> Text -> Content
    forall t. Node t => Text -> t -> Content
    el Text
    "last-name" ([Text] -> Text
    forall a. HasCallStack => [a] -> a
    last [Text]
    rest) ]
                    [] -> []
      in  Content -> [Content]
    forall a. a -> [a]
    list (Content -> [Content]) -> Content -> [Content]
    forall a b. (a -> b) -> a -> b
    $ Text -> [Content] -> Content
    forall t. Node t => Text -> t -> Content
    el Text
    "author" ([Content]
    names [Content] -> [Content] -> [Content]
    forall a. [a] -> [a] -> [a]
    ++ [Content]
    email)

    docdate :: PandocMonad m => Meta -> FBM m [Content]
    docdate :: forall (m :: * -> *). PandocMonad m => Meta -> FBM m [Content]
    docdate Meta
    meta' = do
      let ss :: [Inline]
    ss = Meta -> [Inline]
    docDate Meta
    meta'
      d <- (Inline -> StateT FbRenderState m [Content])
    -> [Inline] -> StateT FbRenderState m [Content]
    forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
    cMapM Inline -> StateT FbRenderState m [Content]
    forall (m :: * -> *). PandocMonad m => Inline -> FBM m [Content]
    toXml [Inline]
    ss
      return $ [el "date" d | not (null d)]

    -- | Divide the stream of blocks into sections and convert to XML
    -- representation.
    renderSections :: PandocMonad m => Int -> [Block] -> FBM m [Content]
    renderSections :: forall (m :: * -> *).
    PandocMonad m =>
    Int -> [Block] -> FBM m [Content]
    renderSections Int
    level [Block]
    blocks = do
        let blocks' :: [Block]
    blocks' = Bool -> Maybe Int -> [Block] -> [Block]
    makeSections Bool
    False Maybe Int
    forall a. Maybe a
    Nothing [Block]
    blocks
        let isSection :: Block -> Bool
    isSection (Div (Text
    _,Text
    "section":[Text]
    _,[(Text, Text)]
    _) (Header{}:[Block]
    _)) = Bool
    True
            isSection Block
    _ = Bool
    False
        let ([Block]
    initialBlocks, [Block]
    secs) = (Block -> Bool) -> [Block] -> ([Block], [Block])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    break Block -> Bool
    isSection [Block]
    blocks'
        let blocks'' :: [Block]
    blocks'' = if [Block] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Block]
    initialBlocks
            then [Block]
    blocks'
            else Attr -> [Block] -> Block
    Div (Text
    "",[Text
    "section"],[])
                   (Int -> Attr -> [Inline] -> Block
    Header Int
    1 Attr
    nullAttr [Inline]
    forall a. Monoid a => a
    mempty Block -> [Block] -> [Block]
    forall a. a -> [a] -> [a]
    : [Block]
    initialBlocks) Block -> [Block] -> [Block]
    forall a. a -> [a] -> [a]
    : [Block]
    secs
        (Block -> StateT FbRenderState m [Content])
    -> [Block] -> StateT FbRenderState m [Content]
    forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
    cMapM (Int -> Block -> StateT FbRenderState m [Content]
    forall (m :: * -> *).
    PandocMonad m =>
    Int -> Block -> FBM m [Content]
    renderSection Int
    level) [Block]
    blocks''

    renderSection :: PandocMonad m =>  Int -> Block -> FBM m [Content]
    renderSection :: forall (m :: * -> *).
    PandocMonad m =>
    Int -> Block -> FBM m [Content]
    renderSection Int
    lvl (Div (Text
    id',Text
    "section":[Text]
    _,[(Text, Text)]
    _) (Header Int
    _ Attr
    _ [Inline]
    title : [Block]
    xs)) = do
      title' <- if [Inline] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Inline]
    title
                then [Content] -> StateT FbRenderState m [Content]
    forall a. a -> StateT FbRenderState m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
                else Content -> [Content]
    forall a. a -> [a]
    list (Content -> [Content])
    -> ([Content] -> Content) -> [Content] -> [Content]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> [Content] -> Content
    forall t. Node t => Text -> t -> Content
    el Text
    "title" ([Content] -> [Content])
    -> StateT FbRenderState m [Content]
    -> StateT FbRenderState m [Content]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Inline] -> StateT FbRenderState m [Content]
    forall (m :: * -> *). PandocMonad m => [Inline] -> FBM m [Content]
    formatTitle [Inline]
    title
      content <- cMapM (renderSection (lvl + 1)) xs
      let sectionContent = if Text -> Bool
    T.null Text
    id'
          then Text -> [Content] -> Content
    forall t. Node t => Text -> t -> Content
    el Text
    "section" ([Content]
    title' [Content] -> [Content] -> [Content]
    forall a. [a] -> [a] -> [a]
    ++ [Content]
    content)
          else Text -> ([Attr], [Content]) -> Content
    forall t. Node t => Text -> t -> Content
    el Text
    "section" ([Text -> Text -> Attr
    uattr Text
    "id" Text
    id'], [Content]
    title' [Content] -> [Content] -> [Content]
    forall a. [a] -> [a] -> [a]
    ++ [Content]
    content)
      return [sectionContent]
    renderSection Int
    lvl (Div Attr
    _attr [Block]
    bs) =
      (Block -> StateT FbRenderState m [Content])
    -> [Block] -> StateT FbRenderState m [Content]
    forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
    cMapM (Int -> Block -> StateT FbRenderState m [Content]
    forall (m :: * -> *).
    PandocMonad m =>
    Int -> Block -> FBM m [Content]
    renderSection Int
    lvl) [Block]
    bs
    renderSection Int
    _ Block
    b = Block -> StateT FbRenderState m [Content]
    forall (m :: * -> *). PandocMonad m => Block -> FBM m [Content]
    blockToXml Block
    b

    -- | Only <p> and <empty-line> are allowed within <title> in FB2.
    formatTitle :: PandocMonad m => [Inline] -> FBM m [Content]
    formatTitle :: forall (m :: * -> *). PandocMonad m => [Inline] -> FBM m [Content]
    formatTitle [Inline]
    inlines =
      ([Inline] -> StateT FbRenderState m [Content])
    -> [[Inline]] -> StateT FbRenderState m [Content]
    forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
    cMapM (Block -> StateT FbRenderState m [Content]
    forall (m :: * -> *). PandocMonad m => Block -> FBM m [Content]
    blockToXml (Block -> StateT FbRenderState m [Content])
    -> ([Inline] -> Block)
    -> [Inline]
    -> StateT FbRenderState m [Content]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Inline] -> Block
    Para) ([[Inline]] -> StateT FbRenderState m [Content])
    -> [[Inline]] -> StateT FbRenderState m [Content]
    forall a b. (a -> b) -> a -> b
    $ (Inline -> Bool) -> [Inline] -> [[Inline]]
    forall a. (a -> Bool) -> [a] -> [[a]]
    split (Inline -> Inline -> Bool
    forall a. Eq a => a -> a -> Bool
    == Inline
    LineBreak) [Inline]
    inlines

    split :: (a -> Bool) -> [a] -> [[a]]
    split :: forall a. (a -> Bool) -> [a] -> [[a]]
    split a -> Bool
    _ [] = []
    split a -> Bool
    cond [a]
    xs = let ([a]
    b,[a]
    a) = (a -> Bool) -> [a] -> ([a], [a])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    break a -> Bool
    cond [a]
    xs
                    in  ([a]
    b[a] -> [[a]] -> [[a]]
    forall a. a -> [a] -> [a]
    :(a -> Bool) -> [a] -> [[a]]
    forall a. (a -> Bool) -> [a] -> [[a]]
    split a -> Bool
    cond (Int -> [a] -> [a]
    forall a. Int -> [a] -> [a]
    drop Int
    1 [a]
    a))

    isLineBreak :: Inline -> Bool
    isLineBreak :: Inline -> Bool
    isLineBreak Inline
    LineBreak = Bool
    True
    isLineBreak Inline
    _         = Bool
    False

    -- | Make another FictionBook body with footnotes.
    renderFootnotes :: PandocMonad m => FBM m [Content]
    renderFootnotes :: forall (m :: * -> *). PandocMonad m => FBM m [Content]
    renderFootnotes = do
      fns <- FbRenderState -> [(Int, Text, [Content])]
    footnotes (FbRenderState -> [(Int, Text, [Content])])
    -> StateT FbRenderState m FbRenderState
    -> StateT FbRenderState m [(Int, Text, [Content])]
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    `liftM` StateT FbRenderState m FbRenderState
    forall s (m :: * -> *). MonadState s m => m s
    get
      if null fns
        then return []  -- no footnotes
        else return . list $
             el "body" ([uattr "name" "notes"], map renderFN (reverse fns))
      where
        renderFN :: (a, Text, [Content]) -> Content
    renderFN (a
    n, Text
    idstr, [Content]
    cs) =
            let fn_texts :: [Content]
    fn_texts = Text -> Content -> Content
    forall t. Node t => Text -> t -> Content
    el Text
    "title" (Text -> Text -> Content
    forall t. Node t => Text -> t -> Content
    el Text
    "p" (a -> Text
    forall a. Show a => a -> Text
    tshow a
    n)) Content -> [Content] -> [Content]
    forall a. a -> [a] -> [a]
    : [Content]
    cs
            in  Text -> ([Attr], [Content]) -> Content
    forall t. Node t => Text -> t -> Content
    el Text
    "section" ([Text -> Text -> Attr
    uattr Text
    "id" Text
    idstr], [Content]
    fn_texts)

    -- | Fetch images and encode them for the FictionBook XML.
    -- Return image data and a list of hrefs of the missing images.
    fetchImages :: PandocMonad m => [(Text,Text)] -> m ([Content],[Text])
    fetchImages :: forall (m :: * -> *).
    PandocMonad m =>
    [(Text, Text)] -> m ([Content], [Text])
    fetchImages [(Text, Text)]
    links = do
        imgs <- ((Text, Text) -> m (Either Text Content))
    -> [(Text, Text)] -> m [Either Text Content]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM ((Text -> Text -> m (Either Text Content))
    -> (Text, Text) -> m (Either Text Content)
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry Text -> Text -> m (Either Text Content)
    forall (m :: * -> *).
    PandocMonad m =>
    Text -> Text -> m (Either Text Content)
    fetchImage) [(Text, Text)]
    links
        return (rights imgs, lefts imgs)

    -- | Fetch image data from disk or from network and make a <binary> XML section.
    -- Return either (Left hrefOfMissingImage) or (Right xmlContent).
    fetchImage :: PandocMonad m => Text -> Text -> m (Either Text Content)
    fetchImage :: forall (m :: * -> *).
    PandocMonad m =>
    Text -> Text -> m (Either Text Content)
    fetchImage Text
    href Text
    link = do
      mbimg <-
          case (Text -> Bool
    isURI Text
    link, Text -> Maybe (Text, Text, Bool, Text)
    readDataURI Text
    link) of
           (Bool
    True, Just (Text
    mime,Text
    _,Bool
    True,Text
    base64)) ->
               let mime' :: Text
    mime' = Text -> Text
    T.toLower Text
    mime
               in if Text
    mime' Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    "image/png" Bool -> Bool -> Bool
    || Text
    mime' Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    "image/jpeg"
                  then Maybe (Text, Text) -> m (Maybe (Text, Text))
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((Text, Text) -> Maybe (Text, Text)
    forall a. a -> Maybe a
    Just (Text
    mime',Text
    base64))
                  else Maybe (Text, Text) -> m (Maybe (Text, Text))
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe (Text, Text)
    forall a. Maybe a
    Nothing
           (Bool
    True, Just (Text, Text, Bool, Text)
    _) -> Maybe (Text, Text) -> m (Maybe (Text, Text))
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe (Text, Text)
    forall a. Maybe a
    Nothing  -- not base64-encoded
           (Bool, Maybe (Text, Text, Bool, Text))
    _               ->
             m (Maybe (Text, Text))
    -> (PandocError -> m (Maybe (Text, Text)))
    -> m (Maybe (Text, Text))
    forall a. m a -> (PandocError -> m a) -> m a
    forall e (m :: * -> *) a.
    MonadError e m =>
    m a -> (e -> m a) -> m a
    catchError (do (bs, mbmime) <- Text -> m (ByteString, Maybe Text)
    forall (m :: * -> *).
    PandocMonad m =>
    Text -> m (ByteString, Maybe Text)
    P.fetchItem Text
    link
                            case mbmime of
                                 Maybe Text
    Nothing -> do
                                   LogMessage -> m ()
    forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
    report (LogMessage -> m ()) -> LogMessage -> m ()
    forall a b. (a -> b) -> a -> b
    $ Text -> LogMessage
    CouldNotDetermineMimeType Text
    link
                                   Maybe (Text, Text) -> m (Maybe (Text, Text))
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe (Text, Text)
    forall a. Maybe a
    Nothing
                                 Just Text
    mime -> Maybe (Text, Text) -> m (Maybe (Text, Text))
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe (Text, Text) -> m (Maybe (Text, Text)))
    -> Maybe (Text, Text) -> m (Maybe (Text, Text))
    forall a b. (a -> b) -> a -> b
    $ (Text, Text) -> Maybe (Text, Text)
    forall a. a -> Maybe a
    Just (Text
    mime,
                                                          ByteString -> Text
    TE.decodeUtf8 (ByteString -> Text) -> ByteString -> Text
    forall a b. (a -> b) -> a -> b
    $ ByteString -> ByteString
    encode ByteString
    bs))
                        (\PandocError
    e ->
                           do LogMessage -> m ()
    forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
    report (LogMessage -> m ()) -> LogMessage -> m ()
    forall a b. (a -> b) -> a -> b
    $ Text -> Text -> LogMessage
    CouldNotFetchResource Text
    link (PandocError -> Text
    forall a. Show a => a -> Text
    tshow PandocError
    e)
                              Maybe (Text, Text) -> m (Maybe (Text, Text))
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe (Text, Text)
    forall a. Maybe a
    Nothing)
      case mbimg of
        Just (Text
    imgtype, Text
    imgdata) ->
            Either Text Content -> m (Either Text Content)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either Text Content -> m (Either Text Content))
    -> (Content -> Either Text Content)
    -> Content
    -> m (Either Text Content)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Content -> Either Text Content
    forall a b. b -> Either a b
    Right (Content -> m (Either Text Content))
    -> Content -> m (Either Text Content)
    forall a b. (a -> b) -> a -> b
    $ Text -> ([Attr], Content) -> Content
    forall t. Node t => Text -> t -> Content
    el Text
    "binary"
                       ( [Text -> Text -> Attr
    uattr Text
    "id" Text
    href
                         , Text -> Text -> Attr
    uattr Text
    "content-type" Text
    imgtype]
                       , Text -> Content
    txt Text
    imgdata )
        Maybe (Text, Text)
    _ -> Either Text Content -> m (Either Text Content)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Text -> Either Text Content
    forall a b. a -> Either a b
    Left (Text
    "#" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    href))

    -- | Extract mime type and encoded data from the Data URI.
    readDataURI :: Text -- ^ URI
                -> Maybe (Text,Text,Bool,Text)
                   -- ^ Maybe (mime,charset,isBase64,data)
    readDataURI :: Text -> Maybe (Text, Text, Bool, Text)
    readDataURI Text
    uri =
      case Text -> Text -> Maybe Text
    T.stripPrefix Text
    "data:" Text
    uri of
        Maybe Text
    Nothing   -> Maybe (Text, Text, Bool, Text)
    forall a. Maybe a
    Nothing
        Just Text
    rest ->
          let meta :: Text
    meta = (Char -> Bool) -> Text -> Text
    T.takeWhile (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    ',') Text
    rest  -- without trailing ','
              uridata :: Text
    uridata = Int -> Text -> Text
    T.drop (Text -> Int
    T.length Text
    meta Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1) Text
    rest
              parts :: [Text]
    parts = (Char -> Bool) -> Text -> [Text]
    T.split (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    ';') Text
    meta
              (Text
    mime,Text
    cs,Bool
    enc)=(Text -> (Text, Text, Bool) -> (Text, Text, Bool))
    -> (Text, Text, Bool) -> [Text] -> (Text, Text, Bool)
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr Text -> (Text, Text, Bool) -> (Text, Text, Bool)
    upd (Text
    "text/plain",Text
    "US-ASCII",Bool
    False) [Text]
    parts
          in  (Text, Text, Bool, Text) -> Maybe (Text, Text, Bool, Text)
    forall a. a -> Maybe a
    Just (Text
    mime,Text
    cs,Bool
    enc,Text
    uridata)

     where
       upd :: Text -> (Text, Text, Bool) -> (Text, Text, Bool)
    upd Text
    str m :: (Text, Text, Bool)
    m@(Text
    mime,Text
    cs,Bool
    enc)
           | Text -> Bool
    isMimeType Text
    str                            = (Text
    str,Text
    cs,Bool
    enc)
           | Just Text
    str' <- Text -> Text -> Maybe Text
    T.stripPrefix Text
    "charset=" Text
    str = (Text
    mime,Text
    str',Bool
    enc)
           | Text
    str Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    ==  Text
    "base64"                          = (Text
    mime,Text
    cs,Bool
    True)
           | Bool
    otherwise                                 = (Text, Text, Bool)
    m

    -- Without parameters like ;charset=...; see RFC 2045, 5.1
    isMimeType :: Text -> Bool
    isMimeType :: Text -> Bool
    isMimeType Text
    s =
        case (Char -> Bool) -> Text -> [Text]
    T.split (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Char
    '/') Text
    s of
          [Text
    mtype,Text
    msubtype] ->
              (Text -> Text
    T.toLower Text
    mtype Text -> [Text] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Text]
    types
               Bool -> Bool -> Bool
    || Text
    "x-" Text -> Text -> Bool
    `T.isPrefixOf` Text -> Text
    T.toLower Text
    mtype)
              Bool -> Bool -> Bool
    && (Char -> Bool) -> Text -> Bool
    T.all Char -> Bool
    valid Text
    mtype
              Bool -> Bool -> Bool
    && (Char -> Bool) -> Text -> Bool
    T.all Char -> Bool
    valid Text
    msubtype
          [Text]
    _ -> Bool
    False
     where
       types :: [Text]
    types =  [Text
    "text",Text
    "image",Text
    "audio",Text
    "video",Text
    "application",Text
    "message",Text
    "multipart"]
       valid :: Char -> Bool
    valid Char
    c = Char -> Bool
    isAscii Char
    c Bool -> Bool -> Bool
    && Bool -> Bool
    not (Char -> Bool
    isControl Char
    c) Bool -> Bool -> Bool
    && Bool -> Bool
    not (Char -> Bool
    isSpace Char
    c) Bool -> Bool -> Bool
    &&
                 Char
    c Char -> String -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `notElem` (String
    "()<>@,;:\\\"/[]?=" :: [Char])

    footnoteID :: Int -> Text
    footnoteID :: Int -> Text
    footnoteID Int
    i = Text
    "n" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Int -> Text
    forall a. Show a => a -> Text
    tshow Int
    i

    mkitem :: PandocMonad m => Text -> [Block] -> FBM m [Content]
    mkitem :: forall (m :: * -> *).
    PandocMonad m =>
    Text -> [Block] -> FBM m [Content]
    mkitem Text
    mrk [Block]
    bs = do
      pmrk <- (FbRenderState -> Text) -> StateT FbRenderState m Text
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets FbRenderState -> Text
    parentListMarker
      let nmrk = Text
    pmrk Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    mrk Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " "
      modify (\FbRenderState
    s -> FbRenderState
    s { parentListMarker = nmrk})
      item <- cMapM blockToXml $ plainToPara $ indentBlocks nmrk bs
      modify (\FbRenderState
    s -> FbRenderState
    s { parentListMarker = pmrk }) -- old parent marker
      return item

    -- | Convert a block-level Pandoc's element to FictionBook XML representation.
    blockToXml :: PandocMonad m => Block -> FBM m [Content]
    blockToXml :: forall (m :: * -> *). PandocMonad m => Block -> FBM m [Content]
    blockToXml (Plain [img :: Inline
    img@Image {}]) = ImageMode -> Inline -> FBM m [Content]
    forall (m :: * -> *).
    PandocMonad m =>
    ImageMode -> Inline -> FBM m [Content]
    insertImage ImageMode
    NormalImage Inline
    img
    blockToXml (Plain [Inline]
    ss) = (Inline -> FBM m [Content]) -> [Inline] -> FBM m [Content]
    forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
    cMapM Inline -> FBM m [Content]
    forall (m :: * -> *). PandocMonad m => Inline -> FBM m [Content]
    toXml [Inline]
    ss  -- FIXME: can lead to malformed FB2
    -- Special handling for singular images and display math elements
    blockToXml (Para [Math MathType
    DisplayMath Text
    formula]) = ImageMode -> Text -> FBM m [Content]
    forall (m :: * -> *).
    PandocMonad m =>
    ImageMode -> Text -> FBM m [Content]
    insertMath ImageMode
    NormalImage Text
    formula
    blockToXml (Para [img :: Inline
    img@(Image {})]) = ImageMode -> Inline -> FBM m [Content]
    forall (m :: * -> *).
    PandocMonad m =>
    ImageMode -> Inline -> FBM m [Content]
    insertImage ImageMode
    NormalImage Inline
    img
    blockToXml (Para [Inline]
    ss) = Content -> [Content]
    forall a. a -> [a]
    list (Content -> [Content])
    -> ([Content] -> Content) -> [Content] -> [Content]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> [Content] -> Content
    forall t. Node t => Text -> t -> Content
    el Text
    "p" ([Content] -> [Content]) -> FBM m [Content] -> FBM m [Content]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Inline -> FBM m [Content]) -> [Inline] -> FBM m [Content]
    forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
    cMapM Inline -> FBM m [Content]
    forall (m :: * -> *). PandocMonad m => Inline -> FBM m [Content]
    toXml [Inline]
    ss
    blockToXml (CodeBlock Attr
    _ Text
    s) = [Content] -> FBM m [Content]
    forall a. a -> StateT FbRenderState m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Content] -> FBM m [Content])
    -> (Text -> [Content]) -> Text -> FBM m [Content]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Content] -> [Content]
    spaceBeforeAfter ([Content] -> [Content])
    -> (Text -> [Content]) -> Text -> [Content]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
                                 (Text -> Content) -> [Text] -> [Content]
    forall a b. (a -> b) -> [a] -> [b]
    map (Text -> Content -> Content
    forall t. Node t => Text -> t -> Content
    el Text
    "p" (Content -> Content) -> (Text -> Content) -> Text -> Content
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> Text -> Content
    forall t. Node t => Text -> t -> Content
    el Text
    "code") ([Text] -> [Content]) -> (Text -> [Text]) -> Text -> [Content]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> [Text]
    T.lines (Text -> FBM m [Content]) -> Text -> FBM m [Content]
    forall a b. (a -> b) -> a -> b
    $ Text
    s
    blockToXml (RawBlock Format
    f Text
    str) =
      if Format
    f Format -> Format -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text -> Format
    Format Text
    "fb2"
        then
          case Text -> Either Text [Content]
    parseXMLContents (Text -> Text
    TL.fromStrict Text
    str) of
             Left Text
    msg  -> PandocError -> FBM m [Content]
    forall a. PandocError -> StateT FbRenderState m a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (PandocError -> FBM m [Content]) -> PandocError -> FBM m [Content]
    forall a b. (a -> b) -> a -> b
    $ Text -> Text -> PandocError
    PandocXMLError Text
    "" Text
    msg
             Right [Content]
    nds -> [Content] -> FBM m [Content]
    forall a. a -> StateT FbRenderState m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [Content]
    nds
        else [Content] -> FBM m [Content]
    forall a. a -> StateT FbRenderState m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
    blockToXml (Div Attr
    _ [Block]
    bs) = (Block -> FBM m [Content]) -> [Block] -> FBM m [Content]
    forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
    cMapM Block -> FBM m [Content]
    forall (m :: * -> *). PandocMonad m => Block -> FBM m [Content]
    blockToXml [Block]
    bs
    blockToXml (BlockQuote [Block]
    bs) = Content -> [Content]
    forall a. a -> [a]
    list (Content -> [Content])
    -> ([Content] -> Content) -> [Content] -> [Content]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> [Content] -> Content
    forall t. Node t => Text -> t -> Content
    el Text
    "cite" ([Content] -> [Content]) -> FBM m [Content] -> FBM m [Content]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Block -> FBM m [Content]) -> [Block] -> FBM m [Content]
    forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
    cMapM Block -> FBM m [Content]
    forall (m :: * -> *). PandocMonad m => Block -> FBM m [Content]
    blockToXml [Block]
    bs
    blockToXml (LineBlock [[Inline]]
    lns) =
      Content -> [Content]
    forall a. a -> [a]
    list (Content -> [Content])
    -> ([Content] -> Content) -> [Content] -> [Content]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> [Content] -> Content
    forall t. Node t => Text -> t -> Content
    el Text
    "poem" ([Content] -> [Content]) -> FBM m [Content] -> FBM m [Content]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ([[Inline]] -> StateT FbRenderState m Content)
    -> [[[Inline]]] -> FBM m [Content]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM [[Inline]] -> StateT FbRenderState m Content
    forall {t :: * -> *} {m :: * -> *}.
    (Node (t Content), Traversable t, PandocMonad m) =>
    t [Inline] -> StateT FbRenderState m Content
    stanza (([Inline] -> Bool) -> [[Inline]] -> [[[Inline]]]
    forall a. (a -> Bool) -> [a] -> [[a]]
    split [Inline] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [[Inline]]
    lns)
      where
        v :: [Inline] -> StateT FbRenderState m Content
    v [Inline]
    xs = Text -> [Content] -> Content
    forall t. Node t => Text -> t -> Content
    el Text
    "v" ([Content] -> Content)
    -> StateT FbRenderState m [Content]
    -> StateT FbRenderState m Content
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Inline -> StateT FbRenderState m [Content])
    -> [Inline] -> StateT FbRenderState m [Content]
    forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
    cMapM Inline -> StateT FbRenderState m [Content]
    forall (m :: * -> *). PandocMonad m => Inline -> FBM m [Content]
    toXml [Inline]
    xs
        stanza :: t [Inline] -> StateT FbRenderState m Content
    stanza t [Inline]
    xs = Text -> t Content -> Content
    forall t. Node t => Text -> t -> Content
    el Text
    "stanza" (t Content -> Content)
    -> StateT FbRenderState m (t Content)
    -> StateT FbRenderState m Content
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ([Inline] -> StateT FbRenderState m Content)
    -> t [Inline] -> StateT FbRenderState m (t Content)
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> t a -> m (t b)
    mapM [Inline] -> StateT FbRenderState m Content
    forall {m :: * -> *}.
    PandocMonad m =>
    [Inline] -> StateT FbRenderState m Content
    v t [Inline]
    xs
    blockToXml (OrderedList ListAttributes
    a [[Block]]
    bss) =
        [[Content]] -> [Content]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([[Content]] -> [Content])
    -> StateT FbRenderState m [[Content]] -> FBM m [Content]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Text -> [Block] -> FBM m [Content])
    -> [Text] -> [[Block]] -> StateT FbRenderState m [[Content]]
    forall (m :: * -> *) a b c.
    Applicative m =>
    (a -> b -> m c) -> [a] -> [b] -> m [c]
    zipWithM Text -> [Block] -> FBM m [Content]
    forall (m :: * -> *).
    PandocMonad m =>
    Text -> [Block] -> FBM m [Content]
    mkitem [Text]
    markers [[Block]]
    bss
        where
          markers :: [Text]
    markers = ListAttributes -> [Text]
    orderedListMarkers ListAttributes
    a
    blockToXml (BulletList [[Block]]
    bss) =
        ([Block] -> FBM m [Content]) -> [[Block]] -> FBM m [Content]
    forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
    cMapM (Text -> [Block] -> FBM m [Content]
    forall (m :: * -> *).
    PandocMonad m =>
    Text -> [Block] -> FBM m [Content]
    mkitem Text
    "•") [[Block]]
    bss
    blockToXml (DefinitionList [([Inline], [[Block]])]
    defs) =
        (([Inline], [[Block]]) -> FBM m [Content])
    -> [([Inline], [[Block]])] -> FBM m [Content]
    forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
    cMapM ([Inline], [[Block]]) -> FBM m [Content]
    forall {m :: * -> *}.
    PandocMonad m =>
    ([Inline], [[Block]]) -> StateT FbRenderState m [Content]
    mkdef [([Inline], [[Block]])]
    defs
        where
          mkdef :: ([Inline], [[Block]]) -> StateT FbRenderState m [Content]
    mkdef ([Inline]
    term, [[Block]]
    bss) = do
              items <- ([Block] -> StateT FbRenderState m [Content])
    -> [[Block]] -> StateT FbRenderState m [Content]
    forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
    cMapM ((Block -> StateT FbRenderState m [Content])
    -> [Block] -> StateT FbRenderState m [Content]
    forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
    cMapM Block -> StateT FbRenderState m [Content]
    forall (m :: * -> *). PandocMonad m => Block -> FBM m [Content]
    blockToXml ([Block] -> StateT FbRenderState m [Content])
    -> ([Block] -> [Block])
    -> [Block]
    -> StateT FbRenderState m [Content]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Block] -> [Block]
    plainToPara ([Block] -> [Block]) -> ([Block] -> [Block]) -> [Block] -> [Block]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> [Block] -> [Block]
    indentBlocks (Int -> Text -> Text
    T.replicate Int
    4 Text
    " ")) [[Block]]
    bss
              t <- wrap "strong" term
              return (el "p" t : items)
    blockToXml h :: Block
    h@Header{} = do
      -- should not occur after makeSections, except inside lists/blockquotes
      LogMessage -> StateT FbRenderState m ()
    forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
    report (LogMessage -> StateT FbRenderState m ())
    -> LogMessage -> StateT FbRenderState m ()
    forall a b. (a -> b) -> a -> b
    $ Block -> LogMessage
    BlockNotRendered Block
    h
      [Content] -> FBM m [Content]
    forall a. a -> StateT FbRenderState m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
    blockToXml Block
    HorizontalRule = [Content] -> FBM m [Content]
    forall a. a -> StateT FbRenderState m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [ Text -> () -> Content
    forall t. Node t => Text -> t -> Content
    el Text
    "empty-line" () ]
    blockToXml (Table Attr
    _ Caption
    blkCapt [ColSpec]
    specs TableHead
    thead [TableBody]
    tbody TableFoot
    tfoot) = do
        let ([Inline]
    caption, [Alignment]
    aligns, [Double]
    _, [[Block]]
    headers, [[[Block]]]
    rows) = Caption
    -> [ColSpec]
    -> TableHead
    -> [TableBody]
    -> TableFoot
    -> ([Inline], [Alignment], [Double], [[Block]], [[[Block]]])
    toLegacyTable Caption
    blkCapt [ColSpec]
    specs TableHead
    thead [TableBody]
    tbody TableFoot
    tfoot
        hd <- if [[Block]] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [[Block]]
    headers then [Content] -> FBM m [Content]
    forall a. a -> StateT FbRenderState m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure [] else (Content -> [Content] -> [Content]
    forall a. a -> [a] -> [a]
    :[]) (Content -> [Content])
    -> StateT FbRenderState m Content -> FBM m [Content]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Text -> [[Block]] -> [Alignment] -> StateT FbRenderState m Content
    forall (m :: * -> *).
    PandocMonad m =>
    Text -> [[Block]] -> [Alignment] -> FBM m Content
    mkrow Text
    "th" [[Block]]
    headers [Alignment]
    aligns
        bd <- mapM (\[[Block]]
    r -> Text -> [[Block]] -> [Alignment] -> StateT FbRenderState m Content
    forall (m :: * -> *).
    PandocMonad m =>
    Text -> [[Block]] -> [Alignment] -> FBM m Content
    mkrow Text
    "td" [[Block]]
    r [Alignment]
    aligns) rows
        c <- el "emphasis" <$> cMapM toXml caption
        return [el "table" (hd <> bd), el "p" c]
        where
          mkrow :: PandocMonad m => Text -> [[Block]] -> [Alignment] -> FBM m Content
          mkrow :: forall (m :: * -> *).
    PandocMonad m =>
    Text -> [[Block]] -> [Alignment] -> FBM m Content
    mkrow Text
    tag [[Block]]
    cells [Alignment]
    aligns' =
            Text -> [Content] -> Content
    forall t. Node t => Text -> t -> Content
    el Text
    "tr" ([Content] -> Content)
    -> StateT FbRenderState m [Content]
    -> StateT FbRenderState m Content
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (([Block], Alignment) -> StateT FbRenderState m Content)
    -> [([Block], Alignment)] -> StateT FbRenderState m [Content]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM (Text -> ([Block], Alignment) -> StateT FbRenderState m Content
    forall (m :: * -> *).
    PandocMonad m =>
    Text -> ([Block], Alignment) -> FBM m Content
    mkcell Text
    tag) ([[Block]] -> [Alignment] -> [([Block], Alignment)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [[Block]]
    cells [Alignment]
    aligns')
          --
          mkcell :: PandocMonad m => Text -> ([Block], Alignment) -> FBM m Content
          mkcell :: forall (m :: * -> *).
    PandocMonad m =>
    Text -> ([Block], Alignment) -> FBM m Content
    mkcell Text
    tag ([Block]
    cell, Alignment
    align) = do
            cblocks <- (Block -> StateT FbRenderState m [Content])
    -> [Block] -> StateT FbRenderState m [Content]
    forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
    cMapM Block -> StateT FbRenderState m [Content]
    forall (m :: * -> *). PandocMonad m => Block -> FBM m [Content]
    blockToXml [Block]
    cell
            return $ el tag ([align_attr align], cblocks)
          --
          align_attr :: Alignment -> Attr
    align_attr Alignment
    a = QName -> Text -> Attr
    Attr (Text -> Maybe Text -> Maybe Text -> QName
    QName Text
    "align" Maybe Text
    forall a. Maybe a
    Nothing Maybe Text
    forall a. Maybe a
    Nothing) (Alignment -> Text
    forall {a}. IsString a => Alignment -> a
    align_str Alignment
    a)
          align_str :: Alignment -> a
    align_str Alignment
    AlignLeft    = a
    "left"
          align_str Alignment
    AlignCenter  = a
    "center"
          align_str Alignment
    AlignRight   = a
    "right"
          align_str Alignment
    AlignDefault = a
    "left"
    blockToXml (Figure Attr
    _attr (Caption Maybe [Inline]
    _ [Block]
    longcapt) [Block]
    body) =
      let alt :: [Inline]
    alt = [Block] -> [Inline]
    blocksToInlines [Block]
    longcapt
          addAlt :: Inline -> Inline
    addAlt (Image Attr
    imgattr [] (Text, Text)
    tgt) = Attr -> [Inline] -> (Text, Text) -> Inline
    Image Attr
    imgattr [Inline]
    alt (Text, Text)
    tgt
          addAlt Inline
    inln                   = Inline
    inln
      in (Block -> FBM m [Content]) -> [Block] -> FBM m [Content]
    forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
    cMapM Block -> FBM m [Content]
    forall (m :: * -> *). PandocMonad m => Block -> FBM m [Content]
    blockToXml ((Inline -> Inline) -> [Block] -> [Block]
    forall a b. Walkable a b => (a -> a) -> b -> b
    walk Inline -> Inline
    addAlt [Block]
    body)

    -- Replace plain text with paragraphs and add line break after paragraphs.
    -- It is used to convert plain text from tight list items to paragraphs.
    plainToPara :: [Block] -> [Block]
    plainToPara :: [Block] -> [Block]
    plainToPara [] = []
    plainToPara (Plain [Inline]
    inlines : [Block]
    rest) =
        [Inline] -> Block
    Para [Inline]
    inlines Block -> [Block] -> [Block]
    forall a. a -> [a] -> [a]
    : [Block] -> [Block]
    plainToPara [Block]
    rest
    plainToPara (Para [Inline]
    inlines : [Block]
    rest) =
        [Inline] -> Block
    Para [Inline]
    inlines Block -> [Block] -> [Block]
    forall a. a -> [a] -> [a]
    : Block
    HorizontalRule Block -> [Block] -> [Block]
    forall a. a -> [a] -> [a]
    : [Block] -> [Block]
    plainToPara [Block]
    rest -- HorizontalRule will be converted to <empty-line />
    plainToPara (Block
    p:[Block]
    rest) = Block
    p Block -> [Block] -> [Block]
    forall a. a -> [a] -> [a]
    : [Block] -> [Block]
    plainToPara [Block]
    rest

    -- Replace plain text with paragraphs
    unPlain :: Block -> Block
    unPlain :: Block -> Block
    unPlain (Plain [Inline]
    inlines) = [Inline] -> Block
    Para [Inline]
    inlines
    unPlain Block
    x = Block
    x

    -- Simulate increased indentation level. Will not really work
    -- for multi-line paragraphs.
    indentPrefix :: Text -> Block -> Block
    indentPrefix :: Text -> Block -> Block
    indentPrefix Text
    spacer = Block -> Block
    indentBlock
      where
      indentBlock :: Block -> Block
    indentBlock (Plain [Inline]
    ins) = [Inline] -> Block
    Plain (Text -> Inline
    Str Text
    spacerInline -> [Inline] -> [Inline]
    forall a. a -> [a] -> [a]
    :[Inline]
    ins)
      indentBlock (Para [Inline]
    ins) = [Inline] -> Block
    Para (Text -> Inline
    Str Text
    spacerInline -> [Inline] -> [Inline]
    forall a. a -> [a] -> [a]
    :[Inline]
    ins)
      indentBlock (CodeBlock Attr
    a Text
    s) =
        let s' :: Text
    s' = [Text] -> Text
    T.unlines ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Text -> Text) -> [Text] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map (Text
    spacerText -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <>) ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> [Text]
    T.lines (Text -> Text) -> Text -> Text
    forall a b. (a -> b) -> a -> b
    $ Text
    s
        in  Attr -> Text -> Block
    CodeBlock Attr
    a Text
    s'
      indentBlock (BlockQuote [Block]
    bs) = [Block] -> Block
    BlockQuote ((Block -> Block) -> [Block] -> [Block]
    forall a b. (a -> b) -> [a] -> [b]
    map Block -> Block
    indent [Block]
    bs)
      indentBlock (Header Int
    l Attr
    attr' [Inline]
    ins) = Int -> Attr -> [Inline] -> Block
    Header Int
    l Attr
    attr' ([Inline] -> [Inline]
    indentLines [Inline]
    ins)
      indentBlock Block
    everythingElse = Block
    everythingElse
      -- indent every (explicit) line
      indentLines :: [Inline] -> [Inline]
      indentLines :: [Inline] -> [Inline]
    indentLines [Inline]
    ins = let lns :: [[Inline]]
    lns = (Inline -> Bool) -> [Inline] -> [[Inline]]
    forall a. (a -> Bool) -> [a] -> [[a]]
    split Inline -> Bool
    isLineBreak [Inline]
    ins :: [[Inline]]
                        in  [Inline] -> [[Inline]] -> [Inline]
    forall a. [a] -> [[a]] -> [a]
    intercalate [Inline
    LineBreak] ([[Inline]] -> [Inline]) -> [[Inline]] -> [Inline]
    forall a b. (a -> b) -> a -> b
    $ ([Inline] -> [Inline]) -> [[Inline]] -> [[Inline]]
    forall a b. (a -> b) -> [a] -> [b]
    map (Text -> Inline
    Str Text
    spacerInline -> [Inline] -> [Inline]
    forall a. a -> [a] -> [a]
    :) [[Inline]]
    lns

    indent :: Block -> Block
    indent :: Block -> Block
    indent = Text -> Block -> Block
    indentPrefix Text
    spacer
      where
      -- indentation space
      spacer :: Text
      spacer :: Text
    spacer = Int -> Text -> Text
    T.replicate Int
    4 Text
    " "

    indentBlocks :: Text -> [Block] -> [Block]
    indentBlocks :: Text -> [Block] -> [Block]
    indentBlocks Text
    _ [] = []
    indentBlocks Text
    prefix (Block
    x:[Block]
    xs) = Text -> Block -> Block
    indentPrefix Text
    prefix Block
    x Block -> [Block] -> [Block]
    forall a. a -> [a] -> [a]
    : (Block -> Block) -> [Block] -> [Block]
    forall a b. (a -> b) -> [a] -> [b]
    map (Text -> Block -> Block
    indentPrefix (Text -> Block -> Block) -> Text -> Block -> Block
    forall a b. (a -> b) -> a -> b
    $ Int -> Text -> Text
    T.replicate (Text -> Int
    T.length Text
    prefix) Text
    " ") [Block]
    xs

    -- | Convert a Pandoc's Inline element to FictionBook XML representation.
    toXml :: PandocMonad m => Inline -> FBM m [Content]
    toXml :: forall (m :: * -> *). PandocMonad m => Inline -> FBM m [Content]
    toXml (Str Text
    s) = [Content] -> StateT FbRenderState m [Content]
    forall a. a -> StateT FbRenderState m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [Text -> Content
    txt Text
    s]
    toXml (Span Attr
    _ [Inline]
    ils) = (Inline -> StateT FbRenderState m [Content])
    -> [Inline] -> StateT FbRenderState m [Content]
    forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
    cMapM Inline -> StateT FbRenderState m [Content]
    forall (m :: * -> *). PandocMonad m => Inline -> FBM m [Content]
    toXml [Inline]
    ils
    toXml (Emph [Inline]
    ss) = Content -> [Content]
    forall a. a -> [a]
    list (Content -> [Content])
    -> StateT FbRenderState m Content
    -> StateT FbRenderState m [Content]
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    `liftM` Text -> [Inline] -> StateT FbRenderState m Content
    forall (m :: * -> *).
    PandocMonad m =>
    Text -> [Inline] -> FBM m Content
    wrap Text
    "emphasis" [Inline]
    ss
    toXml (Underline [Inline]
    ss) = Content -> [Content]
    forall a. a -> [a]
    list (Content -> [Content])
    -> StateT FbRenderState m Content
    -> StateT FbRenderState m [Content]
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    `liftM` Text -> [Inline] -> StateT FbRenderState m Content
    forall (m :: * -> *).
    PandocMonad m =>
    Text -> [Inline] -> FBM m Content
    wrap Text
    "underline" [Inline]
    ss
    toXml (Strong [Inline]
    ss) = Content -> [Content]
    forall a. a -> [a]
    list (Content -> [Content])
    -> StateT FbRenderState m Content
    -> StateT FbRenderState m [Content]
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    `liftM` Text -> [Inline] -> StateT FbRenderState m Content
    forall (m :: * -> *).
    PandocMonad m =>
    Text -> [Inline] -> FBM m Content
    wrap Text
    "strong" [Inline]
    ss
    toXml (Strikeout [Inline]
    ss) = Content -> [Content]
    forall a. a -> [a]
    list (Content -> [Content])
    -> StateT FbRenderState m Content
    -> StateT FbRenderState m [Content]
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    `liftM` Text -> [Inline] -> StateT FbRenderState m Content
    forall (m :: * -> *).
    PandocMonad m =>
    Text -> [Inline] -> FBM m Content
    wrap Text
    "strikethrough" [Inline]
    ss
    toXml (Superscript [Inline]
    ss) = Content -> [Content]
    forall a. a -> [a]
    list (Content -> [Content])
    -> StateT FbRenderState m Content
    -> StateT FbRenderState m [Content]
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    `liftM` Text -> [Inline] -> StateT FbRenderState m Content
    forall (m :: * -> *).
    PandocMonad m =>
    Text -> [Inline] -> FBM m Content
    wrap Text
    "sup" [Inline]
    ss
    toXml (Subscript [Inline]
    ss) = Content -> [Content]
    forall a. a -> [a]
    list (Content -> [Content])
    -> StateT FbRenderState m Content
    -> StateT FbRenderState m [Content]
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    `liftM` Text -> [Inline] -> StateT FbRenderState m Content
    forall (m :: * -> *).
    PandocMonad m =>
    Text -> [Inline] -> FBM m Content
    wrap Text
    "sub" [Inline]
    ss
    toXml (SmallCaps [Inline]
    ss) = (Inline -> StateT FbRenderState m [Content])
    -> [Inline] -> StateT FbRenderState m [Content]
    forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
    cMapM Inline -> StateT FbRenderState m [Content]
    forall (m :: * -> *). PandocMonad m => Inline -> FBM m [Content]
    toXml ([Inline] -> StateT FbRenderState m [Content])
    -> [Inline] -> StateT FbRenderState m [Content]
    forall a b. (a -> b) -> a -> b
    $ [Inline] -> [Inline]
    forall a. Walkable Inline a => a -> a
    capitalize [Inline]
    ss
    toXml (Quoted QuoteType
    SingleQuote [Inline]
    ss) = do  -- FIXME: should be language-specific
      inner <- (Inline -> StateT FbRenderState m [Content])
    -> [Inline] -> StateT FbRenderState m [Content]
    forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
    cMapM Inline -> StateT FbRenderState m [Content]
    forall (m :: * -> *). PandocMonad m => Inline -> FBM m [Content]
    toXml [Inline]
    ss
      return $ [txt "‘"] ++ inner ++ [txt "’"]
    toXml (Quoted QuoteType
    DoubleQuote [Inline]
    ss) = do
      inner <- (Inline -> StateT FbRenderState m [Content])
    -> [Inline] -> StateT FbRenderState m [Content]
    forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
    cMapM Inline -> StateT FbRenderState m [Content]
    forall (m :: * -> *). PandocMonad m => Inline -> FBM m [Content]
    toXml [Inline]
    ss
      return $ [txt "“"] ++ inner ++ [txt "”"]
    toXml (Cite [Citation]
    _ [Inline]
    ss) = (Inline -> StateT FbRenderState m [Content])
    -> [Inline] -> StateT FbRenderState m [Content]
    forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
    cMapM Inline -> StateT FbRenderState m [Content]
    forall (m :: * -> *). PandocMonad m => Inline -> FBM m [Content]
    toXml [Inline]
    ss  -- FIXME: support citation styles
    toXml (Code Attr
    _ Text
    s) = [Content] -> StateT FbRenderState m [Content]
    forall a. a -> StateT FbRenderState m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [Text -> Text -> Content
    forall t. Node t => Text -> t -> Content
    el Text
    "code" Text
    s]
    toXml Inline
    Space = [Content] -> StateT FbRenderState m [Content]
    forall a. a -> StateT FbRenderState m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [Text -> Content
    txt Text
    " "]
    toXml Inline
    SoftBreak = [Content] -> StateT FbRenderState m [Content]
    forall a. a -> StateT FbRenderState m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [Text -> Content
    txt Text
    "\n"]
    toXml Inline
    LineBreak = [Content] -> StateT FbRenderState m [Content]
    forall a. a -> StateT FbRenderState m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [Text -> Content
    txt Text
    "\n"]
    toXml (Math MathType
    _ Text
    formula) = ImageMode -> Text -> StateT FbRenderState m [Content]
    forall (m :: * -> *).
    PandocMonad m =>
    ImageMode -> Text -> FBM m [Content]
    insertMath ImageMode
    InlineImage Text
    formula
    toXml il :: Inline
    il@(RawInline Format
    _ Text
    _) = do
      LogMessage -> StateT FbRenderState m ()
    forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
    report (LogMessage -> StateT FbRenderState m ())
    -> LogMessage -> StateT FbRenderState m ()
    forall a b. (a -> b) -> a -> b
    $ Inline -> LogMessage
    InlineNotRendered Inline
    il
      [Content] -> StateT FbRenderState m [Content]
    forall a. a -> StateT FbRenderState m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return []  -- raw TeX and raw HTML are suppressed
    toXml (Link Attr
    _ [Inline]
    text (Text
    url,Text
    _)) = do
      ln_text <- (Inline -> StateT FbRenderState m [Content])
    -> [Inline] -> StateT FbRenderState m [Content]
    forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
    cMapM Inline -> StateT FbRenderState m [Content]
    forall (m :: * -> *). PandocMonad m => Inline -> FBM m [Content]
    toXml [Inline]
    text
      return [ el "a" ( [ attr ("l","href") url ], ln_text) ]
    toXml img :: Inline
    img@Image{} = ImageMode -> Inline -> StateT FbRenderState m [Content]
    forall (m :: * -> *).
    PandocMonad m =>
    ImageMode -> Inline -> FBM m [Content]
    insertImage ImageMode
    InlineImage Inline
    img
    toXml (Note [Block]
    bs) = do
      fns <- FbRenderState -> [(Int, Text, [Content])]
    footnotes (FbRenderState -> [(Int, Text, [Content])])
    -> StateT FbRenderState m FbRenderState
    -> StateT FbRenderState m [(Int, Text, [Content])]
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    `liftM` StateT FbRenderState m FbRenderState
    forall s (m :: * -> *). MonadState s m => m s
    get
      let n = Int
    1 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + [(Int, Text, [Content])] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [(Int, Text, [Content])]
    fns
      let fn_id = Int -> Text
    footnoteID Int
    n
      fn_desc <- cMapM blockToXml bs
      modify (\FbRenderState
    s -> FbRenderState
    s { footnotes = (n, fn_id, fn_desc) : fns })
      let fn_ref = Text -> Content
    txt (Text -> Content) -> Text -> Content
    forall a b. (a -> b) -> a -> b
    $ Text
    "[" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Int -> Text
    forall a. Show a => a -> Text
    tshow Int
    n Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "]"
      return . list $ el "a" ( [ attr ("l","href") ("#" <> fn_id)
                               , uattr "type" "note" ]
                             , fn_ref )

    insertMath :: PandocMonad m => ImageMode -> Text -> FBM m [Content]
    insertMath :: forall (m :: * -> *).
    PandocMonad m =>
    ImageMode -> Text -> FBM m [Content]
    insertMath ImageMode
    immode Text
    formula = do
      htmlMath <- (FbRenderState -> HTMLMathMethod)
    -> StateT FbRenderState m FbRenderState
    -> StateT FbRenderState m HTMLMathMethod
    forall a b.
    (a -> b) -> StateT FbRenderState m a -> StateT FbRenderState m b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (WriterOptions -> HTMLMathMethod
    writerHTMLMathMethod (WriterOptions -> HTMLMathMethod)
    -> (FbRenderState -> WriterOptions)
    -> FbRenderState
    -> HTMLMathMethod
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FbRenderState -> WriterOptions
    writerOptions) StateT FbRenderState m FbRenderState
    forall s (m :: * -> *). MonadState s m => m s
    get
      case htmlMath of
        WebTeX Text
    url -> do
           let alt :: [Inline]
    alt = [Attr -> Text -> Inline
    Code Attr
    nullAttr Text
    formula]
           let imgurl :: Text
    imgurl = Text
    url Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text -> Text
    urlEncode Text
    formula
           let img :: Inline
    img = Attr -> [Inline] -> (Text, Text) -> Inline
    Image Attr
    nullAttr [Inline]
    alt (Text
    imgurl, Text
    "")
           ImageMode -> Inline -> StateT FbRenderState m [Content]
    forall (m :: * -> *).
    PandocMonad m =>
    ImageMode -> Inline -> FBM m [Content]
    insertImage ImageMode
    immode Inline
    img
        HTMLMathMethod
    _ -> [Content] -> StateT FbRenderState m [Content]
    forall a. a -> StateT FbRenderState m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [Text -> Text -> Content
    forall t. Node t => Text -> t -> Content
    el Text
    "code" Text
    formula]

    insertImage :: PandocMonad m => ImageMode -> Inline -> FBM m [Content]
    insertImage :: forall (m :: * -> *).
    PandocMonad m =>
    ImageMode -> Inline -> FBM m [Content]
    insertImage ImageMode
    immode (Image Attr
    _ [Inline]
    alt (Text
    url,Text
    ttl)) = do
      images <- FbRenderState -> [(Text, Text)]
    imagesToFetch (FbRenderState -> [(Text, Text)])
    -> StateT FbRenderState m FbRenderState
    -> StateT FbRenderState m [(Text, Text)]
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    `liftM` StateT FbRenderState m FbRenderState
    forall s (m :: * -> *). MonadState s m => m s
    get
      let n = Int
    1 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + [(Text, Text)] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [(Text, Text)]
    images
      let fname = Text
    "image" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Int -> Text
    forall a. Show a => a -> Text
    tshow Int
    n
      modify (\FbRenderState
    s -> FbRenderState
    s { imagesToFetch = (fname, url) : images })
      let ttlattr = case (ImageMode
    immode, Text -> Bool
    T.null Text
    ttl) of
                      (ImageMode
    NormalImage, Bool
    False) -> [ Text -> Text -> Attr
    uattr Text
    "title" Text
    ttl ]
                      (ImageMode, Bool)
    _                    -> []
      return . list $
             el "image" $
                [ attr ("l","href") ("#" <> fname)
                , attr ("l","type") (tshow immode)
                , uattr "alt" (mconcat $ map plain alt) ]
                ++ ttlattr
    insertImage ImageMode
    _ Inline
    _ = String -> StateT FbRenderState m [Content]
    forall a. HasCallStack => String -> a
    error String
    "unexpected inline instead of image"

    replaceImagesWithAlt :: [Text] -> Content -> Content
    replaceImagesWithAlt :: [Text] -> Content -> Content
    replaceImagesWithAlt [Text]
    missingHrefs = (forall a. Data a => a -> a) -> forall a. Data a => a -> a
    everywhere ((Content -> Content) -> a -> a
    forall a b. (Typeable a, Typeable b) => (b -> b) -> a -> a
    mkT Content -> Content
    go)
      where
        go :: Content -> Content
    go Content
    c = if Content -> Bool
    isMissing Content
    c
                  then Content -> Content
    replaceNode Content
    c
                  else Content
    c
        isMissing :: Content -> Bool
    isMissing (Elem img :: Element
    img@Element{}) =
            let imgAttrs :: [Attr]
    imgAttrs = Element -> [Attr]
    elAttribs Element
    img
                badAttrs :: [Attr]
    badAttrs = (Text -> Attr) -> [Text] -> [Attr]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Text, Text) -> Text -> Attr
    attr (Text
    "l",Text
    "href")) [Text]
    missingHrefs
            in  (Attr -> Bool) -> [Attr] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (Attr -> [Attr] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Attr]
    imgAttrs) [Attr]
    badAttrs
        isMissing Content
    _ = Bool
    False
      --
        replaceNode :: Content -> Content
        replaceNode :: Content -> Content
    replaceNode n :: Content
    n@(Elem img :: Element
    img@Element{}) =
            let attrs :: [Attr]
    attrs = Element -> [Attr]
    elAttribs Element
    img
                alt :: Maybe Text
    alt = [Attr] -> QName -> Maybe Text
    getAttrVal [Attr]
    attrs (Text -> QName
    unqual Text
    "alt")
                imtype :: Maybe Text
    imtype = [Attr] -> QName -> Maybe Text
    getAttrVal [Attr]
    attrs (Text -> Text -> QName
    qname Text
    "l" Text
    "type")
            in case (Maybe Text
    alt, Maybe Text
    imtype) of
                 (Just Text
    alt', Just Text
    imtype') ->
                     if Text
    imtype' Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == ImageMode -> Text
    forall a. Show a => a -> Text
    tshow ImageMode
    NormalImage
                     then Text -> Text -> Content
    forall t. Node t => Text -> t -> Content
    el Text
    "p" Text
    alt'
                     else Text -> Content
    txt Text
    alt'
                 (Just Text
    alt', Maybe Text
    Nothing) -> Text -> Content
    txt Text
    alt'  -- no type attribute
                 (Maybe Text, Maybe Text)
    _ -> Content
    n   -- don't replace if alt text is not found
        replaceNode Content
    n = Content
    n
      --
        getAttrVal :: [X.Attr] -> QName -> Maybe Text
        getAttrVal :: [Attr] -> QName -> Maybe Text
    getAttrVal [Attr]
    attrs QName
    name =
            case (Attr -> Bool) -> [Attr] -> [Attr]
    forall a. (a -> Bool) -> [a] -> [a]
    filter ((QName
    name QName -> QName -> Bool
    forall a. Eq a => a -> a -> Bool
    ==) (QName -> Bool) -> (Attr -> QName) -> Attr -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Attr -> QName
    attrKey) [Attr]
    attrs of
               (Attr
    a:[Attr]
    _) -> Text -> Maybe Text
    forall a. a -> Maybe a
    Just (Attr -> Text
    attrVal Attr
    a)
               [Attr]
    _     -> Maybe Text
    forall a. Maybe a
    Nothing

    -- | Wrap all inlines with an XML tag (given its unqualified name).
    wrap :: PandocMonad m => Text -> [Inline] -> FBM m Content
    wrap :: forall (m :: * -> *).
    PandocMonad m =>
    Text -> [Inline] -> FBM m Content
    wrap Text
    tagname [Inline]
    inlines = Text -> [Content] -> Content
    forall t. Node t => Text -> t -> Content
    el Text
    tagname ([Content] -> Content)
    -> StateT FbRenderState m [Content]
    -> StateT FbRenderState m Content
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    `liftM` (Inline -> StateT FbRenderState m [Content])
    -> [Inline] -> StateT FbRenderState m [Content]
    forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
    cMapM Inline -> StateT FbRenderState m [Content]
    forall (m :: * -> *). PandocMonad m => Inline -> FBM m [Content]
    toXml [Inline]
    inlines

    -- " Create a singleton list.
    list :: a -> [a]
    list :: forall a. a -> [a]
    list = (a -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :[])

    -- | Convert an 'Inline' to plaintext.
    plain :: Inline -> Text
    plain :: Inline -> Text
    plain (Str Text
    s)               = Text
    s
    plain (Emph [Inline]
    ss)             = [Text] -> Text
    forall a. Monoid a => [a] -> a
    mconcat ([Text] -> Text) -> [Text] -> Text
    forall a b. (a -> b) -> a -> b
    $ (Inline -> Text) -> [Inline] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map Inline -> Text
    plain [Inline]
    ss
    plain (Underline [Inline]
    ss)        = [Text] -> Text
    forall a. Monoid a => [a] -> a
    mconcat ([Text] -> Text) -> [Text] -> Text
    forall a b. (a -> b) -> a -> b
    $ (Inline -> Text) -> [Inline] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map Inline -> Text
    plain [Inline]
    ss
    plain (Span Attr
    _ [Inline]
    ss)           = [Text] -> Text
    forall a. Monoid a => [a] -> a
    mconcat ([Text] -> Text) -> [Text] -> Text
    forall a b. (a -> b) -> a -> b
    $ (Inline -> Text) -> [Inline] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map Inline -> Text
    plain [Inline]
    ss
    plain (Strong [Inline]
    ss)           = [Text] -> Text
    forall a. Monoid a => [a] -> a
    mconcat ([Text] -> Text) -> [Text] -> Text
    forall a b. (a -> b) -> a -> b
    $ (Inline -> Text) -> [Inline] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map Inline -> Text
    plain [Inline]
    ss
    plain (Strikeout [Inline]
    ss)        = [Text] -> Text
    forall a. Monoid a => [a] -> a
    mconcat ([Text] -> Text) -> [Text] -> Text
    forall a b. (a -> b) -> a -> b
    $ (Inline -> Text) -> [Inline] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map Inline -> Text
    plain [Inline]
    ss
    plain (Superscript [Inline]
    ss)      = [Text] -> Text
    forall a. Monoid a => [a] -> a
    mconcat ([Text] -> Text) -> [Text] -> Text
    forall a b. (a -> b) -> a -> b
    $ (Inline -> Text) -> [Inline] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map Inline -> Text
    plain [Inline]
    ss
    plain (Subscript [Inline]
    ss)        = [Text] -> Text
    forall a. Monoid a => [a] -> a
    mconcat ([Text] -> Text) -> [Text] -> Text
    forall a b. (a -> b) -> a -> b
    $ (Inline -> Text) -> [Inline] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map Inline -> Text
    plain [Inline]
    ss
    plain (SmallCaps [Inline]
    ss)        = [Text] -> Text
    forall a. Monoid a => [a] -> a
    mconcat ([Text] -> Text) -> [Text] -> Text
    forall a b. (a -> b) -> a -> b
    $ (Inline -> Text) -> [Inline] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map Inline -> Text
    plain [Inline]
    ss
    plain (Quoted QuoteType
    _ [Inline]
    ss)         = [Text] -> Text
    forall a. Monoid a => [a] -> a
    mconcat ([Text] -> Text) -> [Text] -> Text
    forall a b. (a -> b) -> a -> b
    $ (Inline -> Text) -> [Inline] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map Inline -> Text
    plain [Inline]
    ss
    plain (Cite [Citation]
    _ [Inline]
    ss)           = [Text] -> Text
    forall a. Monoid a => [a] -> a
    mconcat ([Text] -> Text) -> [Text] -> Text
    forall a b. (a -> b) -> a -> b
    $ (Inline -> Text) -> [Inline] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map Inline -> Text
    plain [Inline]
    ss  -- FIXME
    plain (Code Attr
    _ Text
    s)            = Text
    s
    plain Inline
    Space                 = Text
    " "
    plain Inline
    SoftBreak             = Text
    " "
    plain Inline
    LineBreak             = Text
    "\n"
    plain (Math MathType
    _ Text
    s)            = Text
    s
    plain (RawInline Format
    _ Text
    _)       = Text
    ""
    plain (Link Attr
    _ [Inline]
    text (Text
    url,Text
    _)) = [Text] -> Text
    forall a. Monoid a => [a] -> a
    mconcat ((Inline -> Text) -> [Inline] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map Inline -> Text
    plain [Inline]
    text [Text] -> [Text] -> [Text]
    forall a. [a] -> [a] -> [a]
    ++ [Text
    " <", Text
    url, Text
    ">"])
    plain (Image Attr
    _ [Inline]
    alt (Text, Text)
    _)       = [Text] -> Text
    forall a. Monoid a => [a] -> a
    mconcat ([Text] -> Text) -> [Text] -> Text
    forall a b. (a -> b) -> a -> b
    $ (Inline -> Text) -> [Inline] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map Inline -> Text
    plain [Inline]
    alt
    plain (Note [Block]
    _)              = Text
    ""  -- FIXME

    -- | Create an XML element.
    el :: (Node t)
       => Text     -- ^ unqualified element name
       -> t        -- ^ node contents
       -> Content  -- ^ XML content
    el :: forall t. Node t => Text -> t -> Content
    el Text
    name t
    cs = Element -> Content
    Elem (Element -> Content) -> Element -> Content
    forall a b. (a -> b) -> a -> b
    $ Text -> t -> Element
    forall t. Node t => Text -> t -> Element
    unode Text
    name t
    cs

    -- | Put empty lines around content
    spaceBeforeAfter :: [Content] -> [Content]
    spaceBeforeAfter :: [Content] -> [Content]
    spaceBeforeAfter [Content]
    cs =
        let emptyline :: Content
    emptyline = Text -> () -> Content
    forall t. Node t => Text -> t -> Content
    el Text
    "empty-line" ()
        in  [Content
    emptyline] [Content] -> [Content] -> [Content]
    forall a. [a] -> [a] -> [a]
    ++ [Content]
    cs [Content] -> [Content] -> [Content]
    forall a. [a] -> [a] -> [a]
    ++ [Content
    emptyline]

    -- | Create a plain-text XML content.
    txt :: Text -> Content
    txt :: Text -> Content
    txt Text
    s = CData -> Content
    Text (CData -> Content) -> CData -> Content
    forall a b. (a -> b) -> a -> b
    $ CDataKind -> Text -> Maybe Integer -> CData
    CData CDataKind
    CDataText Text
    s Maybe Integer
    forall a. Maybe a
    Nothing

    -- | Create an XML attribute with an unqualified name.
    uattr :: Text -> Text -> X.Attr
    uattr :: Text -> Text -> Attr
    uattr Text
    name = QName -> Text -> Attr
    Attr (Text -> QName
    unqual Text
    name)

    -- | Create an XML attribute with a qualified name from given namespace.
    attr :: (Text, Text) -> Text -> X.Attr
    attr :: (Text, Text) -> Text -> Attr
    attr (Text
    ns, Text
    name) = QName -> Text -> Attr
    Attr (Text -> Text -> QName
    qname Text
    ns Text
    name)

    -- | Qualified name
    qname :: Text -> Text -> QName
    qname :: Text -> Text -> QName
    qname Text
    ns Text
    name = Text -> Maybe Text -> Maybe Text -> QName
    QName Text
    name Maybe Text
    forall a. Maybe a
    Nothing (Text -> Maybe Text
    forall a. a -> Maybe a
    Just Text
    ns)

    -- | Abbreviation for 'concatMap'.
    cMap :: (a -> [b]) -> [a] -> [b]
    cMap :: forall a b. (a -> [b]) -> [a] -> [b]
    cMap = (a -> [b]) -> [a] -> [b]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap

    -- | Monadic equivalent of 'concatMap'.
    cMapM :: (Monad m) => (a -> m [b]) -> [a] -> m [b]
    cMapM :: forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
    cMapM a -> m [b]
    f [a]
    xs = [[b]] -> [b]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([[b]] -> [b]) -> m [[b]] -> m [b]
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    `liftM` (a -> m [b]) -> [a] -> m [[b]]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM a -> m [b]
    f [a]
    xs