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