{-# LANGUAGE PatternGuards     #-}
{-# LANGUAGE OverloadedStrings #-}
{- |
Module      : Text.Pandoc.Writers.FB2
Copyright   : Copyright (C) 2011-2012 Sergey Astanin
                            2012-2023 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 (encodeBase64)
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 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FbRenderState] -> ShowS
$cshowList :: [FbRenderState] -> ShowS
show :: FbRenderState -> String
$cshow :: FbRenderState -> String
showsPrec :: Int -> FbRenderState -> ShowS
$cshowsPrec :: Int -> 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 = forall a. Default a => a
def }

data ImageMode = NormalImage | InlineImage deriving (ImageMode -> ImageMode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ImageMode -> ImageMode -> Bool
$c/= :: ImageMode -> ImageMode -> Bool
== :: ImageMode -> ImageMode -> Bool
$c== :: 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 = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT FbRenderState
newFB forall a b. (a -> b) -> a -> b
$ 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
     forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\FbRenderState
s -> FbRenderState
s { writerOptions :: WriterOptions
writerOptions = WriterOptions
opts })
     Content
desc <- forall (m :: * -> *). PandocMonad m => Meta -> FBM m Content
description Meta
meta
     [Content]
title <- forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
cMapM forall (m :: * -> *). PandocMonad m => Inline -> FBM m [Content]
toXml forall b c a. (b -> c) -> (a -> b) -> a -> c
. Meta -> [Inline]
docTitle forall a b. (a -> b) -> a -> b
$ Meta
meta
     [Content]
secs <- forall (m :: * -> *).
PandocMonad m =>
Int -> [Block] -> FBM m [Content]
renderSections Int
1 [Block]
blocks
     let body :: Content
body = forall t. Node t => Text -> t -> Content
el Text
"body" forall a b. (a -> b) -> a -> b
$ forall t. Node t => Text -> t -> Content
el Text
"title" (forall t. Node t => Text -> t -> Content
el Text
"p" [Content]
title) forall a. a -> [a] -> [a]
: [Content]
secs
     [Content]
notes <- forall (m :: * -> *). PandocMonad m => FBM m [Content]
renderFootnotes
     ([Content]
imgs,[Text]
missing) <- forall s (m :: * -> *). MonadState s m => m s
get forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
PandocMonad m =>
[(Text, Text)] -> m ([Content], [Text])
fetchImages forall b c a. (b -> c) -> (a -> b) -> a -> c
. FbRenderState -> [(Text, Text)]
imagesToFetch)
     let body' :: Content
body' = [Text] -> Content -> Content
replaceImagesWithAlt [Text]
missing Content
body
     let fb2_xml :: Content
