{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}
module Text.Pandoc.Writers.RST ( writeRST, flatten ) where
import Control.Monad.State.Strict
import Data.Char (isSpace)
import Data.List (transpose, intersperse, foldl')
import qualified Data.List.NonEmpty as NE
import Data.Maybe (fromMaybe)
import qualified Data.Text as T
import Data.Text (Text)
import qualified Text.Pandoc.Builder as B
import Text.Pandoc.Class.PandocMonad (PandocMonad, report)
import Text.Pandoc.Definition
import Text.Pandoc.ImageSize
import Text.Pandoc.Logging
import Text.Pandoc.Options
import Text.DocLayout
import Text.Pandoc.Shared
import Text.Pandoc.Templates (renderTemplate)
import Text.Pandoc.Writers.Shared
import Text.Pandoc.Walk
import Safe (lastMay, headMay)
type Refs = [([Inline], Target)]
data WriterState =
WriterState { WriterState -> [[Block]]
stNotes :: [[Block]]
, WriterState -> Refs
stLinks :: Refs
, WriterState -> [([Inline], (Attr, Text, Text, Maybe Text))]
stImages :: [([Inline], (Attr, Text, Text, Maybe Text))]
, WriterState -> Bool
stHasMath :: Bool
, WriterState -> Bool
stHasRawTeX :: Bool
, WriterState -> WriterOptions
stOptions :: WriterOptions
, WriterState -> Bool
stTopLevel :: Bool
, WriterState -> Int
stImageId :: Int
}
type RST = StateT WriterState
writeRST :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writeRST :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeRST WriterOptions
opts Pandoc
document = do
let st :: WriterState
st = WriterState { stNotes :: [[Block]]
stNotes = [], stLinks :: Refs
stLinks = [],
stImages :: [([Inline], (Attr, Text, Text, Maybe Text))]
stImages = [], stHasMath :: Bool
stHasMath = Bool
False,
stHasRawTeX :: Bool
stHasRawTeX = Bool
False, stOptions :: WriterOptions
stOptions = WriterOptions
opts,
stTopLevel :: Bool
stTopLevel = Bool
True, stImageId :: Int
stImageId = Int
1 }
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (forall (m :: * -> *). PandocMonad m => Pandoc -> RST m Text
pandocToRST Pandoc
document) WriterState
st
pandocToRST :: PandocMonad m => Pandoc -> RST m Text
pandocToRST :: forall (m :: * -> *). PandocMonad m => Pandoc -> RST m Text
pandocToRST (Pandoc Meta
meta [Block]
blocks) = do
WriterOptions
opts <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> WriterOptions
stOptions
let colwidth :: Maybe Int
colwidth = if WriterOptions -> WrapOption
writerWrapText WriterOptions
opts forall a. Eq a => a -> a -> Bool
== WrapOption
WrapAuto
then forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ WriterOptions -> Int
writerColumns WriterOptions
opts
else forall a. Maybe a
Nothing
let subtit :: [Inline]
subtit = Text -> Meta -> [Inline]
lookupMetaInlines Text
"subtitle" Meta
meta
Doc Text
title <- forall (m :: * -> *).
PandocMonad m =>
[Inline] -> [Inline] -> RST m (Doc Text)
titleToRST (Meta -> [Inline]
docTitle Meta
meta) [Inline]
subtit
Context Text
metadata <- forall (m :: * -> *) a.
(Monad m, TemplateTarget a) =>
WriterOptions
-> ([Block] -> m (Doc a))
-> ([Inline] -> m (Doc a))
-> Meta
-> m (Context a)
metaToContext WriterOptions
opts
forall (m :: * -> *). PandocMonad m => [Block] -> RST m (Doc Text)
blockListToRST
(forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Doc a -> Doc a
chomp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). PandocMonad m => [Inline] -> RST m (Doc Text)
inlineListToRST)
Meta
meta
Doc Text
body <- forall (m :: * -> *).
PandocMonad m =>
Bool -> [Block] -> RST m (Doc Text)
blockListToRST' Bool
True forall a b. (a -> b) -> a -> b
$ case WriterOptions -> Maybe (Template Text)
writerTemplate WriterOptions
opts of
Just Template Text
_ -> Int -> [Block] -> [Block]
normalizeHeadings Int
1 [Block]
blocks
Maybe (Template Text)
Nothing -> [Block]
blocks
Doc Text
notes <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterState -> [[Block]]
stNotes) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *).
PandocMonad m =>
[[Block]] -> RST m (Doc Text)
notesToRST
Doc Text
refs <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterState -> Refs
stLinks) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *). PandocMonad m => Refs -> RST m (Doc Text)
refsToRST
Doc Text
pics <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterState -> [([Inline], (Attr, Text, Text, Maybe Text))]
stImages) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *).
PandocMonad m =>
[([Inline], (Attr, Text, Text, Maybe Text))] -> RST m (Doc Text)
pictRefsToRST
Bool
hasMath <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stHasMath
Bool
rawTeX <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stHasRawTeX
let main :: Doc Text
main = forall a. [Doc a] -> Doc a
vsep [Doc Text
body, Doc Text
notes, Doc Text
refs, Doc Text
pics]
let context :: Context Text
context = forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"body" Doc Text
main
forall a b. (a -> b) -> a -> b
$ forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"toc" (WriterOptions -> Bool
writerTableOfContents WriterOptions
opts)
forall a b. (a -> b) -> a -> b
$ forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"toc-depth" (forall a. Show a => a -> Text
tshow forall a b. (a -> b) -> a -> b
$ WriterOptions -> Int
writerTOCDepth WriterOptions
opts)
forall a b. (a -> b) -> a -> b
$ forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"number-sections" (WriterOptions -> Bool
writerNumberSections WriterOptions
opts)
forall a b. (a -> b) -> a -> b
$ forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"math" Bool
hasMath
forall a b. (a -> b) -> a -> b
$ forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"titleblock" (forall a. HasChars a => Maybe Int -> Doc a -> a
render forall a. Maybe a
Nothing Doc Text
title :: Text)
forall a b. (a -> b) -> a -> b
$ forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"math" Bool
hasMath
forall a b. (a -> b) -> a -> b
$ forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"rawtex" Bool
rawTeX Context Text
metadata
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. HasChars a => Maybe Int -> Doc a -> a
render Maybe Int
colwidth forall a b. (a -> b) -> a -> b
$
case WriterOptions -> Maybe (Template Text)
writerTemplate WriterOptions
opts of
Maybe (Template Text)
Nothing -> Doc Text
main
Just Template Text
tpl -> forall a b.
(TemplateTarget a, ToContext a b) =>
Template a -> b -> Doc a
renderTemplate Template Text
tpl Context Text
context
where
normalizeHeadings :: Int -> [Block] -> [Block]
normalizeHeadings Int
lev (Header Int
l Attr
a [Inline]
i:[Block]
bs) =
Int -> Attr -> [Inline] -> Block
Header Int
lev Attr
a [Inline]
iforall a. a -> [a] -> [a]
:Int -> [Block] -> [Block]
normalizeHeadings (Int
levforall a. Num a => a -> a -> a
+Int
1) [Block]
cont forall a. [a] -> [a] -> [a]
++ Int -> [Block] -> [Block]
normalizeHeadings Int
lev [Block]
bs'
where ([Block]
cont,[Block]
bs') = forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Int -> Block -> Bool
headerLtEq Int
l) [Block]
bs
headerLtEq :: Int -> Block -> Bool
headerLtEq Int
level (Header Int
l' Attr
_ [Inline]
_) = Int
l' forall a. Ord a => a -> a -> Bool
<= Int
level
headerLtEq Int
_ Block
_ = Bool
False
normalizeHeadings Int
lev (Block
b:[Block]
bs) = Block
bforall a. a -> [a] -> [a]
:Int -> [Block] -> [Block]
normalizeHeadings Int
lev [Block]
bs
normalizeHeadings Int
_ [] = []
refsToRST :: PandocMonad m => Refs -> RST m (Doc Text)
refsToRST :: forall (m :: * -> *). PandocMonad m => Refs -> RST m (Doc Text)
refsToRST Refs
refs =
forall a. [Doc a] -> Doc a
vcat 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], (Text, Text)) -> RST m (Doc Text)
keyToRST Refs
refs
keyToRST :: PandocMonad m => ([Inline], (Text, Text)) -> RST m (Doc Text)
keyToRST :: forall (m :: * -> *).
PandocMonad m =>
([Inline], (Text, Text)) -> RST m (Doc Text)
keyToRST ([Inline]
label, (Text
src, Text
_)) = do
Doc Text
label' <- forall (m :: * -> *). PandocMonad m => [Inline] -> RST m (Doc Text)
inlineListToRST [Inline]
label
let label'' :: Doc Text
label'' = if (forall a. Eq a => a -> a -> Bool
==Char
':') (Char -> Bool) -> Text -> Bool
`T.any` (forall a. HasChars a => Maybe Int -> Doc a -> a
render forall a. Maybe a
Nothing Doc Text
label' :: Text)
then forall a. HasChars a => Char -> Doc a
char Char
'`' forall a. Semigroup a => a -> a -> a
<> Doc Text
label' forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => Char -> Doc a
char Char
'`'
else Doc Text
label'
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. IsString a => Doc a -> Doc a
nowrap forall a b. (a -> b) -> a -> b
$ Doc Text
".. _" forall a. Semigroup a => a -> a -> a
<> Doc Text
label'' forall a. Semigroup a => a -> a -> a
<> Doc Text
": " forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal Text
src
notesToRST :: PandocMonad m => [[Block]] -> RST m (Doc Text)
notesToRST :: forall (m :: * -> *).
PandocMonad m =>
[[Block]] -> RST m (Doc Text)
notesToRST [[Block]]
notes =
forall a. [Doc a] -> Doc a
vsep 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 =>
Int -> [Block] -> RST m (Doc Text)
noteToRST [Int
1..] [[Block]]
notes
noteToRST :: PandocMonad m => Int -> [Block] -> RST m (Doc Text)
noteToRST :: forall (m :: * -> *).
PandocMonad m =>
Int -> [Block] -> RST m (Doc Text)
noteToRST Int
num [Block]
note = do
Doc Text
contents <- forall (m :: * -> *). PandocMonad m => [Block] -> RST m (Doc Text)
blockListToRST [Block]
note
let marker :: Doc Text
marker = Doc Text
".. [" forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => String -> Doc a
text (forall a. Show a => a -> String
show Int
num) forall a. Semigroup a => a -> a -> a
<> Doc Text
"]"
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. IsString a => Doc a -> Doc a
nowrap forall a b. (a -> b) -> a -> b
$ Doc Text
marker forall a. Doc a -> Doc a -> Doc a
$$ forall a. IsString a => Int -> Doc a -> Doc a
nest Int
3 Doc Text
contents
pictRefsToRST :: PandocMonad m
=> [([Inline], (Attr, Text, Text, Maybe Text))]
-> RST m (Doc Text)
pictRefsToRST :: forall (m :: * -> *).
PandocMonad m =>
[([Inline], (Attr, Text, Text, Maybe Text))] -> RST m (Doc Text)
pictRefsToRST [([Inline], (Attr, Text, Text, Maybe Text))]
refs =
forall a. [Doc a] -> Doc a
vcat 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], (Attr, Text, Text, Maybe Text)) -> RST m (Doc Text)
pictToRST [([Inline], (Attr, Text, Text, Maybe Text))]
refs
pictToRST :: PandocMonad m
=> ([Inline], (Attr, Text, Text, Maybe Text))
-> RST m (Doc Text)
pictToRST :: forall (m :: * -> *).
PandocMonad m =>
([Inline], (Attr, Text, Text, Maybe Text)) -> RST m (Doc Text)
pictToRST ([Inline]
label, (Attr
attr, Text
src, Text
_, Maybe Text
mbtarget)) = do
Doc Text
label' <- forall (m :: * -> *). PandocMonad m => [Inline] -> RST m (Doc Text)
inlineListToRST [Inline]
label
Doc Text
dims <- forall (m :: * -> *). PandocMonad m => Attr -> RST m (Doc Text)
imageDimsToRST Attr
attr
let (Text
_, [Text]
cls, [(Text, Text)]
_) = Attr
attr
classes :: Doc Text
classes = case [Text]
cls of
[] -> forall a. Doc a
empty
[Text
"align-top"] -> Doc Text
":align: top"
[Text
"align-middle"] -> Doc Text
":align: middle"
[Text
"align-bottom"] -> Doc Text
":align: bottom"
[Text
"align-center"] -> forall a. Doc a
empty
[Text
"align-right"] -> forall a. Doc a
empty
[Text
"align-left"] -> forall a. Doc a
empty
[Text]
_ -> Doc Text
":class: " forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal ([Text] -> Text
T.unwords [Text]
cls)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. IsString a => Doc a -> Doc a
nowrap
forall a b. (a -> b) -> a -> b
$ Doc Text
".. |" forall a. Semigroup a => a -> a -> a
<> Doc Text
label' forall a. Semigroup a => a -> a -> a
<> Doc Text
"| image:: " forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal Text
src forall a. Doc a -> Doc a -> Doc a
$$ forall a. IsString a => Int -> Doc a -> Doc a -> Doc a
hang Int
3 forall a. Doc a
empty (Doc Text
classes forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
dims)
forall a. Doc a -> Doc a -> Doc a
$$ case Maybe Text
mbtarget of
Maybe Text
Nothing -> forall a. Doc a
empty
Just Text
t -> Doc Text
" :target: " forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal Text
t
escapeText :: WriterOptions -> Text -> Text
escapeText :: WriterOptions -> Text -> Text
escapeText WriterOptions
o = String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. HasSyntaxExtensions a => Bool -> a -> String -> String
escapeString' Bool
True WriterOptions
o forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack
where
escapeString' :: Bool -> a -> String -> String
escapeString' Bool
_ a
_ [] = []
escapeString' Bool
firstChar a
opts (Char
c:String
cs) =
case Char
c of
Char
'\\' -> Char
'\\'forall a. a -> [a] -> [a]
:Char
cforall a. a -> [a] -> [a]
:Bool -> a -> String -> String
escapeString' Bool
False a
opts String
cs
Char
_ | Char
c Char -> Text -> Bool
`elemText` Text
"`*_|" Bool -> Bool -> Bool
&&
(Bool
firstChar Bool -> Bool -> Bool
|| forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
cs) -> Char
'\\'forall a. a -> [a] -> [a]
:Char
cforall a. a -> [a] -> [a]
:Bool -> a -> String -> String
escapeString' Bool
False a
opts String
cs
Char
'\'' | forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_smart a
opts -> Char
'\\'forall a. a -> [a] -> [a]
:Char
'\''forall a. a -> [a] -> [a]
:Bool -> a -> String -> String
escapeString' Bool
False a
opts String
cs
Char
'"' | forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_smart a
opts -> Char
'\\'forall a. a -> [a] -> [a]
:Char
'"'forall a. a -> [a] -> [a]
:Bool -> a -> String -> String
escapeString' Bool
False a
opts String
cs
Char
'-' | forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_smart a
opts ->
case String
cs of
Char
'-':String
_ -> Char
'\\'forall a. a -> [a] -> [a]
:Char
'-'forall a. a -> [a] -> [a]
:Bool -> a -> String -> String
escapeString' Bool
False a
opts String
cs
String
_ -> Char
'-'forall a. a -> [a] -> [a]
:Bool -> a -> String -> String
escapeString' Bool
False a
opts String
cs
Char
'.' | forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_smart a
opts ->
case String
cs of
Char
'.':Char
'.':String
rest -> Char
'\\'forall a. a -> [a] -> [a]
:Char
'.'forall a. a -> [a] -> [a]
:Char
'.'forall a. a -> [a] -> [a]
:Char
'.'forall a. a -> [a] -> [a]
:Bool -> a -> String -> String
escapeString' Bool
False a
opts String
rest
String
_ -> Char
'.'forall a. a -> [a] -> [a]
:Bool -> a -> String -> String
escapeString' Bool
False a
opts String
cs
Char
_ -> Char
c forall a. a -> [a] -> [a]
: Bool -> a -> String -> String
escapeString' Bool
False a
opts String
cs
titleToRST :: PandocMonad m => [Inline] -> [Inline] -> RST m (Doc Text)
titleToRST :: forall (m :: * -> *).
PandocMonad m =>
[Inline] -> [Inline] -> RST m (Doc Text)
titleToRST [] [Inline]
_ = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Doc a
empty
titleToRST [Inline]
tit [Inline]
subtit = do
Doc Text
title <- forall (m :: * -> *). PandocMonad m => [Inline] -> RST m (Doc Text)
inlineListToRST [Inline]
tit
Doc Text
subtitle <- forall (m :: * -> *). PandocMonad m => [Inline] -> RST m (Doc Text)
inlineListToRST [Inline]
subtit
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text -> Char -> Doc Text
bordered Doc Text
title Char
'=' forall a. Doc a -> Doc a -> Doc a
$$ Doc Text -> Char -> Doc Text
bordered Doc Text
subtitle Char
'-'
bordered :: Doc Text -> Char -> Doc Text
bordered :: Doc Text -> Char -> Doc Text
bordered Doc Text
contents Char
c =
if Int
len forall a. Ord a => a -> a -> Bool
> Int
0
then Doc Text
border forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
contents forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
border
else forall a. Doc a
empty
where len :: Int
len = forall a. (IsString a, HasChars a) => Doc a -> Int
offset Doc Text
contents
border :: Doc Text
border = forall a. HasChars a => a -> Doc a
literal (Int -> Text -> Text
T.replicate Int
len forall a b. (a -> b) -> a -> b
$ Char -> Text
T.singleton Char
c)
blockToRST :: PandocMonad m
=> Block
-> RST m (Doc Text)
blockToRST :: forall (m :: * -> *). PandocMonad m => Block -> RST m (Doc Text)
blockToRST Block
Null = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Doc a
empty
blockToRST (Div (Text
"",[Text
"title"],[]) [Block]
_) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Doc a
empty
blockToRST (Div (Text
ident,[Text]
classes,[(Text, Text)]
_kvs) [Block]
bs) = do
Doc Text
contents <- forall (m :: * -> *). PandocMonad m => [Block] -> RST m (Doc Text)
blockListToRST [Block]
bs
let admonitions :: [Text]
admonitions = [Text
"attention",Text
"caution",Text
"danger",Text
"error",Text
"hint",
Text
"important",Text
"note",Text
"tip",Text
"warning",Text
"admonition"]
let admonition :: Doc Text
admonition = case [Text]
classes of
(Text
cl:[Text]
_)
| Text
cl forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
admonitions
-> Doc Text
".. " forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal Text
cl forall a. Semigroup a => a -> a -> a
<> Doc Text
"::"
[Text]
cls -> Doc Text
".. container::" forall a. Semigroup a => a -> a -> a
<> forall a. Doc a
space forall a. Semigroup a => a -> a -> a
<>
forall a. HasChars a => a -> Doc a
literal ([Text] -> Text
T.unwords (forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/= Text
"container") [Text]
cls))
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Doc a
blankline forall a. Doc a -> Doc a -> Doc a
$$
Doc Text
admonition forall a. Doc a -> Doc a -> Doc a
$$
(if Text -> Bool
T.null Text
ident
then forall a. Doc a
blankline
else Doc Text
" :name: " forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal Text
ident forall a. Doc a -> Doc a -> Doc a
$$ forall a. Doc a
blankline) forall a. Doc a -> Doc a -> Doc a
$$
forall a. IsString a => Int -> Doc a -> Doc a
nest Int
3 Doc Text
contents forall a. Doc a -> Doc a -> Doc a
$$
forall a. Doc a
blankline
blockToRST (Plain [Inline]
inlines) = forall (m :: * -> *). PandocMonad m => [Inline] -> RST m (Doc Text)
inlineListToRST [Inline]
inlines
blockToRST (SimpleFigure Attr
attr [Inline]
txt (Text
src, Text
tit)) = do
Doc Text
description <- forall (m :: * -> *). PandocMonad m => [Inline] -> RST m (Doc Text)
inlineListToRST [Inline]
txt
Doc Text
dims <- forall (m :: * -> *). PandocMonad m => Attr -> RST m (Doc Text)
imageDimsToRST Attr
attr
let fig :: Doc Text
fig = Doc Text
"figure:: " forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal Text
src
alt :: Doc Text
alt = Doc Text
":alt: " forall a. Semigroup a => a -> a -> a
<> if Text -> Bool
T.null Text
tit then Doc Text
description else forall a. HasChars a => a -> Doc a
literal Text
tit
capt :: Doc Text
capt = Doc Text
description
(Text
_,[Text]
cls,[(Text, Text)]
_) = Attr
attr
classes :: Doc Text
classes = case [Text]
cls of
[] -> forall a. Doc a
empty
[Text
"align-right"] -> Doc Text
":align: right"
[Text
"align-left"] -> Doc Text
":align: left"
[Text
"align-center"] -> Doc Text
":align: center"
[Text]
_ -> Doc Text
":figclass: " forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal ([Text] -> Text
T.unwords [Text]
cls)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. IsString a => Int -> Doc a -> Doc a -> Doc a
hang Int
3 Doc Text
".. " (Doc Text
fig forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
alt forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
classes forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
dims forall a. Doc a -> Doc a -> Doc a
$+$ Doc Text
capt) forall a. Doc a -> Doc a -> Doc a
$$ forall a. Doc a
blankline
blockToRST (Para [Image Attr
attr [Inline]
txt (Text
src, Text
_)]) = do
Doc Text
description <- forall (m :: * -> *). PandocMonad m => [Inline] -> RST m (Doc Text)
inlineListToRST [Inline]
txt
Doc Text
dims <- forall (m :: * -> *). PandocMonad m => Attr -> RST m (Doc Text)
imageDimsToRST Attr
attr
let fig :: Doc Text
fig = Doc Text
"image:: " forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal Text
src
alt :: Doc Text
alt | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
txt = forall a. Doc a
empty
| Bool
otherwise = Doc Text
":alt: " forall a. Semigroup a => a -> a -> a
<> Doc Text
description
capt :: Doc a
capt = forall a. Doc a
empty
(Text
_,[Text]
cls,[(Text, Text)]
_) = Attr
attr
classes :: Doc Text
classes = case [Text]
cls of
[] -> forall a. Doc a
empty
[Text
"align-right"] -> Doc Text
":align: right"
[Text
"align-left"] -> Doc Text
":align: left"
[Text
"align-center"] -> Doc Text
":align: center"
[Text]
_ -> Doc Text
":class: " forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal ([Text] -> Text
T.unwords [Text]
cls)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. IsString a => Int -> Doc a -> Doc a -> Doc a
hang Int
3 Doc Text
".. " (Doc Text
fig forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
alt forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
classes forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
dims forall a. Doc a -> Doc a -> Doc a
$+$ forall a. Doc a
capt) forall a. Doc a -> Doc a -> Doc a
$$ forall a. Doc a
blankline
blockToRST (Para [Inline]
inlines)
| Inline
LineBreak forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Inline]
inlines =
forall (m :: * -> *).
PandocMonad m =>
[[Inline]] -> RST m (Doc Text)
linesToLineBlock forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [[a]]
splitBy (forall a. Eq a => a -> a -> Bool
==Inline
LineBreak) [Inline]
inlines
| Bool
otherwise = do
Doc Text
contents <- forall (m :: * -> *). PandocMonad m => [Inline] -> RST m (Doc Text)
inlineListToRST [Inline]
inlines
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
contents forall a. Semigroup a => a -> a -> a
<> forall a. Doc a
blankline
blockToRST (LineBlock [[Inline]]
lns) =
forall (m :: * -> *).
PandocMonad m =>
[[Inline]] -> RST m (Doc Text)
linesToLineBlock [[Inline]]
lns
blockToRST (RawBlock f :: Format
f@(Format Text
f') Text
str)
| Format
f forall a. Eq a => a -> a -> Bool
== Format
"rst" = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. HasChars a => a -> Doc a
literal Text
str
| Format
f forall a. Eq a => a -> a -> Bool
== Format
"tex" = forall (m :: * -> *). PandocMonad m => Block -> RST m (Doc Text)
blockToRST (Format -> Text -> Block
RawBlock (Text -> Format
Format Text
"latex") Text
str)
| Bool
otherwise = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Doc a
blankline forall a. Semigroup a => a -> a -> a
<> Doc Text
".. raw:: " forall a. Semigroup a => a -> a -> a
<>
forall a. HasChars a => a -> Doc a
literal (Text -> Text
T.toLower Text
f') forall a. Doc a -> Doc a -> Doc a
$+$
forall a. IsString a => Int -> Doc a -> Doc a
nest Int
3 (forall a. HasChars a => a -> Doc a
literal Text
str) forall a. Doc a -> Doc a -> Doc a
$$ forall a. Doc a
blankline
blockToRST Block
HorizontalRule =
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Doc a
blankline forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
"--------------" forall a. Doc a -> Doc a -> Doc a
$$ forall a. Doc a
blankline
blockToRST (Header Int
level (Text
name,[Text]
classes,[(Text, Text)]
_) [Inline]
inlines) = do
Doc Text
contents <- forall (m :: * -> *). PandocMonad m => [Inline] -> RST m (Doc Text)
inlineListToRST [Inline]
inlines
WriterOptions
opts <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> WriterOptions
stOptions
let autoId :: Text
autoId = Extensions -> [Inline] -> Set Text -> Text
uniqueIdent (WriterOptions -> Extensions
writerExtensions WriterOptions
opts) [Inline]
inlines forall a. Monoid a => a
mempty
Bool
isTopLevel <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stTopLevel
if Bool
isTopLevel
then do
let headerChar :: Char
headerChar = if Int
level forall a. Ord a => a -> a -> Bool
> Int
5 then Char
' ' else String
"=-~^'" forall a. [a] -> Int -> a
!! (Int
level forall a. Num a => a -> a -> a
- Int
1)
let border :: Doc Text
border = forall a. HasChars a => a -> Doc a
literal forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.replicate (forall a. (IsString a, HasChars a) => Doc a -> Int
offset Doc Text
contents) forall a b. (a -> b) -> a -> b
$ Char -> Text
T.singleton Char
headerChar
let anchor :: Doc Text
anchor | Text -> Bool
T.null Text
name Bool -> Bool -> Bool
|| Text
name forall a. Eq a => a -> a -> Bool
== Text
autoId = forall a. Doc a
empty
| Bool
otherwise = Doc Text
".. _" forall a. Semigroup a => a -> a -> a
<>
(if (Char -> Bool) -> Text -> Bool
T.any (forall a. Eq a => a -> a -> Bool
==Char
':') Text
name Bool -> Bool -> Bool
||
Int -> Text -> Text
T.take Int
1 Text
name forall a. Eq a => a -> a -> Bool
== Text
"_"
then Doc Text
"`" forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal Text
name forall a. Semigroup a => a -> a -> a
<> Doc Text
"`"
else forall a. HasChars a => a -> Doc a
literal Text
name) forall a. Semigroup a => a -> a -> a
<>
Doc Text
":" forall a. Doc a -> Doc a -> Doc a
$$ forall a. Doc a
blankline
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. IsString a => Doc a -> Doc a
nowrap forall a b. (a -> b) -> a -> b
$ Doc Text
anchor forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
contents forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
border forall a. Doc a -> Doc a -> Doc a
$$ forall a. Doc a
blankline
else do
let rub :: Doc Text
rub = Doc Text
"rubric:: " forall a. Semigroup a => a -> a -> a
<> Doc Text
contents
let name' :: Doc Text
name' | Text -> Bool
T.null Text
name = forall a. Doc a
empty
| Bool
otherwise = Doc Text
":name: " forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal Text
name
let cls :: Doc Text
cls | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
classes = forall a. Doc a
empty
| Bool
otherwise = Doc Text
":class: " forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal ([Text] -> Text
T.unwords [Text]
classes)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. IsString a => Doc a -> Doc a
nowrap forall a b. (a -> b) -> a -> b
$ forall a. IsString a => Int -> Doc a -> Doc a -> Doc a
hang Int
3 Doc Text
".. " (Doc Text
rub forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
name' forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
cls) forall a. Doc a -> Doc a -> Doc a
$$ forall a. Doc a
blankline
blockToRST (CodeBlock (Text
_,[Text]
classes,[(Text, Text)]
kvs) Text
str) = do
WriterOptions
opts <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> WriterOptions
stOptions
let startnum :: Doc Text
startnum = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc Text
"" (\Text
x -> Doc Text
" " forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal Text
x) forall a b. (a -> b) -> a -> b
$ forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"startFrom" [(Text, Text)]
kvs
let numberlines :: Doc Text
numberlines = if Text
"numberLines" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes
then Doc Text
" :number-lines:" forall a. Semigroup a => a -> a -> a
<> Doc Text
startnum
else forall a. Doc a
empty
if Text
"haskell" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes Bool -> Bool -> Bool
&& Text
"literate" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes Bool -> Bool -> Bool
&&
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_literate_haskell WriterOptions
opts
then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. IsString a => String -> Doc a -> Doc a
prefixed String
"> " (forall a. HasChars a => a -> Doc a
literal Text
str) forall a. Doc a -> Doc a -> Doc a
$$ forall a. Doc a
blankline
else forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
(case [Text
c | Text
c <- [Text]
classes,
Text
c forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Text
"sourceCode",Text
"literate",Text
"numberLines",
Text
"number-lines",Text
"example"]] of
[] -> Doc Text
"::"
(Text
lang:[Text]
_) -> (Doc Text
".. code:: " forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal Text
lang) forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
numberlines)
forall a. Doc a -> Doc a -> Doc a
$+$ forall a. IsString a => Int -> Doc a -> Doc a
nest Int
3 (forall a. HasChars a => a -> Doc a
literal Text
str) forall a. Doc a -> Doc a -> Doc a
$$ forall a. Doc a
blankline
blockToRST (BlockQuote [Block]
blocks) = do
Doc Text
contents <- forall (m :: * -> *). PandocMonad m => [Block] -> RST m (Doc Text)
blockListToRST [Block]
blocks
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. IsString a => Int -> Doc a -> Doc a
nest Int
3 Doc Text
contents forall a. Semigroup a => a -> a -> a
<> forall a. Doc a
blankline
blockToRST (Table Attr
_ Caption
blkCapt [ColSpec]
specs TableHead
thead [TableBody]
tbody TableFoot
tfoot) = do
let ([Inline]
caption, [Alignment]
aligns, [Double]
widths, [[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
Doc Text
caption' <- forall (m :: * -> *). PandocMonad m => [Inline] -> RST m (Doc Text)
inlineListToRST [Inline]
caption
let blocksToDoc :: WriterOptions -> [Block] -> StateT WriterState m (Doc Text)
blocksToDoc WriterOptions
opts [Block]
bs = do
WriterOptions
oldOpts <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> WriterOptions
stOptions
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st{ stOptions :: WriterOptions
stOptions = WriterOptions
opts }
Doc Text
result <- forall (m :: * -> *). PandocMonad m => [Block] -> RST m (Doc Text)
blockListToRST [Block]
bs
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st{ stOptions :: WriterOptions
stOptions = WriterOptions
oldOpts }
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
result
WriterOptions
opts <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> WriterOptions
stOptions
let isSimple :: Bool
isSimple = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall a. Eq a => a -> a -> Bool
== Double
0) [Double]
widths Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Int
length [Double]
widths forall a. Ord a => a -> a -> Bool
> Int
1
Doc Text
tbl <- if Bool
isSimple
then do
Doc Text
tbl' <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions
-> (WriterOptions -> [Block] -> m (Doc Text))
-> [[Block]]
-> [[[Block]]]
-> m (Doc Text)
simpleTable WriterOptions
opts forall {m :: * -> *}.
PandocMonad m =>
WriterOptions -> [Block] -> StateT WriterState m (Doc Text)
blocksToDoc [[Block]]
headers [[[Block]]]
rows
if forall a. (IsString a, HasChars a) => Doc a -> Int
offset Doc Text
tbl' forall a. Ord a => a -> a -> Bool
> WriterOptions -> Int
writerColumns WriterOptions
opts
then forall (m :: * -> *) a.
(Monad m, HasChars a) =>
WriterOptions
-> (WriterOptions -> [Block] -> m (Doc a))
-> Bool
-> [Alignment]
-> [Double]
-> [[Block]]
-> [[[Block]]]
-> m (Doc a)
gridTable WriterOptions
opts forall {m :: * -> *}.
PandocMonad m =>
WriterOptions -> [Block] -> StateT WriterState m (Doc Text)
blocksToDoc (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Block]]
headers)
(forall a b. (a -> b) -> [a] -> [b]
map (forall a b. a -> b -> a
const Alignment
AlignDefault) [Alignment]
aligns) [Double]
widths
[[Block]]
headers [[[Block]]]
rows
else forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
tbl'
else forall (m :: * -> *) a.
(Monad m, HasChars a) =>
WriterOptions
-> (WriterOptions -> [Block] -> m (Doc a))
-> Bool
-> [Alignment]
-> [Double]
-> [[Block]]
-> [[[Block]]]
-> m (Doc a)
gridTable WriterOptions
opts forall {m :: * -> *}.
PandocMonad m =>
WriterOptions -> [Block] -> StateT WriterState m (Doc Text)
blocksToDoc (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Block]]
headers)
(forall a b. (a -> b) -> [a] -> [b]
map (forall a b. a -> b -> a
const Alignment
AlignDefault) [Alignment]
aligns) [Double]
widths
[[Block]]
headers [[[Block]]]
rows
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Doc a
blankline forall a. Doc a -> Doc a -> Doc a
$$
(if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
caption
then Doc Text
tbl
else (Doc Text
".. table:: " forall a. Semigroup a => a -> a -> a
<> Doc Text
caption') forall a. Doc a -> Doc a -> Doc a
$$ forall a. Doc a
blankline forall a. Doc a -> Doc a -> Doc a
$$ forall a. IsString a => Int -> Doc a -> Doc a
nest Int
3 Doc Text
tbl) forall a. Doc a -> Doc a -> Doc a
$$
forall a. Doc a
blankline
blockToRST (BulletList [[Block]]
items) = do
[Doc Text]
contents <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *). PandocMonad m => [Block] -> RST m (Doc Text)
bulletListItemToRST [[Block]]
items
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Doc a
blankline forall a. Doc a -> Doc a -> Doc a
$$
(if [[Block]] -> Bool
isTightList [[Block]]
items then forall a. [Doc a] -> Doc a
vcat else forall a. [Doc a] -> Doc a
vsep) [Doc Text]
contents forall a. Doc a -> Doc a -> Doc a
$$
forall a. Doc a
blankline
blockToRST (OrderedList (Int
start, ListNumberStyle
style', ListNumberDelim
delim) [[Block]]
items) = do
let markers :: [Text]
markers = if Int
start forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> Bool -> Bool
&& ListNumberStyle
style' forall a. Eq a => a -> a -> Bool
== ListNumberStyle
DefaultStyle Bool -> Bool -> Bool
&& ListNumberDelim
delim forall a. Eq a => a -> a -> Bool
== ListNumberDelim
DefaultDelim
then forall a. Int -> a -> [a]
replicate (forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Block]]
items) Text
"#."
else forall a. Int -> [a] -> [a]
take (forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Block]]
items) forall a b. (a -> b) -> a -> b
$ (Int, ListNumberStyle, ListNumberDelim) -> [Text]
orderedListMarkers
(Int
start, ListNumberStyle
style', ListNumberDelim
delim)
let maxMarkerLength :: Int
maxMarkerLength = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall a b. (a -> b) -> a -> b
$ forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Text -> Int
T.length [Text]
markers
let markers' :: [Text]
markers' = forall a b. (a -> b) -> [a] -> [b]
map (\Text
m -> let s :: Int
s = Int
maxMarkerLength forall a. Num a => a -> a -> a
- Text -> Int
T.length Text
m
in Text
m forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.replicate Int
s Text
" ") [Text]
markers
[Doc Text]
contents <- forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM forall (m :: * -> *).
PandocMonad m =>
Text -> [Block] -> RST m (Doc Text)
orderedListItemToRST [Text]
markers' [[Block]]
items
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Doc a
blankline forall a. Doc a -> Doc a -> Doc a
$$
(if [[Block]] -> Bool
isTightList [[Block]]
items then forall a. [Doc a] -> Doc a
vcat else forall a. [Doc a] -> Doc a
vsep) [Doc Text]
contents forall a. Doc a -> Doc a -> Doc a
$$
forall a. Doc a
blankline
blockToRST (DefinitionList [([Inline], [[Block]])]
items) = do
[Doc Text]
contents <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *).
PandocMonad m =>
([Inline], [[Block]]) -> RST m (Doc Text)
definitionListItemToRST [([Inline], [[Block]])]
items
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Doc a
blankline forall a. Doc a -> Doc a -> Doc a
$$ forall a. [Doc a] -> Doc a
vcat [Doc Text]
contents forall a. Doc a -> Doc a -> Doc a
$$ forall a. Doc a
blankline
bulletListItemToRST :: PandocMonad m => [Block] -> RST m (Doc Text)
bulletListItemToRST :: forall (m :: * -> *). PandocMonad m => [Block] -> RST m (Doc Text)
bulletListItemToRST [Block]
items = do
Doc Text
contents <- forall (m :: * -> *). PandocMonad m => [Block] -> RST m (Doc Text)
blockListToRST [Block]
items
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. IsString a => Int -> Doc a -> Doc a -> Doc a
hang Int
3 Doc Text
"- " Doc Text
contents forall a. Doc a -> Doc a -> Doc a
$$
if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Block]
items Bool -> Bool -> Bool
|| ([Block] -> Bool
endsWithPlain [Block]
items Bool -> Bool -> Bool
&& Bool -> Bool
not ([Block] -> Bool
endsWithList [Block]
items))
then forall a. Doc a
cr
else forall a. Doc a
blankline
orderedListItemToRST :: PandocMonad m
=> Text
-> [Block]
-> RST m (Doc Text)
orderedListItemToRST :: forall (m :: * -> *).
PandocMonad m =>
Text -> [Block] -> RST m (Doc Text)
orderedListItemToRST Text
marker [Block]
items = do
Doc Text
contents <- forall (m :: * -> *). PandocMonad m => [Block] -> RST m (Doc Text)
blockListToRST [Block]
items
let marker' :: Text
marker' = Text
marker forall a. Semigroup a => a -> a -> a
<> Text
" "
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. IsString a => Int -> Doc a -> Doc a -> Doc a
hang (Text -> Int
T.length Text
marker') (forall a. HasChars a => a -> Doc a
literal Text
marker') Doc Text
contents forall a. Doc a -> Doc a -> Doc a
$$
if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Block]
items Bool -> Bool -> Bool
|| ([Block] -> Bool
endsWithPlain [Block]
items Bool -> Bool -> Bool
&& Bool -> Bool
not ([Block] -> Bool
endsWithList [Block]
items))
then forall a. Doc a
cr
else forall a. Doc a
blankline
endsWithList :: [Block] -> Bool
endsWithList :: [Block] -> Bool
endsWithList [Block]
bs = case forall a. [a] -> Maybe a
lastMay [Block]
bs of
Just (BulletList{}) -> Bool
True
Just (OrderedList{}) -> Bool
True
Maybe Block
_ -> Bool
False
definitionListItemToRST :: PandocMonad m => ([Inline], [[Block]]) -> RST m (Doc Text)
definitionListItemToRST :: forall (m :: * -> *).
PandocMonad m =>
([Inline], [[Block]]) -> RST m (Doc Text)
definitionListItemToRST ([Inline]
label, [[Block]]
defs) = do
Doc Text
label' <- forall (m :: * -> *). PandocMonad m => [Inline] -> RST m (Doc Text)
inlineListToRST [Inline]
label
Doc Text
contents <- forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall a. [Doc a] -> Doc a
vcat forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *). PandocMonad m => [Block] -> RST m (Doc Text)
blockListToRST [[Block]]
defs
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. IsString a => Doc a -> Doc a
nowrap Doc Text
label' forall a. Doc a -> Doc a -> Doc a
$$ forall a. IsString a => Int -> Doc a -> Doc a
nest Int
3 (forall a. Doc a -> Doc a
nestle Doc Text
contents) forall a. Doc a -> Doc a -> Doc a
$$
if [[Block]] -> Bool
isTightList [[Block]]
defs
then forall a. Doc a
cr
else forall a. Doc a
blankline
linesToLineBlock :: PandocMonad m => [[Inline]] -> RST m (Doc Text)
linesToLineBlock :: forall (m :: * -> *).
PandocMonad m =>
[[Inline]] -> RST m (Doc Text)
linesToLineBlock [[Inline]]
inlineLines = do
[Doc Text]
lns <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *). PandocMonad m => [Inline] -> RST m (Doc Text)
inlineListToRST [[Inline]]
inlineLines
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
forall a. [Doc a] -> Doc a
vcat (forall a b. (a -> b) -> [a] -> [b]
map (forall a. IsString a => Int -> Doc a -> Doc a -> Doc a
hang Int
2 (forall a. HasChars a => a -> Doc a
literal Text
"| ")) [Doc Text]
lns) forall a. Semigroup a => a -> a -> a
<> forall a. Doc a
blankline
blockListToRST' :: PandocMonad m
=> Bool
-> [Block]
-> RST m (Doc Text)
blockListToRST' :: forall (m :: * -> *).
PandocMonad m =>
Bool -> [Block] -> RST m (Doc Text)
blockListToRST' Bool
topLevel [Block]
blocks = do
let fixBlocks :: [Block] -> [Block]
fixBlocks (Block
b1:b2 :: Block
b2@(BlockQuote [Block]
_):[Block]
bs)
| Block -> Bool
toClose Block
b1 = Block
b1 forall a. a -> [a] -> [a]
: Block
commentSep forall a. a -> [a] -> [a]
: Block
b2 forall a. a -> [a] -> [a]
: [Block] -> [Block]
fixBlocks [Block]
bs
where
toClose :: Block -> Bool
toClose Plain{} = Bool
False
toClose Header{} = Bool
False
toClose LineBlock{} = Bool
False
toClose Block
HorizontalRule = Bool
False
toClose SimpleFigure{} = Bool
True
toClose Para{} = Bool
False
toClose Block
_ = Bool
True
commentSep :: Block
commentSep = Format -> Text -> Block
RawBlock Format
"rst" Text
"..\n\n"
fixBlocks (Block
b:[Block]
bs) = Block
b forall a. a -> [a] -> [a]
: [Block] -> [Block]
fixBlocks [Block]
bs
fixBlocks [] = []
Bool
tl <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stTopLevel
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\WriterState
s->WriterState
s{stTopLevel :: Bool
stTopLevel=Bool
topLevel})
Doc Text
res <- forall a. [Doc a] -> Doc a
vcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *). PandocMonad m => Block -> RST m (Doc Text)
blockToRST ([Block] -> [Block]
fixBlocks [Block]
blocks)
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\WriterState
s->WriterState
s{stTopLevel :: Bool
stTopLevel=Bool
tl})
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
res
blockListToRST :: PandocMonad m
=> [Block]
-> RST m (Doc Text)
blockListToRST :: forall (m :: * -> *). PandocMonad m => [Block] -> RST m (Doc Text)
blockListToRST = forall (m :: * -> *).
PandocMonad m =>
Bool -> [Block] -> RST m (Doc Text)
blockListToRST' Bool
False
transformInlines :: [Inline] -> [Inline]
transformInlines :: [Inline] -> [Inline]
transformInlines = [Inline] -> [Inline]
insertBS forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall a. (a -> Bool) -> [a] -> [a]
filter Inline -> Bool
hasContents forall b c a. (b -> c) -> (a -> b) -> a -> c
.
[Inline] -> [Inline]
removeSpaceAfterDisplayMath forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([Inline] -> [Inline]
transformNested forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inline -> [Inline]
flatten)
where
hasContents :: Inline -> Bool
hasContents :: Inline -> Bool
hasContents (Str Text
"") = Bool
False
hasContents (Emph []) = Bool
False
hasContents (Underline []) = Bool
False
hasContents (Strong []) = Bool
False
hasContents (Strikeout []) = Bool
False
hasContents (Superscript []) = Bool
False
hasContents (Subscript []) = Bool
False
hasContents (SmallCaps []) = Bool
False
hasContents (Quoted QuoteType
_ []) = Bool
False
hasContents (Cite [Citation]
_ []) = Bool
False
hasContents (Span Attr
_ []) = Bool
False
hasContents (Link Attr
_ [] (Text
"", Text
"")) = Bool
False
hasContents (Image Attr
_ [] (Text
"", Text
"")) = Bool
False
hasContents Inline
_ = Bool
True
removeSpaceAfterDisplayMath :: [Inline] -> [Inline]
removeSpaceAfterDisplayMath (Math MathType
DisplayMath Text
x : [Inline]
zs) =
MathType -> Text -> Inline
Math MathType
DisplayMath Text
x forall a. a -> [a] -> [a]
: forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Eq a => a -> a -> Bool
==Inline
Space) [Inline]
zs
removeSpaceAfterDisplayMath (Inline
x:[Inline]
xs) = Inline
x forall a. a -> [a] -> [a]
: [Inline] -> [Inline]
removeSpaceAfterDisplayMath [Inline]
xs
removeSpaceAfterDisplayMath [] = []
insertBS :: [Inline] -> [Inline]
insertBS :: [Inline] -> [Inline]
insertBS (Inline
x:Inline
y:Inline
z:[Inline]
zs)
| Inline -> Bool
isComplex Inline
y Bool -> Bool -> Bool
&& Inline -> Inline -> Bool
surroundComplex Inline
x Inline
z =
Inline
x forall a. a -> [a] -> [a]
: Inline
y forall a. a -> [a] -> [a]
: [Inline] -> [Inline]
insertBS (Inline
z forall a. a -> [a] -> [a]
: [Inline]
zs)
insertBS (Inline
x:Inline
y:[Inline]
zs)
| Inline -> Bool
isComplex Inline
x Bool -> Bool -> Bool
&& Bool -> Bool
not (Inline -> Bool
okAfterComplex Inline
y) =
Inline
x forall a. a -> [a] -> [a]
: Format -> Text -> Inline
RawInline Format
"rst" Text
"\\ " forall a. a -> [a] -> [a]
: [Inline] -> [Inline]
insertBS (Inline
y forall a. a -> [a] -> [a]
: [Inline]
zs)
| Inline -> Bool
isComplex Inline
y Bool -> Bool -> Bool
&& Bool -> Bool
not (Inline -> Bool
okBeforeComplex Inline
x) =
Inline
x forall a. a -> [a] -> [a]
: Format -> Text -> Inline
RawInline Format
"rst" Text
"\\ " forall a. a -> [a] -> [a]
: [Inline] -> [Inline]
insertBS (Inline
y forall a. a -> [a] -> [a]
: [Inline]
zs)
| Bool
otherwise =
Inline
x forall a. a -> [a] -> [a]
: [Inline] -> [Inline]
insertBS (Inline
y forall a. a -> [a] -> [a]
: [Inline]
zs)
insertBS (Inline
x:[Inline]
ys) = Inline
x forall a. a -> [a] -> [a]
: [Inline] -> [Inline]
insertBS [Inline]
ys
insertBS [] = []
transformNested :: [Inline] -> [Inline]
transformNested :: [Inline] -> [Inline]
transformNested = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Inline -> [Inline]
exportLeadingTrailingSpace
exportLeadingTrailingSpace :: Inline -> [Inline]
exportLeadingTrailingSpace :: Inline -> [Inline]
exportLeadingTrailingSpace Inline
il
| Inline -> Bool
isComplex Inline
il =
let contents :: [Inline]
contents = Inline -> [Inline]
dropInlineParent Inline
il
headSpace :: Bool
headSpace = forall a. [a] -> Maybe a
headMay [Inline]
contents forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Inline
Space
lastSpace :: Bool
lastSpace = forall a. [a] -> Maybe a
lastMay [Inline]
contents forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Inline
Space
in (if Bool
headSpace then (Inline
Spaceforall a. a -> [a] -> [a]
:) else forall a. a -> a
id) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(if Bool
lastSpace then (forall a. [a] -> [a] -> [a]
++ [Inline
Space]) else forall a. a -> a
id) forall a b. (a -> b) -> a -> b
$
[Inline -> [Inline] -> Inline
setInlineChildren Inline
il ([Inline] -> [Inline]
stripLeadingTrailingSpace [Inline]
contents)]
| Bool
otherwise = [Inline
il]
surroundComplex :: Inline -> Inline -> Bool
surroundComplex :: Inline -> Inline -> Bool
surroundComplex (Str Text
s) (Str Text
s')
| Just (Text
_, Char
c) <- Text -> Maybe (Text, Char)
T.unsnoc Text
s
, Just (Char
c', Text
_) <- Text -> Maybe (Char, Text)
T.uncons Text
s'
= case (Char
c, Char
c') of
(Char
'\'',Char
'\'') -> Bool
True
(Char
'"',Char
'"') -> Bool
True
(Char
'<',Char
'>') -> Bool
True
(Char
'[',Char
']') -> Bool
True
(Char
'{',Char
'}') -> Bool
True
(Char, Char)
_ -> Bool
False
surroundComplex Inline
_ Inline
_ = Bool
False
okAfterComplex :: Inline -> Bool
okAfterComplex :: Inline -> Bool
okAfterComplex Inline
Space = Bool
True
okAfterComplex Inline
SoftBreak = Bool
True
okAfterComplex Inline
LineBreak = Bool
True
okAfterComplex (Str (Text -> Maybe (Char, Text)
T.uncons -> Just (Char
c,Text
_)))
= Char -> Bool
isSpace Char
c Bool -> Bool -> Bool
|| Char
c Char -> Text -> Bool
`elemText` Text
"-.,:;!?\\/'\")]}>–—"
okAfterComplex Inline
_ = Bool
False
okBeforeComplex :: Inline -> Bool
okBeforeComplex :: Inline -> Bool
okBeforeComplex Inline
Space = Bool
True
okBeforeComplex Inline
SoftBreak = Bool
True
okBeforeComplex Inline
LineBreak = Bool
True
okBeforeComplex (Str (Text -> Maybe (Text, Char)
T.unsnoc -> Just (Text
_,Char
c)))
= Char -> Bool
isSpace Char
c Bool -> Bool -> Bool
|| Char
c Char -> Text -> Bool
`elemText` Text
"-:/'\"<([{–—"
okBeforeComplex Inline
_ = Bool
False
isComplex :: Inline -> Bool
isComplex :: Inline -> Bool
isComplex (Emph [Inline]
_) = Bool
True
isComplex (Underline [Inline]
_) = Bool
True
isComplex (Strong [Inline]
_) = Bool
True
isComplex (SmallCaps [Inline]
_) = Bool
True
isComplex (Strikeout [Inline]
_) = Bool
True
isComplex (Superscript [Inline]
_) = Bool
True
isComplex (Subscript [Inline]
_) = Bool
True
isComplex Link{} = Bool
True
isComplex Image{} = Bool
True
isComplex (Code Attr
_ Text
_) = Bool
True
isComplex (Math MathType
_ Text
_) = Bool
True
isComplex (Cite [Citation]
_ (Inline
x:[Inline]
_)) = Inline -> Bool
isComplex Inline
x
isComplex (Span Attr
_ (Inline
x:[Inline]
_)) = Inline -> Bool
isComplex Inline
x
isComplex Inline
_ = Bool
False
flatten :: Inline -> [Inline]
flatten :: Inline -> [Inline]
flatten Inline
outer
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
contents = [Inline
outer]
| Bool
otherwise = [Inline] -> [Inline]
combineAll [Inline]
contents
where contents :: [Inline]
contents = Inline -> [Inline]
dropInlineParent Inline
outer
combineAll :: [Inline] -> [Inline]
combineAll = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' [Inline] -> Inline -> [Inline]
combine []
combine :: [Inline] -> Inline -> [Inline]
combine :: [Inline] -> Inline -> [Inline]
combine [Inline]
f Inline
i =
case (Inline
outer, Inline
i) of
(Quoted QuoteType
_ [Inline]
_, Inline
_) -> [Inline] -> Inline -> [Inline]
keep [Inline]
f Inline
i
(Inline
_, Quoted QuoteType
_ [Inline]
_) -> [Inline] -> Inline -> [Inline]
keep [Inline]
f Inline
i
(Span (Text
_,[Text]
_,[]) [Inline]
_, Inline
_) -> [Inline] -> Inline -> [Inline]
keep [Inline]
f Inline
i
(Inline
_, Span (Text
_,[Text]
_,[]) [Inline]
_) -> [Inline] -> Inline -> [Inline]
keep [Inline]
f Inline
i
( Link{}, Image{}) -> [Inline] -> Inline -> [Inline]
keep [Inline]
f Inline
i
(Inline
_, Link{}) -> forall {a}. [a] -> a -> [a]
emerge [Inline]
f Inline
i
(Emph [Inline]
_, Strong [Inline]
_) -> forall {a}. [a] -> a -> [a]
emerge [Inline]
f Inline
i
(Inline
_, Inline
_) -> [Inline] -> Inline -> [Inline]
collapse [Inline]
f Inline
i
emerge :: [a] -> a -> [a]
emerge [a]
f a
i = [a]
f forall a. Semigroup a => a -> a -> a
<> [a
i]
keep :: [Inline] -> Inline -> [Inline]
keep [Inline]
f Inline
i = [Inline] -> [Inline] -> [Inline]
appendToLast [Inline]
f [Inline
i]
collapse :: [Inline] -> Inline -> [Inline]
collapse [Inline]
f Inline
i = [Inline] -> [Inline] -> [Inline]
appendToLast [Inline]
f forall a b. (a -> b) -> a -> b
$ Inline -> [Inline]
dropInlineParent Inline
i
appendToLast :: [Inline] -> [Inline] -> [Inline]
appendToLast :: [Inline] -> [Inline] -> [Inline]
appendToLast [Inline]
flattened [Inline]
toAppend =
case forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [Inline]
flattened of
Maybe (NonEmpty Inline)
Nothing -> [Inline -> [Inline] -> Inline
setInlineChildren Inline
outer [Inline]
toAppend]
Just NonEmpty Inline
xs ->
if Inline -> Bool
isOuter Inline
lastFlat
then forall a. NonEmpty a -> [a]
NE.init NonEmpty Inline
xs forall a. Semigroup a => a -> a -> a
<> [Inline -> [Inline] -> Inline
appendTo Inline
lastFlat [Inline]
toAppend]
else [Inline]
flattened forall a. Semigroup a => a -> a -> a
<> [Inline -> [Inline] -> Inline
setInlineChildren Inline
outer [Inline]
toAppend]
where
lastFlat :: Inline
lastFlat = forall a. NonEmpty a -> a
NE.last NonEmpty Inline
xs
appendTo :: Inline -> [Inline] -> Inline
appendTo Inline
o [Inline]
i = ([Inline] -> [Inline]) -> Inline -> Inline
mapNested (forall a. Semigroup a => a -> a -> a
<> [Inline]
i) Inline
o
isOuter :: Inline -> Bool
isOuter Inline
i = Inline -> Inline
emptyParent Inline
i forall a. Eq a => a -> a -> Bool
== Inline -> Inline
emptyParent Inline
outer
emptyParent :: Inline -> Inline
emptyParent Inline
i = Inline -> [Inline] -> Inline
setInlineChildren Inline
i []
mapNested :: ([Inline] -> [Inline]) -> Inline -> Inline
mapNested :: ([Inline] -> [Inline]) -> Inline -> Inline
mapNested [Inline] -> [Inline]
f Inline
i = Inline -> [Inline] -> Inline
setInlineChildren Inline
i ([Inline] -> [Inline]
f (Inline -> [Inline]
dropInlineParent Inline
i))
dropInlineParent :: Inline -> [Inline]
dropInlineParent :: Inline -> [Inline]
dropInlineParent (Link Attr
_ [Inline]
i (Text, Text)
_) = [Inline]
i
dropInlineParent (Emph [Inline]
i) = [Inline]
i
dropInlineParent (Underline [Inline]
i) = [Inline]
i
dropInlineParent (Strong [Inline]
i) = [Inline]
i
dropInlineParent (Strikeout [Inline]
i) = [Inline]
i
dropInlineParent (Superscript [Inline]
i) = [Inline]
i
dropInlineParent (Subscript [Inline]
i) = [Inline]
i
dropInlineParent (SmallCaps [Inline]
i) = [Inline]
i
dropInlineParent (Cite [Citation]
_ [Inline]
i) = [Inline]
i
dropInlineParent (Image Attr
_ [Inline]
i (Text, Text)
_) = [Inline]
i
dropInlineParent (Span Attr
_ [Inline]
i) = [Inline]
i
dropInlineParent (Quoted QuoteType
_ [Inline]
i) = [Inline]
i
dropInlineParent Inline
i = [Inline
i]
setInlineChildren :: Inline -> [Inline] -> Inline
setInlineChildren :: Inline -> [Inline] -> Inline
setInlineChildren (Link Attr
a [Inline]
_ (Text, Text)
t) [Inline]
i = Attr -> [Inline] -> (Text, Text) -> Inline
Link Attr
a [Inline]
i (Text, Text)
t
setInlineChildren (Emph [Inline]
_) [Inline]
i = [Inline] -> Inline
Emph [Inline]
i
setInlineChildren (Underline [Inline]
_) [Inline]
i = [Inline] -> Inline
Underline [Inline]
i
setInlineChildren (Strong [Inline]
_) [Inline]
i = [Inline] -> Inline
Strong [Inline]
i
setInlineChildren (Strikeout [Inline]
_) [Inline]
i = [Inline] -> Inline
Strikeout [Inline]
i
setInlineChildren (Superscript [Inline]
_) [Inline]
i = [Inline] -> Inline
Superscript [Inline]
i
setInlineChildren (Subscript [Inline]
_) [Inline]
i = [Inline] -> Inline
Subscript [Inline]
i
setInlineChildren (SmallCaps [Inline]
_) [Inline]
i = [Inline] -> Inline
SmallCaps [Inline]
i
setInlineChildren (Quoted QuoteType
q [Inline]
_) [Inline]
i = QuoteType -> [Inline] -> Inline
Quoted QuoteType
q [Inline]
i
setInlineChildren (Cite [Citation]
c [Inline]
_) [Inline]
i = [Citation] -> [Inline] -> Inline
Cite [Citation]
c [Inline]
i
setInlineChildren (Image Attr
a [Inline]
_ (Text, Text)
t) [Inline]
i = Attr -> [Inline] -> (Text, Text) -> Inline
Image Attr
a [Inline]
i (Text, Text)
t
setInlineChildren (Span Attr
a [Inline]
_) [Inline]
i = Attr -> [Inline] -> Inline
Span Attr
a [Inline]
i
setInlineChildren Inline
leaf [Inline]
_ = Inline
leaf
inlineListToRST :: PandocMonad m => [Inline] -> RST m (Doc Text)
inlineListToRST :: forall (m :: * -> *). PandocMonad m => [Inline] -> RST m (Doc Text)
inlineListToRST = forall (m :: * -> *). PandocMonad m => [Inline] -> RST m (Doc Text)
writeInlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Walkable a b => (a -> a) -> b -> b
walk [Inline] -> [Inline]
transformInlines
writeInlines :: PandocMonad m => [Inline] -> RST m (Doc Text)
writeInlines :: forall (m :: * -> *). PandocMonad m => [Inline] -> RST m (Doc Text)
writeInlines [Inline]
lst =
forall a. [Doc a] -> Doc a
hcat 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 -> RST m (Doc Text)
inlineToRST [Inline]
lst
inlineToRST :: PandocMonad m => Inline -> RST m (Doc Text)
inlineToRST :: forall (m :: * -> *). PandocMonad m => Inline -> RST m (Doc Text)
inlineToRST (Span (Text
_,[Text]
_,[(Text, Text)]
kvs) [Inline]
ils) = do
Doc Text
contents <- forall (m :: * -> *). PandocMonad m => [Inline] -> RST m (Doc Text)
writeInlines [Inline]
ils
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"role" [(Text, Text)]
kvs of
Just Text
role -> Doc Text
":" forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal Text
role forall a. Semigroup a => a -> a -> a
<> Doc Text
":`" forall a. Semigroup a => a -> a -> a
<> Doc Text
contents forall a. Semigroup a => a -> a -> a
<> Doc Text
"`"
Maybe Text
Nothing -> Doc Text
contents
inlineToRST (Emph [Inline]
lst) = do
Doc Text
contents <- forall (m :: * -> *). PandocMonad m => [Inline] -> RST m (Doc Text)
writeInlines [Inline]
lst
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
"*" forall a. Semigroup a => a -> a -> a
<> Doc Text
contents forall a. Semigroup a => a -> a -> a
<> Doc Text
"*"
inlineToRST (Underline [Inline]
lst) =
forall (m :: * -> *). PandocMonad m => Inline -> RST m (Doc Text)
inlineToRST ([Inline] -> Inline
Emph [Inline]
lst)
inlineToRST (Strong [Inline]
lst) = do
Doc Text
contents <- forall (m :: * -> *). PandocMonad m => [Inline] -> RST m (Doc Text)
writeInlines [Inline]
lst
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
"**" forall a. Semigroup a => a -> a -> a
<> Doc Text
contents forall a. Semigroup a => a -> a -> a
<> Doc Text
"**"
inlineToRST (Strikeout [Inline]
lst) = do
Doc Text
contents <- forall (m :: * -> *). PandocMonad m => [Inline] -> RST m (Doc Text)
writeInlines [Inline]
lst
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
"[STRIKEOUT:" forall a. Semigroup a => a -> a -> a
<> Doc Text
contents forall a. Semigroup a => a -> a -> a
<> Doc Text
"]"
inlineToRST (Superscript [Inline]
lst) = do
Doc Text
contents <- forall (m :: * -> *). PandocMonad m => [Inline] -> RST m (Doc Text)
writeInlines [Inline]
lst
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
":sup:`" forall a. Semigroup a => a -> a -> a
<> Doc Text
contents forall a. Semigroup a => a -> a -> a
<> Doc Text
"`"
inlineToRST (Subscript [Inline]
lst) = do
Doc Text
contents <- forall (m :: * -> *). PandocMonad m => [Inline] -> RST m (Doc Text)
writeInlines [Inline]
lst
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
":sub:`" forall a. Semigroup a => a -> a -> a
<> Doc Text
contents forall a. Semigroup a => a -> a -> a
<> Doc Text
"`"
inlineToRST (SmallCaps [Inline]
lst) = forall (m :: * -> *). PandocMonad m => [Inline] -> RST m (Doc Text)
writeInlines [Inline]
lst
inlineToRST (Quoted QuoteType
SingleQuote [Inline]
lst) = do
Doc Text
contents <- forall (m :: * -> *). PandocMonad m => [Inline] -> RST m (Doc Text)
writeInlines [Inline]
lst
WriterOptions
opts <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> WriterOptions
stOptions
if forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_smart WriterOptions
opts
then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
"'" forall a. Semigroup a => a -> a -> a
<> Doc Text
contents forall a. Semigroup a => a -> a -> a
<> Doc Text
"'"
else forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
"‘" forall a. Semigroup a => a -> a -> a
<> Doc Text
contents forall a. Semigroup a => a -> a -> a
<> Doc Text
"’"
inlineToRST (Quoted QuoteType
DoubleQuote [Inline]
lst) = do
Doc Text
contents <- forall (m :: * -> *). PandocMonad m => [Inline] -> RST m (Doc Text)
writeInlines [Inline]
lst
WriterOptions
opts <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> WriterOptions
stOptions
if forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_smart WriterOptions
opts
then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
"\"" forall a. Semigroup a => a -> a -> a
<> Doc Text
contents forall a. Semigroup a => a -> a -> a
<> Doc Text
"\""
else forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
"“" forall a. Semigroup a => a -> a -> a
<> Doc Text
contents forall a. Semigroup a => a -> a -> a
<> Doc Text
"”"
inlineToRST (Cite [Citation]
_ [Inline]
lst) =
forall (m :: * -> *). PandocMonad m => [Inline] -> RST m (Doc Text)
writeInlines [Inline]
lst
inlineToRST (Code (Text
_,[Text
"interpreted-text"],[(Text
"role",Text
role)]) Text
str) =
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
":" forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal Text
role forall a. Semigroup a => a -> a -> a
<> Doc Text
":`" forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal Text
str forall a. Semigroup a => a -> a -> a
<> Doc Text
"`"
inlineToRST (Code Attr
_ Text
str) = do
WriterOptions
opts <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> WriterOptions
stOptions
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
if Char
'`' Char -> Text -> Bool
`elemText` Text
str
then Doc Text
":literal:`" forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal (WriterOptions -> Text -> Text
escapeText WriterOptions
opts (Text -> Text
trim Text
str)) forall a. Semigroup a => a -> a -> a
<> Doc Text
"`"
else Doc Text
"``" forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal (Text -> Text
trim Text
str) forall a. Semigroup a => a -> a -> a
<> Doc Text
"``"
inlineToRST (Str Text
str) = do
WriterOptions
opts <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> WriterOptions
stOptions
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. HasChars a => a -> Doc a
literal forall a b. (a -> b) -> a -> b
$
(if forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_smart WriterOptions
opts
then WriterOptions -> Text -> Text
unsmartify WriterOptions
opts
else forall a. a -> a
id) forall a b. (a -> b) -> a -> b
$ WriterOptions -> Text -> Text
escapeText WriterOptions
opts Text
str
inlineToRST (Math MathType
t Text
str) = do
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st{ stHasMath :: Bool
stHasMath = Bool
True }
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if MathType
t forall a. Eq a => a -> a -> Bool
== MathType
InlineMath
then Doc Text
":math:`" forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal Text
str forall a. Semigroup a => a -> a -> a
<> Doc Text
"`"
else if Char
'\n' Char -> Text -> Bool
`elemText` Text
str
then forall a. Doc a
blankline forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
".. math::" forall a. Doc a -> Doc a -> Doc a
$$
forall a. Doc a
blankline forall a. Doc a -> Doc a -> Doc a
$$ forall a. IsString a => Int -> Doc a -> Doc a
nest Int
3 (forall a. HasChars a => a -> Doc a
literal Text
str) forall a. Doc a -> Doc a -> Doc a
$$ forall a. Doc a
blankline
else forall a. Doc a
blankline forall a. Doc a -> Doc a -> Doc a
$$ (Doc Text
".. math:: " forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal Text
str) forall a. Doc a -> Doc a -> Doc a
$$ forall a. Doc a
blankline
inlineToRST il :: Inline
il@(RawInline Format
f Text
x)
| Format
f forall a. Eq a => a -> a -> Bool
== Format
"rst" = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. HasChars a => a -> Doc a
literal Text
x
| Format
f forall a. Eq a => a -> a -> Bool
== Format
"latex" Bool -> Bool -> Bool
|| Format
f forall a. Eq a => a -> a -> Bool
== Format
"tex" = do
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st{ stHasRawTeX :: Bool
stHasRawTeX = Bool
True }
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
":raw-latex:`" forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal Text
x forall a. Semigroup a => a -> a -> a
<> Doc Text
"`"
| Bool
otherwise = forall a. Doc a
empty forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (Inline -> LogMessage
InlineNotRendered Inline
il)
inlineToRST Inline
LineBreak = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Doc a
cr
inlineToRST Inline
Space = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Doc a
space
inlineToRST Inline
SoftBreak = do
WrapOption
wrapText <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a b. (a -> b) -> a -> b
$ WriterOptions -> WrapOption
writerWrapText forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterState -> WriterOptions
stOptions
case WrapOption
wrapText of
WrapOption
WrapPreserve -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Doc a
cr
WrapOption
WrapAuto -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Doc a
space
WrapOption
WrapNone -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Doc a
space
inlineToRST (Link Attr
_ [Str Text
str] (Text
src, Text
_))
| Text -> Bool
isURI Text
src Bool -> Bool -> Bool
&&
if Text
"mailto:" Text -> Text -> Bool
`T.isPrefixOf` Text
src
then Text
src forall a. Eq a => a -> a -> Bool
== Text -> Text
escapeURI (Text
"mailto:" forall a. Semigroup a => a -> a -> a
<> Text
str)
else Text
src forall a. Eq a => a -> a -> Bool
== Text -> Text
escapeURI Text
str = do
let srcSuffix :: Text
srcSuffix = forall a. a -> Maybe a -> a
fromMaybe Text
src (Text -> Text -> Maybe Text
T.stripPrefix Text
"mailto:" Text
src)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. HasChars a => a -> Doc a
literal Text
srcSuffix
inlineToRST (Link Attr
_ [Image Attr
attr [Inline]
alt (Text
imgsrc,Text
imgtit)] (Text
src, Text
_tit)) = do
Doc Text
label <- forall (m :: * -> *).
PandocMonad m =>
Attr -> [Inline] -> (Text, Text) -> Maybe Text -> RST m (Doc Text)
registerImage Attr
attr [Inline]
alt (Text
imgsrc,Text
imgtit) (forall a. a -> Maybe a
Just Text
src)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
"|" forall a. Semigroup a => a -> a -> a
<> Doc Text
label forall a. Semigroup a => a -> a -> a
<> Doc Text
"|"
inlineToRST (Link Attr
_ [Inline]
txt (Text
src, Text
tit)) = do
Bool
useReferenceLinks <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a b. (a -> b) -> a -> b
$ WriterOptions -> Bool
writerReferenceLinks forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterState -> WriterOptions
stOptions
Doc Text
linktext <- forall (m :: * -> *). PandocMonad m => [Inline] -> RST m (Doc Text)
writeInlines forall a b. (a -> b) -> a -> b
$ forall a. Many a -> [a]
B.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. Many Inline -> Many Inline
B.trimInlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Many a
B.fromList forall a b. (a -> b) -> a -> b
$ [Inline]
txt
if Bool
useReferenceLinks
then do Refs
refs <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Refs
stLinks
case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup [Inline]
txt Refs
refs of
Just (Text
src',Text
tit') ->
if Text
src forall a. Eq a => a -> a -> Bool
== Text
src' Bool -> Bool -> Bool
&& Text
tit forall a. Eq a => a -> a -> Bool
== Text
tit'
then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
"`" forall a. Semigroup a => a -> a -> a
<> Doc Text
linktext forall a. Semigroup a => a -> a -> a
<> Doc Text
"`_"
else
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
"`" forall a. Semigroup a => a -> a -> a
<> Doc Text
linktext forall a. Semigroup a => a -> a -> a
<> Doc Text
" <" forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal Text
src forall a. Semigroup a => a -> a -> a
<> Doc Text
">`__"
Maybe (Text, Text)
Nothing -> do
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st { stLinks :: Refs
stLinks = ([Inline]
txt,(Text
src,Text
tit))forall a. a -> [a] -> [a]
:Refs
refs }
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
"`" forall a. Semigroup a => a -> a -> a
<> Doc Text
linktext forall a. Semigroup a => a -> a -> a
<> Doc Text
"`_"
else forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
"`" forall a. Semigroup a => a -> a -> a
<> Doc Text
linktext forall a. Semigroup a => a -> a -> a
<> Doc Text
" <" forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal Text
src forall a. Semigroup a => a -> a -> a
<> Doc Text
">`__"
inlineToRST (Image Attr
attr [Inline]
alternate (Text
source, Text
tit)) = do
Doc Text
label <- forall (m :: * -> *).
PandocMonad m =>
Attr -> [Inline] -> (Text, Text) -> Maybe Text -> RST m (Doc Text)
registerImage Attr
attr [Inline]
alternate (Text
source,Text
tit) forall a. Maybe a
Nothing
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
"|" forall a. Semigroup a => a -> a -> a
<> Doc Text
label forall a. Semigroup a => a -> a -> a
<> Doc Text
"|"
inlineToRST (Note [Block]
contents) = do
[[Block]]
notes <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> [[Block]]
stNotes
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st { stNotes :: [[Block]]
stNotes = [Block]
contentsforall a. a -> [a] -> [a]
:[[Block]]
notes }
let ref :: String
ref = forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Block]]
notes forall a. Num a => a -> a -> a
+ Int
1
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
" [" forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => String -> Doc a
text String
ref forall a. Semigroup a => a -> a -> a
<> Doc Text
"]_"
registerImage :: PandocMonad m => Attr -> [Inline] -> Target -> Maybe Text -> RST m (Doc Text)
registerImage :: forall (m :: * -> *).
PandocMonad m =>
Attr -> [Inline] -> (Text, Text) -> Maybe Text -> RST m (Doc Text)
registerImage Attr
attr [Inline]
alt (Text
src,Text
tit) Maybe Text
mbtarget = do
[([Inline], (Attr, Text, Text, Maybe Text))]
pics <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> [([Inline], (Attr, Text, Text, Maybe Text))]
stImages
Int
imgId <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Int
stImageId
let getImageName :: StateT WriterState m [Inline]
getImageName = do
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st{ stImageId :: Int
stImageId = Int
imgId forall a. Num a => a -> a -> a
+ Int
1 }
forall (m :: * -> *) a. Monad m => a -> m a
return [Text -> Inline
Str (Text
"image" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow Int
imgId)]
[Inline]
txt <- case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup [Inline]
alt [([Inline], (Attr, Text, Text, Maybe Text))]
pics of
Just (Attr
a,Text
s,Text
t,Maybe Text
mbt) ->
if (Attr
a,Text
s,Text
t,Maybe Text
mbt) forall a. Eq a => a -> a -> Bool
== (Attr
attr,Text
src,Text
tit,Maybe Text
mbtarget)
then forall (m :: * -> *) a. Monad m => a -> m a
return [Inline]
alt
else do
[Inline]
alt' <- StateT WriterState m [Inline]
getImageName
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st { stImages :: [([Inline], (Attr, Text, Text, Maybe Text))]
stImages =
([Inline]
alt', (Attr
attr,Text
src,Text
tit, Maybe Text
mbtarget))forall a. a -> [a] -> [a]
:WriterState -> [([Inline], (Attr, Text, Text, Maybe Text))]
stImages WriterState
st }
forall (m :: * -> *) a. Monad m => a -> m a
return [Inline]
alt'
Maybe (Attr, Text, Text, Maybe Text)
Nothing -> do
[Inline]
alt' <- if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
alt Bool -> Bool -> Bool
|| [Inline]
alt forall a. Eq a => a -> a -> Bool
== [Text -> Inline
Str Text
""]
then StateT WriterState m [Inline]
getImageName
else forall (m :: * -> *) a. Monad m => a -> m a
return [Inline]
alt
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st { stImages :: [([Inline], (Attr, Text, Text, Maybe Text))]
stImages =
([Inline]
alt', (Attr
attr,Text
src,Text
tit, Maybe Text
mbtarget))forall a. a -> [a] -> [a]
:WriterState -> [([Inline], (Attr, Text, Text, Maybe Text))]
stImages WriterState
st }
forall (m :: * -> *) a. Monad m => a -> m a
return [Inline]
alt'
forall (m :: * -> *). PandocMonad m => [Inline] -> RST m (Doc Text)
inlineListToRST [Inline]
txt
imageDimsToRST :: PandocMonad m => Attr -> RST m (Doc Text)
imageDimsToRST :: forall (m :: * -> *). PandocMonad m => Attr -> RST m (Doc Text)
imageDimsToRST Attr
attr = do
let (Text
ident, [Text]
_, [(Text, Text)]
_) = Attr
attr
name :: Doc Text
name = if Text -> Bool
T.null Text
ident
then forall a. Doc a
empty
else Doc Text
":name: " forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal Text
ident
showDim :: Direction -> Doc a
showDim Direction
dir = let cols :: a -> Doc a
cols a
d = Doc a
":" forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => String -> Doc a
text (forall a. Show a => a -> String
show Direction
dir) forall a. Semigroup a => a -> a -> a
<> Doc a
": " forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => String -> Doc a
text (forall a. Show a => a -> String
show a
d)
in case Direction -> Attr -> Maybe Dimension
dimension Direction
dir Attr
attr of
Just (Percent Double
a) ->
case Direction
dir of
Direction
Height -> forall a. Doc a
empty
Direction
Width -> forall {a} {a}. (HasChars a, Show a) => a -> Doc a
cols (Double -> Dimension
Percent Double
a)
Just Dimension
dim -> forall {a} {a}. (HasChars a, Show a) => a -> Doc a
cols Dimension
dim
Maybe Dimension
Nothing -> forall a. Doc a
empty
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Doc a
cr forall a. Semigroup a => a -> a -> a
<> Doc Text
name forall a. Doc a -> Doc a -> Doc a
$$ forall {a}. HasChars a => Direction -> Doc a
showDim Direction
Width forall a. Doc a -> Doc a -> Doc a
$$ forall {a}. HasChars a => Direction -> Doc a
showDim Direction
Height
simpleTable :: PandocMonad m
=> WriterOptions
-> (WriterOptions -> [Block] -> m (Doc Text))
-> [[Block]]
-> [[[Block]]]
-> m (Doc Text)
simpleTable :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions
-> (WriterOptions -> [Block] -> m (Doc Text))
-> [[Block]]
-> [[[Block]]]
-> m (Doc Text)
simpleTable WriterOptions
opts WriterOptions -> [Block] -> m (Doc Text)
blocksToDoc [[Block]]
headers [[[Block]]]
rows = do
let fixEmpties :: [Doc a] -> [Doc a]
fixEmpties (Doc a
d:[Doc a]
ds) = if forall a. Doc a -> Bool
isEmpty Doc a
d
then forall a. HasChars a => a -> Doc a
literal a
"\\ " forall a. a -> [a] -> [a]
: [Doc a]
ds
else Doc a
d forall a. a -> [a] -> [a]
: [Doc a]
ds
fixEmpties [] = []
[Doc Text]
headerDocs <- if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Block]]
headers
then forall (m :: * -> *) a. Monad m => a -> m a
return []
else forall {a}. HasChars a => [Doc a] -> [Doc a]
fixEmpties 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 (WriterOptions -> [Block] -> m (Doc Text)
blocksToDoc WriterOptions
opts) [[Block]]
headers
[[Doc Text]]
rowDocs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {a}. HasChars a => [Doc a] -> [Doc a]
fixEmpties forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (WriterOptions -> [Block] -> m (Doc Text)
blocksToDoc WriterOptions
opts)) [[[Block]]]
rows
let numChars :: [Doc Text] -> Int
numChars = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. (IsString a, HasChars a) => Doc a -> Int
offset
let colWidths :: [Int]
colWidths = forall a b. (a -> b) -> [a] -> [b]
map [Doc Text] -> Int
numChars forall a b. (a -> b) -> a -> b
$ forall a. [[a]] -> [[a]]
transpose ([Doc Text]
headerDocs forall a. a -> [a] -> [a]
: [[Doc Text]]
rowDocs)
let toRow :: [Doc Text] -> Doc Text
toRow = forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> [a] -> [a]
intersperse (forall a. HasChars a => Int -> Doc a -> Doc a
lblock Int
1 Doc Text
" ") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall a. HasChars a => Int -> Doc a -> Doc a
lblock [Int]
colWidths
let hline :: Doc Text
hline = forall a. IsString a => Doc a -> Doc a
nowrap forall a b. (a -> b) -> a -> b
$ forall a. [Doc a] -> Doc a
hsep (forall a b. (a -> b) -> [a] -> [b]
map (\Int
n -> forall a. HasChars a => a -> Doc a
literal (Int -> Text -> Text
T.replicate Int
n Text
"=")) [Int]
colWidths)
let hdr :: Doc Text
hdr = if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Block]]
headers
then forall a. Monoid a => a
mempty
else Doc Text
hline forall a. Doc a -> Doc a -> Doc a
$$ [Doc Text] -> Doc Text
toRow [Doc Text]
headerDocs
let bdy :: Doc Text
bdy = forall a. [Doc a] -> Doc a
vcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map [Doc Text] -> Doc Text
toRow [[Doc Text]]
rowDocs
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
hdr forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
hline forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
bdy forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
hline