{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE OverloadedStrings #-}
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 FbRenderState = FbRenderState
{ :: [ (Int, Text, [Content]) ]
, FbRenderState -> [(Text, Text)]
imagesToFetch :: [ (Text, Text) ]
, FbRenderState -> Text
parentListMarker :: Text
, 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)
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"
writeFB2 :: PandocMonad m
=> WriterOptions
-> Pandoc
-> m Text
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 })
Content
desc <- Meta -> FBM m Content
forall (m :: * -> *). PandocMonad m => Meta -> FBM m Content
description Meta
meta
[Content]
title <- (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
[Content]
secs <- Int -> [Block] -> StateT FbRenderState m [Content]
forall (m :: * -> *).
PandocMonad m =>
Int -> [Block] -> FBM m [Content]
renderSections Int
1 [Block]
blocks
let body :: Content
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
[Content]
notes <- StateT FbRenderState m [Content]
forall (m :: * -> *). PandocMonad m => FBM m [Content]
renderFootnotes
([Content]
imgs,[Text]
missing) <- StateT FbRenderState m FbRenderState
forall s (m :: * -> *). MonadState s m => m s
get StateT FbRenderState m FbRenderState
-> (FbRenderState -> StateT FbRenderState m ([Content], [Text]))
-> StateT FbRenderState m ([Content], [Text])
forall a b.
StateT FbRenderState m a
-> (a -> StateT FbRenderState m b) -> StateT FbRenderState m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (m ([Content], [Text]) -> StateT FbRenderState m ([Content], [Text])
forall (m :: * -> *) a. Monad m => m a -> StateT FbRenderState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ([Content], [Text])
-> StateT FbRenderState m ([Content], [Text]))
-> (FbRenderState -> m ([Content], [Text]))
-> FbRenderState
-> StateT FbRenderState m ([Content], [Text])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Text, Text)] -> m ([Content], [Text])
forall (m :: * -> *).
PandocMonad m =>
[(Text, Text)] -> m ([Content], [Text])
fetchImages ([(Text, Text)] -> m ([Content], [Text]))
-> (FbRenderState -> [(Text, Text)])
-> FbRenderState
-> m ([Content], [Text])
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 = 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)
Text -> FBM m Text
forall a. a -> StateT FbRenderState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> FBM m Text) -> Text -> FBM m Text
forall a b. (a -> b) -> a -> b
$ Text
xml_head Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Content -> Text
showContent Content
fb2_xml Text -> Text -> Text
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
"" -> 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
[Content]
bt <- Meta -> FBM m [Content]
forall (m :: * -> *). PandocMonad m => Meta -> FBM m [Content]
booktitle Meta
meta'
let as :: [Content]
as = Meta -> [Content]
authors Meta
meta'
[Content]
dd <- Meta -> FBM m [Content]
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) -> 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 :: [Content]
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
'-')
let coverimage :: Text -> StateT FbRenderState m [Content]
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
"")
[Content]
im <- ImageMode -> Inline -> StateT FbRenderState m [Content]
forall (m :: * -> *).
PandocMonad m =>
ImageMode -> Inline -> FBM m [Content]
insertImage ImageMode
InlineImage Inline
img
[Content] -> StateT FbRenderState m [Content]
forall a. a -> StateT FbRenderState m a
forall (m :: * -> *) a. Monad m => a -> m a
return [Text -> [Content] -> Content
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) -> 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 []
Content -> FBM m Content
forall a. a -> StateT FbRenderState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Content -> FBM m Content) -> Content -> FBM m Content
forall a b. (a -> b) -> a -> b
$ Text -> [Content] -> Content
forall t. Node t => Text -> t -> Content
el Text
"description"
[ Text -> [Content] -> Content
forall t. Node t => Text -> t -> Content
el Text
"title-info" (Content
genre Content -> [Content] -> [Content]
forall a. a -> [a] -> [a]
:
([Content]
as [Content] -> [Content] -> [Content]
forall a. [a] -> [a] -> [a]
++ [Content]
bt [Content] -> [Content] -> [Content]
forall a. [a] -> [a] -> [a]
++ [Content]
annotation [Content] -> [Content] -> [Content]
forall a. [a] -> [a] -> [a]
++ [Content]
dd [Content] -> [Content] -> [Content]
forall a. [a] -> [a] -> [a]
++ [Content]
coverpage [Content] -> [Content] -> [Content]
forall a. [a] -> [a] -> [a]
++ [Content]
lang))
, Text -> [Content] -> Content
forall t. Node t => Text -> t -> Content
el Text
"document-info" [Text -> Text -> Content
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 <- (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] -> FBM m [Content])
-> (Meta -> [Inline]) -> Meta -> FBM m [Content]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Meta -> [Inline]
docTitle (Meta -> FBM m [Content]) -> Meta -> FBM m [Content]
forall a b. (a -> b) -> a -> b
$ Meta
meta'
[Content] -> FBM m [Content]
forall a. a -> StateT FbRenderState m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Content] -> FBM m [Content]) -> [Content] -> FBM m [Content]
forall a b. (a -> b) -> a -> b
$ [Text -> [Content] -> Content
forall t. Node t => Text -> t -> Content
el Text
"book-title" [Content]
t | Bool -> Bool
not ([Content] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Content]
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'
[Content]
d <- (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
[Content] -> FBM m [Content]
forall a. a -> StateT FbRenderState m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Content] -> FBM m [Content]) -> [Content] -> FBM m [Content]
forall a b. (a -> b) -> a -> b
$ [Text -> [Content] -> Content
forall t. Node t => Text -> t -> Content
el Text
"date" [Content]
d | Bool -> Bool
not ([Content] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Content]
d)]
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 -> FBM m [Content]) -> [Block] -> FBM m [Content]
forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
cMapM (Int -> Block -> FBM 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
[Content]
title' <- if [Inline] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
title
then [Content] -> FBM 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]) -> FBM m [Content] -> FBM m [Content]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> FBM m [Content]
forall (m :: * -> *). PandocMonad m => [Inline] -> FBM m [Content]
formatTitle [Inline]
title
[Content]
content <- (Block -> FBM m [Content]) -> [Block] -> FBM m [Content]
forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
cMapM (Int -> Block -> FBM m [Content]
forall (m :: * -> *).
PandocMonad m =>
Int -> Block -> FBM m [Content]
renderSection (Int
lvl Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)) [Block]
xs
let sectionContent :: Content
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)
[Content] -> FBM m [Content]
forall a. a -> StateT FbRenderState m a
forall (m :: * -> *) a. Monad m => a -> m a
return [Content
sectionContent]
renderSection Int
lvl (Div Attr
_attr [Block]
bs) =
(Block -> FBM m [Content]) -> [Block] -> FBM m [Content]
forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
cMapM (Int -> Block -> FBM m [Content]
forall (m :: * -> *).
PandocMonad m =>
Int -> Block -> FBM m [Content]
renderSection Int
lvl) [Block]
bs
renderSection Int
_ Block
b = Block -> FBM m [Content]
forall (m :: * -> *). PandocMonad m => Block -> FBM m [Content]
blockToXml Block
b
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
renderFootnotes :: PandocMonad m => FBM m [Content]
= do
[(Int, Text, [Content])]
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 [(Int, Text, [Content])] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Int, Text, [Content])]
fns
then [Content] -> FBM m [Content]
forall a. a -> StateT FbRenderState m a
forall (m :: * -> *) a. Monad m => a -> m a
return []
else [Content] -> FBM m [Content]
forall a. a -> StateT FbRenderState m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Content] -> FBM m [Content])
-> (Content -> [Content]) -> Content -> FBM m [Content]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Content -> [Content]
forall a. a -> [a]
list (Content -> FBM m [Content]) -> Content -> FBM m [Content]
forall a b. (a -> b) -> a -> b
$
Text -> ([Attr], [Content]) -> Content
forall t. Node t => Text -> t -> Content
el Text
"body" ([Text -> Text -> Attr
uattr Text
"name" Text
"notes"], ((Int, Text, [Content]) -> Content)
-> [(Int, Text, [Content])] -> [Content]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Text, [Content]) -> Content
forall {a}. Show a => (a, Text, [Content]) -> Content
renderFN ([(Int, Text, [Content])] -> [(Int, Text, [Content])]
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 = 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)
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 <- ((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
([Content], [Text]) -> m ([Content], [Text])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Either Text Content] -> [Content]
forall a b. [Either a b] -> [b]
rights [Either Text Content]
imgs, [Either Text Content] -> [Text]
forall a b. [Either a b] -> [a]
lefts [Either Text Content]
imgs)
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' 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
(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 (ByteString
bs, Maybe Text
mbmime) <- Text -> m (ByteString, Maybe Text)
forall (m :: * -> *).
PandocMonad m =>
Text -> m (ByteString, Maybe Text)
P.fetchItem Text
link
case Maybe Text
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 Maybe (Text, Text)
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))
readDataURI :: Text
-> Maybe (Text,Text,Bool,Text)
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
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
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
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
Text
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
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
" "
(FbRenderState -> FbRenderState) -> StateT FbRenderState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\FbRenderState
s -> FbRenderState
s { parentListMarker = nmrk})
[Content]
item <- (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] -> FBM m [Content]) -> [Block] -> FBM m [Content]
forall a b. (a -> b) -> a -> b
$ [Block] -> [Block]
plainToPara ([Block] -> [Block]) -> [Block] -> [Block]
forall a b. (a -> b) -> a -> b
$ Text -> [Block] -> [Block]
indentBlocks Text
nmrk [Block]
bs
(FbRenderState -> FbRenderState) -> StateT FbRenderState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\FbRenderState
s -> FbRenderState
s { parentListMarker = pmrk })
[Content] -> FBM m [Content]
forall a. a -> StateT FbRenderState m a
forall (m :: * -> *) a. Monad m => a -> m a
return [Content]
item
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
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
[Content]
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
Content
t <- Text -> [Inline] -> FBM m Content
forall (m :: * -> *).
PandocMonad m =>
Text -> [Inline] -> FBM m Content
wrap Text
"strong" [Inline]
term
[Content] -> StateT FbRenderState m [Content]
forall a. a -> StateT FbRenderState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Content -> Content
forall t. Node t => Text -> t -> Content
el Text
"p" Content
t Content -> [Content] -> [Content]
forall a. a -> [a] -> [a]
: [Content]
items)
blockToXml h :: Block
h@Header{} = 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
$ 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
[Content]
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
[Content]
bd <- ([[Block]] -> StateT FbRenderState m Content)
-> [[[Block]]] -> 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 (\[[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) [[[Block]]]
rows
Content
c <- Text -> [Content] -> Content
forall t. Node t => Text -> t -> Content
el Text
"emphasis" ([Content] -> Content)
-> FBM m [Content] -> StateT FbRenderState 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]
caption
[Content] -> FBM m [Content]
forall a. a -> StateT FbRenderState m a
forall (m :: * -> *) a. Monad m => a -> m a
return [Text -> [Content] -> Content
forall t. Node t => Text -> t -> Content
el Text
"table" ([Content]
hd [Content] -> [Content] -> [Content]
forall a. Semigroup a => a -> a -> a
<> [Content]
bd), Text -> Content -> Content
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' =
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
[Content]
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
Content -> FBM m Content
forall a. a -> StateT FbRenderState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Content -> FBM m Content) -> Content -> FBM m Content
forall a b. (a -> b) -> a -> b
$ Text -> ([Attr], [Content]) -> Content
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" 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)
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
plainToPara (Block
p:[Block]
rest) = Block
p Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block] -> [Block]
plainToPara [Block]
rest
unPlain :: Block -> Block
unPlain :: Block -> Block
unPlain (Plain [Inline]
inlines) = [Inline] -> Block
Para [Inline]
inlines
unPlain Block
x = Block
x
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
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
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
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
[Content]
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
[Content] -> StateT FbRenderState m [Content]
forall a. a -> StateT FbRenderState m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Content] -> StateT FbRenderState m [Content])
-> [Content] -> StateT FbRenderState m [Content]
forall a b. (a -> b) -> a -> b
$ [Text -> Content
txt Text
"‘"] [Content] -> [Content] -> [Content]
forall a. [a] -> [a] -> [a]
++ [Content]
inner [Content] -> [Content] -> [Content]
forall a. [a] -> [a] -> [a]
++ [Text -> Content
txt Text
"’"]
toXml (Quoted QuoteType
DoubleQuote [Inline]
ss) = do
[Content]
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
[Content] -> StateT FbRenderState m [Content]
forall a. a -> StateT FbRenderState m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Content] -> StateT FbRenderState m [Content])
-> [Content] -> StateT FbRenderState m [Content]
forall a b. (a -> b) -> a -> b
$ [Text -> Content
txt Text
"“"] [Content] -> [Content] -> [Content]
forall a. [a] -> [a] -> [a]
++ [Content]
inner [Content] -> [Content] -> [Content]
forall a. [a] -> [a] -> [a]
++ [Text -> Content
txt Text
"”"]
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
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 []
toXml (Link Attr
_ [Inline]
text (Text
url,Text
_)) = do
[Content]
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
[Content] -> StateT FbRenderState m [Content]
forall a. a -> StateT FbRenderState m a
forall (m :: * -> *) a. Monad m => a -> m a
return [ Text -> ([Attr], [Content]) -> Content
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{} = 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
[(Int, Text, [Content])]
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
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 :: Text
fn_id = Int -> Text
footnoteID Int
n
[Content]
fn_desc <- (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]
bs
(FbRenderState -> FbRenderState) -> StateT FbRenderState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\FbRenderState
s -> FbRenderState
s { footnotes = (n, fn_id, fn_desc) : fns })
let fn_ref :: Content
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
"]"
[Content] -> StateT FbRenderState m [Content]
forall a. a -> StateT FbRenderState m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Content] -> StateT FbRenderState m [Content])
-> (Content -> [Content])
-> Content
-> StateT FbRenderState m [Content]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Content -> [Content]
forall a. a -> [a]
list (Content -> StateT FbRenderState m [Content])
-> Content -> StateT FbRenderState m [Content]
forall a b. (a -> b) -> a -> b
$ Text -> ([Attr], Content) -> Content
forall t. Node t => Text -> t -> Content
el Text
"a" ( [ (Text, Text) -> Text -> Attr
attr (Text
"l",Text
"href") (Text
"#" Text -> Text -> 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 <- (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 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 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 -> FBM m [Content]
forall (m :: * -> *).
PandocMonad m =>
ImageMode -> Inline -> FBM m [Content]
insertImage ImageMode
immode Inline
img
HTMLMathMethod
_ -> [Content] -> FBM 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
[(Text, Text)]
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
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
fname = Text
"image" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
n
(FbRenderState -> FbRenderState) -> StateT FbRenderState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\FbRenderState
s -> FbRenderState
s { imagesToFetch = (fname, url) : 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)
_ -> []
[Content] -> FBM m [Content]
forall a. a -> StateT FbRenderState m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Content] -> FBM m [Content])
-> (Content -> [Content]) -> Content -> FBM m [Content]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Content -> [Content]
forall a. a -> [a]
list (Content -> FBM m [Content]) -> Content -> FBM m [Content]
forall a b. (a -> b) -> a -> b
$
Text -> [Attr] -> Content
forall t. Node t => Text -> t -> Content
el Text
"image" ([Attr] -> Content) -> [Attr] -> Content
forall a b. (a -> b) -> a -> b
$
[ (Text, Text) -> Text -> Attr
attr (Text
"l",Text
"href") (Text
"#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
fname)
, (Text, Text) -> Text -> Attr
attr (Text
"l",Text
"type") (ImageMode -> Text
forall a. Show a => a -> Text
tshow ImageMode
immode)
, Text -> Text -> Attr
uattr Text
"alt" ([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) ]
[Attr] -> [Attr] -> [Attr]
forall a. [a] -> [a] -> [a]
++ [Attr]
ttlattr
insertImage ImageMode
_ Inline
_ = String -> FBM 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'
(Maybe Text, Maybe Text)
_ -> Content
n
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 :: 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
list :: a -> [a]
list :: forall a. a -> [a]
list = (a -> [a] -> [a]
forall a. a -> [a] -> [a]
:[])
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
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
""
el :: (Node t)
=> Text
-> t
-> 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
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]
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 Line -> CData
CData CDataKind
CDataText Text
s Maybe Line
forall a. Maybe a
Nothing
uattr :: Text -> Text -> X.Attr
uattr :: Text -> Text -> Attr
uattr Text
name = QName -> Text -> Attr
Attr (Text -> QName
unqual Text
name)
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)
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)
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
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