fb2_xml = forall t. Node t => Text -> t -> Content
el Text
"FictionBook" ([Attr]
fb2_attrs, [Content
desc, Content
body'] forall a. [a] -> [a] -> [a]
++ [Content]
notes forall a. [a] -> [a] -> [a]
++ [Content]
imgs)
     forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text
xml_head forall a. Semigroup a => a -> a -> a
<> Content -> Text
showContent Content
fb2_xml forall a. Semigroup a => a -> a -> a
<> Text
"\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
"" -> forall t. Node t => Text -> t -> Content
el Text
"genre" (Text
"unrecognised" :: Text)
                Text
s  -> forall t. Node t => Text -> t -> Content
el Text
"genre" Text
s
  [Content]
bt <- forall (m :: * -> *). PandocMonad m => Meta -> FBM m [Content]
booktitle Meta
meta'
  let as :: [Content]
as = Meta -> [Content]
authors Meta
meta'
  [Content]
dd <- forall (m :: * -> *). PandocMonad m => Meta -> FBM m [Content]
docdate Meta
meta'
  [Content]
annotation <- case Text -> Meta -> Maybe MetaValue
lookupMeta Text
"abstract" Meta
meta' of
                  Just (MetaBlocks [Block]
bs) -> forall a. a -> [a]
list forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Node t => Text -> t -> Content
el Text
"annotation" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
cMapM forall (m :: * -> *). PandocMonad m => Block -> FBM m [Content]
blockToXml (forall a b. (a -> b) -> [a] -> [b]
map Block -> Block
unPlain [Block]
bs)
                  Maybe MetaValue
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty
  let lang :: [Content]
lang = case Text -> Meta -> Maybe MetaValue
lookupMeta Text
"lang" Meta
meta' of
               Just (MetaInlines [Str Text
s]) -> [forall t. Node t => Text -> t -> Content
el Text
"lang" forall a b. (a -> b) -> a -> b
$ Text -> Text
iso639 Text
s]
               Just (MetaString Text
s)        -> [forall t. Node t => Text -> t -> Content
el Text
"lang" 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 (forall a. Eq a => a -> a -> Bool
/= Char
'-') -- Convert BCP 47 to ISO 639
  let coverimage :: Text -> StateT FbRenderState m [Content]
coverimage Text
url = do
        let img :: Inline
img = Attr -> [Inline] -> (Text, Text) -> Inline
Image Attr
nullAttr forall a. Monoid a => a
mempty (Text
url, Text
"")
        [Content]
im <- forall (m :: * -> *).
PandocMonad m =>
ImageMode -> Inline -> FBM m [Content]
insertImage ImageMode
InlineImage Inline
img
        forall (m :: * -> *) a. Monad m => a -> m a
return [forall t. Node t => Text -> t -> Content
el Text
"coverpage" [Content]
im]
  [Content]
coverpage <- case Text -> Meta -> Maybe MetaValue
lookupMeta Text
"cover-image" Meta
meta' of
                    Just (MetaInlines [Inline]
ils) -> forall {m :: * -> *}.
PandocMonad m =>
Text -> StateT FbRenderState m [Content]
coverimage (forall a. Walkable Inline a => a -> Text
stringify [Inline]
ils)
                    Just (MetaString Text
s) -> forall {m :: * -> *}.
PandocMonad m =>
Text -> StateT FbRenderState m [Content]
coverimage Text
s
                    Maybe MetaValue
_       -> forall (m :: * -> *) a. Monad m => a -> m a
return []
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall t. Node t => Text -> t -> Content
el Text
"description"
    [ forall t. Node t => Text -> t -> Content
el Text
"title-info" (Content
genre forall a. a -> [a] -> [a]
:
                      ([Content]
as forall a. [a] -> [a] -> [a]
++ [Content]
bt forall a. [a] -> [a] -> [a]
++ [Content]
annotation forall a. [a] -> [a] -> [a]
++ [Content]
dd forall a. [a] -> [a] -> [a]
++ [Content]
coverpage forall a. [a] -> [a] -> [a]
++ [Content]
lang))
    , forall t. Node t => Text -> t -> Content
el Text
"document-info" [forall t. Node t => Text -> t -> Content
el Text
"program-used" (Text
"pandoc" :: Text)]
    ]

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

authors :: Meta -> [Content]
authors :: Meta -> [Content]
authors Meta
meta' = 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 forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Inline -> Text
plain [Inline]
ss
      email :: [Content]
email = forall t. Node t => Text -> t -> Content
el Text
"email" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Int -> [a] -> [a]
take Int
1 (forall a. (a -> Bool) -> [a] -> [a]
filter ((Char -> Bool) -> Text -> Bool
T.any (forall a. Eq a => a -> a -> Bool
==Char
'@')) [Text]
ws)
      ws' :: [Text]
ws' = forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Bool
T.any (forall a. Eq a => a -> a -> Bool
== Char
'@')) [Text]
ws
      names :: [Content]
names = case [Text]
ws' of
                [Text
nickname] -> [ forall t. Node t => Text -> t -> Content
el Text
"nickname" Text
nickname ]
                [Text
fname, Text
lname] -> [ forall t. Node t => Text -> t -> Content
el Text
"first-name" Text
fname
                                    , forall t. Node t => Text -> t -> Content
el Text
"last-name" Text
lname ]
                (Text
fname:[Text]
rest) -> [ forall t. Node t => Text -> t -> Content
el Text
"first-name" Text
fname
                                , forall t. Node t => Text -> t -> Content
el Text
"middle-name" ([Text] -> Text
T.concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
init forall a b. (a -> b) -> a -> b
$ [Text]
rest)
                                , forall t. Node t => Text -> t -> Content
el Text
"last-name" (forall a. [a] -> a
last [Text]
rest) ]
                [] -> []
  in  forall a. a -> [a]
list forall a b. (a -> b) -> a -> b
$ forall t. Node t => Text -> t -> Content
el Text
"author" ([Content]
names 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'
  [Content]
d <- forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
cMapM forall (m :: * -> *). PandocMonad m => Inline -> FBM m [Content]
toXml [Inline]
ss
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [forall t. Node t => Text -> t -> Content
el Text
"date" [Content]
d | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Content]
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 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) = forall a. (a -> Bool) -> [a] -> ([a], [a])
break Block -> Bool
isSection [Block]
blocks'
    let blocks'' :: [Block]
blocks'' = if 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 forall a. Monoid a => a
mempty forall a. a -> [a] -> [a]
: [Block]
initialBlocks) forall a. a -> [a] -> [a]
: [Block]
secs
    forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
cMapM (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
  [Content]
title' <- if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
title
            then forall (m :: * -> *) a. Monad m => a -> m a
return []
            else forall a. a -> [a]
list forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Node t => Text -> t -> Content
el Text
"title" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). PandocMonad m => [Inline] -> FBM m [Content]
formatTitle [Inline]
title
  [Content]
content <- forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
cMapM (forall (m :: * -> *).
PandocMonad m =>
Int -> Block -> FBM m [Content]
renderSection (Int
lvl forall a. Num a => a -> a -> a
+ Int
1)) [Block]
xs
  let sectionContent :: Content
sectionContent = if Text -> Bool
T.null Text
id'
      then forall t. Node t => Text -> t -> Content
el Text
"section" ([Content]
title' forall a. [a] -> [a] -> [a]
++ [Content]
content)
      else forall t. Node t => Text -> t -> Content
el Text
"section" ([Text -> Text -> Attr
uattr Text
"id" Text
id'], [Content]
title' forall a. [a] -> [a] -> [a]
++ [Content]
content)
  forall (m :: * -> *) a. Monad m => a -> m a
return [Content
sectionContent]
renderSection Int
lvl (Div Attr
_attr [Block]
bs) =
  forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
cMapM (forall (m :: * -> *).
PandocMonad m =>
Int -> Block -> FBM m [Content]
renderSection Int
lvl) [Block]
bs
renderSection Int
_ Block
b = 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 =
  forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
cMapM (forall (m :: * -> *). PandocMonad m => Block -> FBM m [Content]
blockToXml forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> Block
Para) forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [[a]]
split (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) = forall a. (a -> Bool) -> [a] -> ([a], [a])
break a -> Bool
cond [a]
xs
                in  ([a]
bforall a. a -> [a] -> [a]
:forall a. (a -> Bool) -> [a] -> [[a]]
split a -> Bool
cond (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
  [(Int, Text, [Content])]
fns <- FbRenderState -> [(Int, Text, [Content])]
footnotes forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` forall s (m :: * -> *). MonadState s m => m s
get
  if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Int, Text, [Content])]
fns
    then forall (m :: * -> *) a. Monad m => a -> m a
return []  -- no footnotes
    else forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> [a]
list forall a b. (a -> b) -> a -> b
$
         forall t. Node t => Text -> t -> Content
el Text
"body" ([Text -> Text -> Attr
uattr Text
"name" Text
"notes"], forall a b. (a -> b) -> [a] -> [b]
map forall {a}. Show a => (a, Text, [Content]) -> Content
renderFN (forall a. [a] -> [a]
reverse [(Int, Text, [Content])]
fns))
  where
    renderFN :: (a, Text, [Content]) -> Content
renderFN (a
n, Text
idstr, [Content]
cs) =
        let fn_texts :: [Content]
fn_texts = forall t. Node t => Text -> t -> Content
el Text
"title" (forall t. Node t => Text -> t -> Content
el Text
"p" (forall a. Show a => a -> Text
tshow a
n)) forall a. a -> [a] -> [a]
: [Content]
cs
        in  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
    [Either Text Content]
imgs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall (m :: * -> *).
PandocMonad m =>
Text -> Text -> m (Either Text Content)
fetchImage) [(Text, Text)]
links
    forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. [Either a b] -> [b]
rights [Either Text Content]
imgs, forall a b. [Either a b] -> [a]
lefts [Either Text Content]
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
  Maybe (Text, Text)
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' forall a. Eq a => a -> a -> Bool
== Text
"image/png" Bool -> Bool -> Bool
|| Text
mime' forall a. Eq a => a -> a -> Bool
== Text
"image/jpeg"
              then forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just (Text
mime',Text
base64))
              else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
       (Bool
True, Just (Text, Text, Bool, Text)
_) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing  -- not base64-encoded
       (Bool, Maybe (Text, Text, Bool, Text))
_               ->
         forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError (do (ByteString
bs, Maybe Text
mbmime) <- forall (m :: * -> *).
PandocMonad m =>
Text -> m (ByteString, Maybe Text)
P.fetchItem Text
link
                        case Maybe Text
mbmime of
                             Maybe Text
Nothing -> do
                               forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report forall a b. (a -> b) -> a -> b
$ Text -> LogMessage
CouldNotDetermineMimeType Text
link
                               forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
                             Just Text
mime -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (Text
mime,
                                                        ByteString -> Text
encodeBase64 ByteString
bs))
                    (\PandocError
e ->
                       do forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report forall a b. (a -> b) -> a -> b
$ Text -> Text -> LogMessage
CouldNotFetchResource Text
link (forall a. Show a => a -> Text
tshow PandocError
e)
                          forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing)
  case Maybe (Text, Text)
mbimg of
    Just (Text
imgtype, Text
imgdata) ->
        forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ 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)
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left (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   -> forall a. Maybe a
Nothing
    Just Text
rest ->
      let meta :: Text
meta = (Char -> Bool) -> Text -> Text
T.takeWhile (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 forall a. Num a => a -> a -> a
+ Int
1) Text
rest
          parts :: [Text]
parts = (Char -> Bool) -> Text -> [Text]
T.split (forall a. Eq a => a -> a -> Bool
== Char
';') Text
meta
          (Text
mime,Text
cs,Bool
enc)=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  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 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 (forall a. Eq a => a -> a -> Bool
==Char
'/') Text
s of
      [Text
mtype,Text
msubtype] ->
          (Text -> Text
T.toLower Text
mtype 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 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" forall a. Semigroup a => a -> a -> a
<> 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
  Text
pmrk <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets FbRenderState -> Text
parentListMarker
  let nmrk :: Text
nmrk = Text
pmrk forall a. Semigroup a => a -> a -> a
<> Text
mrk forall a. Semigroup a => a -> a -> a
<> Text
" "
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\FbRenderState
s -> FbRenderState
s { parentListMarker :: Text
parentListMarker = Text
nmrk})
  [Content]
item <- forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
cMapM forall (m :: * -> *). PandocMonad m => Block -> FBM m [Content]
blockToXml forall a b. (a -> b) -> a -> b
$ [Block] -> [Block]
plainToPara forall a b. (a -> b) -> a -> b
$ Text -> [Block] -> [Block]
indentBlocks Text
nmrk [Block]
bs
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\FbRenderState
s -> FbRenderState
s { parentListMarker :: Text
parentListMarker = Text
pmrk }) -- old parent marker
  forall (m :: * -> *) a. Monad m => a -> m a
return [Content]
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 {}]) = forall (m :: * -> *).
PandocMonad m =>
ImageMode -> Inline -> FBM m [Content]
insertImage ImageMode
NormalImage Inline
img
blockToXml (Plain [Inline]
ss) = forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
cMapM 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]) = forall (m :: * -> *).
PandocMonad m =>
ImageMode -> Text -> FBM m [Content]
insertMath ImageMode
NormalImage Text
formula
blockToXml (Para [img :: Inline
img@(Image {})]) = forall (m :: * -> *).
PandocMonad m =>
ImageMode -> Inline -> FBM m [Content]
insertImage ImageMode
NormalImage Inline
img
blockToXml (Para [Inline]
ss) = forall a. a -> [a]
list forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Node t => Text -> t -> Content
el Text
"p" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
cMapM forall (m :: * -> *). PandocMonad m => Inline -> FBM m [Content]
toXml [Inline]
ss
blockToXml (CodeBlock Attr
_ Text
s) = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Content] -> [Content]
spaceBeforeAfter forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                             forall a b. (a -> b) -> [a] -> [b]
map (forall t. Node t => Text -> t -> Content
el Text
"p" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Node t => Text -> t -> Content
el Text
"code") forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.lines forall a b. (a -> b) -> a -> b
$ Text
s
blockToXml (RawBlock Format
f Text
str) =
  if Format
f 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  -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ Text -> Text -> PandocError
PandocXMLError Text
"" Text
msg
         Right [Content]
nds -> forall (m :: * -> *) a. Monad m => a -> m a
return [Content]
nds
    else forall (m :: * -> *) a. Monad m => a -> m a
return []
blockToXml (Div Attr
_ [Block]
bs) = forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
cMapM forall (m :: * -> *). PandocMonad m => Block -> FBM m [Content]
blockToXml [Block]
bs
blockToXml (BlockQuote [Block]
bs) = forall a. a -> [a]
list forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Node t => Text -> t -> Content
el Text
"cite" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
cMapM forall (m :: * -> *). PandocMonad m => Block -> FBM m [Content]
blockToXml [Block]
bs
blockToXml (LineBlock [[Inline]]
lns) =
  forall a. a -> [a]
list forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Node t => Text -> t -> Content
el Text
"poem" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall {t :: * -> *} {m :: * -> *}.
(Node (t Content), Traversable t, PandocMonad m) =>
t [Inline] -> StateT FbRenderState m Content
stanza (forall a. (a -> Bool) -> [a] -> [[a]]
split forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Inline]]
lns)
  where
    v :: [Inline] -> StateT FbRenderState m Content
v [Inline]
xs = forall t. Node t => Text -> t -> Content
el Text
"v" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
cMapM forall (m :: * -> *). PandocMonad m => Inline -> FBM m [Content]
toXml [Inline]
xs
    stanza :: t [Inline] -> StateT FbRenderState m Content
stanza t [Inline]
xs = forall t. Node t => Text -> t -> Content
el Text
"stanza" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall {m :: * -> *}.
PandocMonad m =>
[Inline] -> StateT FbRenderState m Content
v t [Inline]
xs
blockToXml (OrderedList ListAttributes
a [[Block]]
bss) =
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM 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) =
    forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
cMapM (forall (m :: * -> *).
PandocMonad m =>
Text -> [Block] -> FBM m [Content]
mkitem Text
"•") [[Block]]
bss
blockToXml (DefinitionList [([Inline], [[Block]])]
defs) =
    forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
cMapM 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
          [Content]
items <- forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
cMapM (forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
cMapM forall (m :: * -> *). PandocMonad m => Block -> FBM m [Content]
blockToXml forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Block] -> [Block]
plainToPara forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Block] -> [Block]
indentBlocks (Int -> Text -> Text
T.replicate Int
4 Text
" ")) [[Block]]
bss
          Content
t <- forall (m :: * -> *).
PandocMonad m =>
Text -> [Inline] -> FBM m Content
wrap Text
"strong" [Inline]
term
          forall (m :: * -> *) a. Monad m => a -> m a
return (forall t. Node t => Text -> t -> Content
el Text
"p" Content
t forall a. a -> [a] -> [a]
: [Content]
items)
blockToXml h :: Block
h@Header{} = do
  -- should not occur after makeSections, except inside lists/blockquotes
  forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report forall a b. (a -> b) -> a -> b
$ Block -> LogMessage
BlockNotRendered Block
h
  forall (m :: * -> *) a. Monad m => a -> m a
return []
blockToXml Block
HorizontalRule = forall (m :: * -> *) a. Monad m => a -> m a
return [ 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
    [Content]
hd <- if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Block]]
headers then forall (f :: * -> *) a. Applicative f => a -> f a
pure [] else (forall a. a -> [a] -> [a]
:[]) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
PandocMonad m =>
Text -> [[Block]] -> [Alignment] -> FBM m Content
mkrow Text
"th" [[Block]]
headers [Alignment]
aligns
    [Content]
bd <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\[[Block]]
r -> forall (m :: * -> *).
PandocMonad m =>
Text -> [[Block]] -> [Alignment] -> FBM m Content
mkrow Text
"td" [[Block]]
r [Alignment]
aligns) [[[Block]]]
rows
    Content
c <- forall t. Node t => Text -> t -> Content
el Text
"emphasis" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
cMapM forall (m :: * -> *). PandocMonad m => Inline -> FBM m [Content]
toXml [Inline]
caption
    forall (m :: * -> *) a. Monad m => a -> m a
return [forall t. Node t => Text -> t -> Content
el Text
"table" ([Content]
hd forall a. Semigroup a => a -> a -> a
<> [Content]
bd), forall t. Node t => Text -> t -> Content
el Text
"p" Content
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' =
        forall t. Node t => Text -> t -> Content
el Text
"tr" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *).
PandocMonad m =>
Text -> ([Block], Alignment) -> FBM m Content
mkcell Text
tag) (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
        [Content]
cblocks <- forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
cMapM forall (m :: * -> *). PandocMonad m => Block -> FBM m [Content]
blockToXml [Block]
cell
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall t. Node t => Text -> t -> Content
el Text
tag ([Alignment -> Attr
align_attr Alignment
align], [Content]
cblocks)
      --
      align_attr :: Alignment -> Attr
align_attr Alignment
a = QName -> Text -> Attr
Attr (Text -> Maybe Text -> Maybe Text -> QName
QName Text
"align" forall a. Maybe a
Nothing forall a. Maybe a
Nothing) (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 forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
cMapM forall (m :: * -> *). PandocMonad m => Block -> FBM m [Content]
blockToXml (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 forall a. a -> [a] -> [a]
: [Block] -> [Block]
plainToPara [Block]
rest
plainToPara (Para [Inline]
inlines : [Block]
rest) =
    [Inline] -> Block
Para [Inline]
inlines forall a. a -> [a] -> [a]
: Block
HorizontalRule forall a. a -> [a] -> [a]
: [Block] -> [Block]
plainToPara [Block]
rest -- HorizontalRule will be converted to <empty-line />
plainToPara (Block
p:[Block]
rest) = Block
p 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
spacerforall a. a -> [a] -> [a]
:[Inline]
ins)
  indentBlock (Para [Inline]
ins) = [Inline] -> Block
Para (Text -> Inline
Str Text
spacerforall a. a -> [a] -> [a]
:[Inline]
ins)
  indentBlock (CodeBlock Attr
a Text
s) =
    let s' :: Text
s' = [Text] -> Text
T.unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (Text
spacerforall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.lines 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 (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 = forall a. (a -> Bool) -> [a] -> [[a]]
split Inline -> Bool
isLineBreak [Inline]
ins :: [[Inline]]
                    in  forall a. [a] -> [[a]] -> [a]
intercalate [Inline
LineBreak] forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Text -> Inline
Str Text
spacerforall 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 forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (Text -> Block -> Block
indentPrefix 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) = forall (m :: * -> *) a. Monad m => a -> m a
return [Text -> Content
txt Text
s]
toXml (Span Attr
_ [Inline]
ils) = forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
cMapM forall (m :: * -> *). PandocMonad m => Inline -> FBM m [Content]
toXml [Inline]
ils
toXml (Emph [Inline]
ss) = forall a. a -> [a]
list forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` forall (m :: * -> *).
PandocMonad m =>
Text -> [Inline] -> FBM m Content
wrap Text
"emphasis" [Inline]
ss
toXml (Underline [Inline]
ss) = forall a. a -> [a]
list forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` forall (m :: * -> *).
PandocMonad m =>
Text -> [Inline] -> FBM m Content
wrap Text
"underline" [Inline]
ss
toXml (Strong [Inline]
ss) = forall a. a -> [a]
list forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` forall (m :: * -> *).
PandocMonad m =>
Text -> [Inline] -> FBM m Content
wrap Text
"strong" [Inline]
ss
toXml (Strikeout [Inline]
ss) = forall a. a -> [a]
list forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` forall (m :: * -> *).
PandocMonad m =>
Text -> [Inline] -> FBM m Content
wrap Text
"strikethrough" [Inline]
ss
toXml (Superscript [Inline]
ss) = forall a. a -> [a]
list forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` forall (m :: * -> *).
PandocMonad m =>
Text -> [Inline] -> FBM m Content
wrap Text
"sup" [Inline]
ss
toXml (Subscript [Inline]
ss) = forall a. a -> [a]
list forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` forall (m :: * -> *).
PandocMonad m =>
Text -> [Inline] -> FBM m Content
wrap Text
"sub" [Inline]
ss
toXml (SmallCaps [Inline]
ss) = forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
cMapM forall (m :: * -> *). PandocMonad m => Inline -> FBM m [Content]
toXml forall a b. (a -> b) -> a -> b
$ forall a. Walkable Inline a => a -> a
capitalize [Inline]
ss
toXml (Quoted QuoteType
SingleQuote [Inline]
ss) = do  -- FIXME: should be language-specific
  [Content]
inner <- forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
cMapM forall (m :: * -> *). PandocMonad m => Inline -> FBM m [Content]
toXml [Inline]
ss
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Text -> Content
txt Text
"‘"] forall a. [a] -> [a] -> [a]
++ [Content]
inner forall a. [a] -> [a] -> [a]
++ [Text -> Content
txt Text
"’"]
toXml (Quoted QuoteType
DoubleQuote [Inline]
ss) = do
  [Content]
inner <- forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
cMapM forall (m :: * -> *). PandocMonad m => Inline -> FBM m [Content]
toXml [Inline]
ss
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Text -> Content
txt Text
"“"] forall a. [a] -> [a] -> [a]
++ [Content]
inner forall a. [a] -> [a] -> [a]
++ [Text -> Content
txt Text
"”"]
toXml (Cite [Citation]
_ [Inline]
ss) = forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
cMapM forall (m :: * -> *). PandocMonad m => Inline -> FBM m [Content]
toXml [Inline]
ss  -- FIXME: support citation styles
toXml (Code Attr
_ Text
s) = forall (m :: * -> *) a. Monad m => a -> m a
return [forall t. Node t => Text -> t -> Content
el Text
"code" Text
s]
toXml Inline
Space = forall (m :: * -> *) a. Monad m => a -> m a
return [Text -> Content
txt Text
" "]
toXml Inline
SoftBreak = forall (m :: * -> *) a. Monad m => a -> m a
return [Text -> Content
txt Text
"\n"]
toXml Inline
LineBreak = forall (m :: * -> *) a. Monad m => a -> m a
return [Text -> Content
txt Text
"\n"]
toXml (Math MathType
_ Text
formula) = forall (m :: * -> *).
PandocMonad m =>
ImageMode -> Text -> FBM m [Content]
insertMath ImageMode
InlineImage Text
formula
toXml il :: Inline
il@(RawInline Format
_ Text
_) = do
  forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report forall a b. (a -> b) -> a -> b
$ Inline -> LogMessage
InlineNotRendered Inline
il
  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
  [Content]
ln_text <- forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
cMapM forall (m :: * -> *). PandocMonad m => Inline -> FBM m [Content]
toXml [Inline]
text
  forall (m :: * -> *) a. Monad m => a -> m a
return [ forall t. Node t => Text -> t -> Content
el Text
"a" ( [ (Text, Text) -> Text -> Attr
attr (Text
"l",Text
"href") Text
url ], [Content]
ln_text) ]
toXml img :: Inline
img@Image{} = forall (m :: * -> *).
PandocMonad m =>
ImageMode -> Inline -> FBM m [Content]
insertImage ImageMode
InlineImage Inline
img
toXml (Note [Block]
bs) = do
  [(Int, Text, [Content])]
fns <- FbRenderState -> [(Int, Text, [Content])]
footnotes forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` forall s (m :: * -> *). MonadState s m => m s
get
  let n :: Int
n = Int
1 forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Int, Text, [Content])]
fns
  let fn_id :: Text
fn_id = Int -> Text
footnoteID Int
n
  [Content]
fn_desc <- forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
cMapM forall (m :: * -> *). PandocMonad m => Block -> FBM m [Content]
blockToXml [Block]
bs
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\FbRenderState
s -> FbRenderState
s { footnotes :: [(Int, Text, [Content])]
footnotes = (Int
n, Text
fn_id, [Content]
fn_desc) forall a. a -> [a] -> [a]
: [(Int, Text, [Content])]
fns })
  let fn_ref :: Content
fn_ref = Text -> Content
txt forall a b. (a -> b) -> a -> b
$ Text
"[" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow Int
n forall a. Semigroup a => a -> a -> a
<> Text
"]"
  forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> [a]
list forall a b. (a -> b) -> a -> b
$ forall t. Node t => Text -> t -> Content
el Text
"a" ( [ (Text, Text) -> Text -> Attr
attr (Text
"l",Text
"href") (Text
"#" forall a. Semigroup a => a -> a -> a
<> Text
fn_id)
                           , Text -> Text -> Attr
uattr Text
"type" Text
"note" ]
                         , Content
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
  HTMLMathMethod
htmlMath <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (WriterOptions -> HTMLMathMethod
writerHTMLMathMethod forall b c a. (b -> c) -> (a -> b) -> a -> c
. FbRenderState -> WriterOptions
writerOptions) forall s (m :: * -> *). MonadState s m => m s
get
  case HTMLMathMethod
htmlMath of
    WebTeX Text
url -> do
       let alt :: [Inline]
alt = [Attr -> Text -> Inline
Code Attr
nullAttr Text
formula]
       let imgurl :: Text
imgurl = Text
url 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
"")
       forall (m :: * -> *).
PandocMonad m =>
ImageMode -> Inline -> FBM m [Content]
insertImage ImageMode
immode Inline
img
    HTMLMathMethod
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return [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
  [(Text, Text)]
images <- FbRenderState -> [(Text, Text)]
imagesToFetch forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` forall s (m :: * -> *). MonadState s m => m s
get
  let n :: Int
n = Int
1 forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Text, Text)]
images
  let fname :: Text
fname = Text
"image" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow Int
n
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\FbRenderState
s -> FbRenderState
s { imagesToFetch :: [(Text, Text)]
imagesToFetch = (Text
fname, Text
url) forall a. a -> [a] -> [a]
: [(Text, Text)]
images })
  let ttlattr :: [Attr]
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)
_                    -> []
  forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> [a]
list forall a b. (a -> b) -> a -> b
$
         forall t. Node t => Text -> t -> Content
el Text
"image" forall a b. (a -> b) -> a -> b
$
            [ (Text, Text) -> Text -> Attr
attr (Text
"l",Text
"href") (Text
"#" forall a. Semigroup a => a -> a -> a
<> Text
fname)
            , (Text, Text) -> Text -> Attr
attr (Text
"l",Text
"type") (forall a. Show a => a -> Text
tshow ImageMode
immode)
            , Text -> Text -> Attr
uattr Text
"alt" (forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Inline -> Text
plain [Inline]
alt) ]
            forall a. [a] -> [a] -> [a]
++ [Attr]
ttlattr
insertImage ImageMode
_ Inline
_ = 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 (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 = forall a b. (a -> b) -> [a] -> [b]
map ((Text, Text) -> Text -> Attr
attr (Text
"l",Text
"href")) [Text]
missingHrefs
        in  forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (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' forall a. Eq a => a -> a -> Bool
== forall a. Show a => a -> Text
tshow ImageMode
NormalImage
                 then 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 forall a. (a -> Bool) -> [a] -> [a]
filter ((QName
name forall a. Eq a => a -> a -> Bool
==) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attr -> QName
attrKey) [Attr]
attrs of
           (Attr
a:[Attr]
_) -> forall a. a -> Maybe a
Just (Attr -> Text
attrVal Attr
a)
           [Attr]
_     -> 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 = forall t. Node t => Text -> t -> Content
el Text
tagname forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
cMapM forall (m :: * -> *). PandocMonad m => Inline -> FBM m [Content]
toXml [Inline]
inlines

-- " Create a singleton list.
list :: a -> [a]
list :: forall a. a -> [a]
list = (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)             = forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Inline -> Text
plain [Inline]
ss
plain (Underline [Inline]
ss)        = forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Inline -> Text
plain [Inline]
ss
plain (Span Attr
_ [Inline]
ss)           = forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Inline -> Text
plain [Inline]
ss
plain (Strong [Inline]
ss)           = forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Inline -> Text
plain [Inline]
ss
plain (Strikeout [Inline]
ss)        = forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Inline -> Text
plain [Inline]
ss
plain (Superscript [Inline]
ss)      = forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Inline -> Text
plain [Inline]
ss
plain (Subscript [Inline]
ss)        = forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Inline -> Text
plain [Inline]
ss
plain (SmallCaps [Inline]
ss)        = forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Inline -> Text
plain [Inline]
ss
plain (Quoted QuoteType
_ [Inline]
ss)         = forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Inline -> Text
plain [Inline]
ss
plain (Cite [Citation]
_ [Inline]
ss)           = forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ 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
_)) = forall a. Monoid a => [a] -> a
mconcat (forall a b. (a -> b) -> [a] -> [b]
map Inline -> Text
plain [Inline]
text forall a. [a] -> [a] -> [a]
++ [Text
" <", Text
url, Text
">"])
plain (Image Attr
_ [Inline]
alt (Text, Text)
_)       = forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ 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 forall a b. (a -> b) -> a -> b
$ 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 = forall t. Node t => Text -> t -> Content
el Text
"empty-line" ()
    in  [Content
emptyline] forall a. [a] -> [a] -> [a]
++ [Content]
cs 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 forall a b. (a -> b) -> a -> b
$ CDataKind -> Text -> Maybe Line -> CData
CData CDataKind
CDataText Text
s 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 forall a. Maybe a
Nothing (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 = 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 = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM a -> m [b]
f [a]
xs