{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}
module Text.Pandoc.Writers.RST ( writeRST, flatten ) where
import Control.Monad.State.Strict
import Data.Char (isSpace)
import Data.List (transpose, intersperse, foldl')
import qualified Data.List.NonEmpty as NE
import Data.Maybe (fromMaybe)
import qualified Data.Text as T
import Data.Text (Text)
import qualified Text.Pandoc.Builder as B
import Text.Pandoc.Class.PandocMonad (PandocMonad, report)
import Text.Pandoc.Definition
import Text.Pandoc.ImageSize
import Text.Pandoc.Logging
import Text.Pandoc.Options
import Text.DocLayout
import Text.Pandoc.Shared
import Text.Pandoc.Templates (renderTemplate)
import Text.Pandoc.Writers.Shared
import Text.Pandoc.Walk
import Safe (lastMay)
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 opts :: WriterOptions
opts document :: 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 = 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
meta blocks :: [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 "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 _ -> Int -> [Block] -> [Block]
normalizeHeadings 1 [Block]
blocks
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 "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 "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 "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 "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 "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 "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 "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 "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
Nothing -> Doc Text
main
Just tpl :: 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 lev :: Int
lev (Header l :: Int
l a :: Attr
a i :: [Inline]
i:bs :: [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
+1) [Block]
cont [Block] -> [Block] -> [Block]
forall a. [a] -> [a] -> [a]
++ Int -> [Block] -> [Block]
normalizeHeadings Int
lev [Block]
bs'
where (cont :: [Block]
cont,bs' :: [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 level :: Int
level (Header l' :: Int
l' _ _) = Int
l' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
level
headerLtEq _ _ = Bool
False
normalizeHeadings lev :: Int
lev (b :: Block
b:bs :: [Block]
bs) = Block
bBlock -> [Block] -> [Block]
forall a. a -> [a] -> [a]
:Int -> [Block] -> [Block]
normalizeHeadings Int
lev [Block]
bs
normalizeHeadings _ [] = []
refsToRST :: PandocMonad m => Refs -> RST m (Doc Text)
refsToRST :: Refs -> RST m (Doc Text)
refsToRST refs :: 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 (label :: [Inline]
label, (src :: Text
src, _)) = 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 -> 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 '`' 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 '`'
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
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
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 notes :: [[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 [1..] [[Block]]
notes
noteToRST :: PandocMonad m => Int -> [Block] -> RST m (Doc Text)
noteToRST :: Int -> [Block] -> RST m (Doc Text)
noteToRST num :: Int
num note :: [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
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 -> 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 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 refs :: [([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 (label :: [Inline]
label, (attr :: Attr
attr, src :: Text
src, _, mbtarget :: 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 (_, cls :: [Text]
cls, _) = Attr
attr
classes :: Doc Text
classes = case [Text]
cls of
[] -> Doc Text
forall a. Doc a
empty
["align-top"] -> ":align: top"
["align-middle"] -> ":align: middle"
["align-bottom"] -> ":align: bottom"
["align-center"] -> Doc Text
forall a. Doc a
empty
["align-right"] -> Doc Text
forall a. Doc a
empty
["align-left"] -> Doc Text
forall a. Doc a
empty
_ -> ":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
forall a. Semigroup a => a -> a -> a
<> Doc Text
label' Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> "| 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 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
Nothing -> Doc Text
forall a. Doc a
empty
Just t :: Text
t -> " :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 o :: 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' _ _ [] = []
escapeString' firstChar :: Bool
firstChar opts :: a
opts (c :: Char
c:cs :: String
cs) =
case Char
c of
_ | Char
c Char -> Text -> Bool
`elemText` "\\`*_|" Bool -> Bool -> Bool
&&
(Bool
firstChar Bool -> Bool -> Bool
|| String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
cs) -> '\\'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
'\'' | Extension -> a -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_smart a
opts -> '\\'Char -> String -> String
forall a. a -> [a] -> [a]
:'\''Char -> String -> String
forall a. a -> [a] -> [a]
:Bool -> a -> String -> String
escapeString' Bool
False a
opts String
cs
'"' | Extension -> a -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_smart a
opts -> '\\'Char -> String -> String
forall a. a -> [a] -> [a]
:'"'Char -> String -> String
forall a. a -> [a] -> [a]
:Bool -> a -> String -> String
escapeString' Bool
False a
opts String
cs
'-' | Extension -> a -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_smart a
opts ->
case String
cs of
'-':_ -> '\\'Char -> String -> String
forall a. a -> [a] -> [a]
:'-'Char -> String -> String
forall a. a -> [a] -> [a]
:Bool -> a -> String -> String
escapeString' Bool
False a
opts String
cs
_ -> '-'Char -> String -> String
forall a. a -> [a] -> [a]
:Bool -> a -> String -> String
escapeString' Bool
False a
opts String
cs
'.' | Extension -> a -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_smart a
opts ->
case String
cs of
'.':'.':rest :: String
rest -> '\\'Char -> String -> String
forall a. a -> [a] -> [a]
:'.'Char -> String -> String
forall a. a -> [a] -> [a]
:'.'Char -> String -> String
forall a. a -> [a] -> [a]
:'.'Char -> String -> String
forall a. a -> [a] -> [a]
:Bool -> a -> String -> String
escapeString' Bool
False a
opts String
rest
_ -> '.'Char -> String -> String
forall a. a -> [a] -> [a]
:Bool -> a -> String -> String
escapeString' Bool
False a
opts String
cs
_ -> 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 [] _ = Doc Text -> RST m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
titleToRST tit :: [Inline]
tit subtit :: [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 '=' Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text -> Char -> Doc Text
bordered Doc Text
subtitle '-'
bordered :: Doc Text -> Char -> Doc Text
bordered :: Doc Text -> Char -> Doc Text
bordered contents :: Doc Text
contents c :: Char
c =
if Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 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 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 ("",["title"],[]) _) = Doc Text -> RST m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
blockToRST (Div (ident :: Text
ident,classes :: [Text]
classes,_kvs :: [(Text, Text)]
_kvs) bs :: [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 = ["attention","caution","danger","error","hint",
"important","note","tip","warning","admonition"]
let admonition :: Doc Text
admonition = case [Text]
classes of
(cl :: Text
cl:_)
| 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
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
<> "::"
cls :: [Text]
cls -> ".. 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
/= "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 " :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 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 inlines :: [Inline]
inlines) = [Inline] -> RST m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> RST m (Doc Text)
inlineListToRST [Inline]
inlines
blockToRST (SimpleFigure attr :: Attr
attr txt :: [Inline]
txt (src :: Text
src, tit :: Text
tit)) = 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 fig :: Doc Text
fig = "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
alt :: Doc Text
alt = ":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
capt :: Doc Text
capt = Doc Text
description
(_,cls :: [Text]
cls,_) = Attr
attr
classes :: Doc Text
classes = case [Text]
cls of
[] -> Doc Text
forall a. Doc a
empty
["align-right"] -> ":align: right"
["align-left"] -> ":align: left"
["align-center"] -> ":align: center"
_ -> ":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)
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 3 ".. " (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 [Image attr :: Attr
attr txt :: [Inline]
txt (src :: Text
src, _)]) = 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 fig :: Doc Text
fig = "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 | [Inline] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
txt = Doc Text
forall a. Doc a
empty
| Bool
otherwise = ":alt: " Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
description
capt :: Doc a
capt = Doc a
forall a. Doc a
empty
(_,cls :: [Text]
cls,_) = Attr
attr
classes :: Doc Text
classes = case [Text]
cls of
[] -> Doc Text
forall a. Doc a
empty
["align-right"] -> ":align: right"
["align-left"] -> ":align: left"
["align-center"] -> ":align: center"
_ -> ":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 3 ".. " (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
forall a. Doc a
capt) Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
forall a. Doc a
blankline
blockToRST (Para inlines :: [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 lns :: [[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 f' :: Text
f') str :: Text
str)
| Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== "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
== "tex" = Block -> RST m (Doc Text)
forall (m :: * -> *). PandocMonad m => Block -> RST m (Doc Text)
blockToRST (Format -> Text -> Block
RawBlock (Text -> Format
Format "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
<> ".. 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 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 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
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
forall a. Doc a
blankline
blockToRST (Header level :: Int
level (name :: Text
name,classes :: [Text]
classes,_) inlines :: [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
> 5 then ' ' else "=-~^'" String -> Int -> Char
forall a. [a] -> Int -> a
!! (Int
level Int -> Int -> Int
forall a. Num a => a -> a -> a
- 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
forall a. Semigroup a => a -> a -> a
<>
(if (Char -> Bool) -> Text -> Bool
T.any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==':') Text
name Bool -> Bool -> Bool
||
Int -> Text -> Text
T.take 1 Text
name Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== "_"
then "`" 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
<> "`"
else 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
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 = "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 = ":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 = ":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 3 ".. " (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 (_,classes :: [Text]
classes,kvs :: [(Text, Text)]
kvs) 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
let startnum :: Doc Text
startnum = Doc Text -> (Text -> Doc Text) -> Maybe Text -> Doc Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe "" (\x :: Text
x -> " " 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 "startFrom" [(Text, Text)]
kvs
let numberlines :: Doc Text
numberlines = if "numberLines" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes
then " :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 "haskell" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes Bool -> Bool -> Bool
&& "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 "> " (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` ["sourceCode","literate","numberLines",
"number-lines","example"]] of
[] -> "::"
(lang :: Text
lang:_) -> (".. 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 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 blocks :: [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 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 _ blkCapt :: Caption
blkCapt specs :: [ColSpec]
specs thead :: TableHead
thead tbody :: [TableBody]
tbody tfoot :: TableFoot
tfoot) = do
let (caption :: [Inline]
caption, aligns :: [Alignment]
aligns, widths :: [Double]
widths, headers :: [[Block]]
headers, rows :: [[[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 opts :: WriterOptions
opts bs :: [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
$ \st :: 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
$ \st :: 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
== 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
> 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 (".. 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 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 items :: [[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 (start :: Int
start, style' :: ListNumberStyle
style', delim :: ListNumberDelim
delim) items :: [[Block]]
items) = do
let markers :: [Text]
markers = if Int
start Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 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) "#."
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 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 (\m :: 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]
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 items :: [([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 items :: [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 3 "- " Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
if [Block] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Block]
items Bool -> Bool -> Bool
|| ([Block] -> Bool
endsWithPlain [Block]
items Bool -> Bool -> Bool
&& Bool -> Bool
not ([Block] -> Bool
endsWithList [Block]
items))
then 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 marker :: Text
marker items :: [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
<> " "
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
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Block]
items Bool -> Bool -> Bool
|| ([Block] -> Bool
endsWithPlain [Block]
items Bool -> Bool -> Bool
&& Bool -> Bool
not ([Block] -> Bool
endsWithList [Block]
items))
then Doc Text
forall a. Doc a
cr
else Doc Text
forall a. Doc a
blankline
endsWithList :: [Block] -> Bool
endsWithList :: [Block] -> Bool
endsWithList bs :: [Block]
bs = case [Block] -> Maybe Block
forall a. [a] -> Maybe a
lastMay [Block]
bs of
Just (BulletList{}) -> Bool
True
Just (OrderedList{}) -> Bool
True
_ -> Bool
False
definitionListItemToRST :: PandocMonad m => ([Inline], [[Block]]) -> RST m (Doc Text)
definitionListItemToRST :: ([Inline], [[Block]]) -> RST m (Doc Text)
definitionListItemToRST (label :: [Inline]
label, defs :: [[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 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 inlineLines :: [[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 2 (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal "| ")) [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' topLevel :: Bool
topLevel blocks :: [Block]
blocks = do
let fixBlocks :: [Block] -> [Block]
fixBlocks (b1 :: Block
b1:b2 :: Block
b2@(BlockQuote _):bs :: [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 HorizontalRule = Bool
False
toClose SimpleFigure{} = Bool
True
toClose Para{} = Bool
False
toClose _ = Bool
True
commentSep :: Block
commentSep = Format -> Text -> Block
RawBlock "rst" "..\n\n"
fixBlocks (b :: Block
b:bs :: [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 (\s :: 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 (\s :: 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 "") = 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 _ []) = Bool
False
hasContents (Cite _ []) = Bool
False
hasContents (Span _ []) = Bool
False
hasContents (Link _ [] ("", "")) = Bool
False
hasContents (Image _ [] ("", "")) = Bool
False
hasContents _ = Bool
True
removeSpaceAfterDisplayMath :: [Inline] -> [Inline]
removeSpaceAfterDisplayMath (Math DisplayMath x :: Text
x : zs :: [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 (x :: Inline
x:xs :: [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 (x :: Inline
x:y :: Inline
y:z :: Inline
z:zs :: [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 (x :: Inline
x:y :: Inline
y:zs :: [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 "rst" "\\ " 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 "rst" "\\ " 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 (x :: Inline
x:ys :: [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 s :: Text
s) (Str s' :: Text
s')
| Just (_, c :: Char
c) <- Text -> Maybe (Text, Char)
T.unsnoc Text
s
, Just (c' :: Char
c', _) <- Text -> Maybe (Char, Text)
T.uncons Text
s'
= case (Char
c, Char
c') of
('\'','\'') -> Bool
True
('"','"') -> Bool
True
('<','>') -> Bool
True
('[',']') -> Bool
True
('{','}') -> Bool
True
_ -> Bool
False
surroundComplex _ _ = Bool
False
okAfterComplex :: Inline -> Bool
okAfterComplex :: Inline -> Bool
okAfterComplex Space = Bool
True
okAfterComplex SoftBreak = Bool
True
okAfterComplex LineBreak = Bool
True
okAfterComplex (Str (Text -> Maybe (Char, Text)
T.uncons -> Just (c :: Char
c,_)))
= Char -> Bool
isSpace Char
c Bool -> Bool -> Bool
|| Char
c Char -> Text -> Bool
`elemText` "-.,:;!?\\/'\")]}>–—"
okAfterComplex _ = Bool
False
okBeforeComplex :: Inline -> Bool
okBeforeComplex :: Inline -> Bool
okBeforeComplex Space = Bool
True
okBeforeComplex SoftBreak = Bool
True
okBeforeComplex LineBreak = Bool
True
okBeforeComplex (Str (Text -> Maybe (Text, Char)
T.unsnoc -> Just (_,c :: Char
c)))
= Char -> Bool
isSpace Char
c Bool -> Bool -> Bool
|| Char
c Char -> Text -> Bool
`elemText` "-:/'\"<([{–—"
okBeforeComplex _ = Bool
False
isComplex :: Inline -> Bool
isComplex :: Inline -> Bool
isComplex (Emph _) = Bool
True
isComplex (Underline _) = Bool
True
isComplex (Strong _) = Bool
True
isComplex (SmallCaps _) = Bool
True
isComplex (Strikeout _) = Bool
True
isComplex (Superscript _) = Bool
True
isComplex (Subscript _) = Bool
True
isComplex Link{} = Bool
True
isComplex Image{} = Bool
True
isComplex (Code _ _) = Bool
True
isComplex (Math _ _) = Bool
True
isComplex (Cite _ (x :: Inline
x:_)) = Inline -> Bool
isComplex Inline
x
isComplex (Span _ (x :: Inline
x:_)) = Inline -> Bool
isComplex Inline
x
isComplex _ = Bool
False
flatten :: Inline -> [Inline]
flatten :: Inline -> [Inline]
flatten outer :: 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 f :: [Inline]
f i :: Inline
i =
case (Inline
outer, Inline
i) of
(Quoted _ _, _) -> [Inline] -> Inline -> [Inline]
keep [Inline]
f Inline
i
(_, Quoted _ _) -> [Inline] -> Inline -> [Inline]
keep [Inline]
f Inline
i
(Span (_,_,[]) _, _) -> [Inline] -> Inline -> [Inline]
keep [Inline]
f Inline
i
(_, Span (_,_,[]) _) -> [Inline] -> Inline -> [Inline]
keep [Inline]
f Inline
i
( Link{}, Image{}) -> [Inline] -> Inline -> [Inline]
keep [Inline]
f Inline
i
(_, Link{}) -> [Inline] -> Inline -> [Inline]
forall a. [a] -> a -> [a]
emerge [Inline]
f Inline
i
(Emph _, Strong _) -> [Inline] -> Inline -> [Inline]
forall a. [a] -> a -> [a]
emerge [Inline]
f Inline
i
(_, _) -> [Inline] -> Inline -> [Inline]
collapse [Inline]
f Inline
i
emerge :: [a] -> a -> [a]
emerge f :: [a]
f i :: a
i = [a]
f [a] -> [a] -> [a]
forall a. Semigroup a => a -> a -> a
<> [a
i]
keep :: [Inline] -> Inline -> [Inline]
keep f :: [Inline]
f i :: Inline
i = [Inline] -> [Inline] -> [Inline]
appendToLast [Inline]
f [Inline
i]
collapse :: [Inline] -> Inline -> [Inline]
collapse f :: [Inline]
f i :: 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 flattened :: [Inline]
flattened toAppend :: [Inline]
toAppend =
case [Inline] -> Maybe (NonEmpty Inline)
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [Inline]
flattened of
Nothing -> [Inline -> [Inline] -> Inline
setInlineChildren Inline
outer [Inline]
toAppend]
Just xs :: 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 o :: Inline
o i :: [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 i :: 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 i :: Inline
i = Inline -> [Inline] -> Inline
setInlineChildren Inline
i []
mapNested :: ([Inline] -> [Inline]) -> Inline -> Inline
mapNested :: ([Inline] -> [Inline]) -> Inline -> Inline
mapNested f :: [Inline] -> [Inline]
f i :: Inline
i = Inline -> [Inline] -> Inline
setInlineChildren Inline
i ([Inline] -> [Inline]
f (Inline -> [Inline]
dropInlineParent Inline
i))
dropInlineParent :: Inline -> [Inline]
dropInlineParent :: Inline -> [Inline]
dropInlineParent (Link _ i :: [Inline]
i _) = [Inline]
i
dropInlineParent (Emph i :: [Inline]
i) = [Inline]
i
dropInlineParent (Underline i :: [Inline]
i) = [Inline]
i
dropInlineParent (Strong i :: [Inline]
i) = [Inline]
i
dropInlineParent (Strikeout i :: [Inline]
i) = [Inline]
i
dropInlineParent (Superscript i :: [Inline]
i) = [Inline]
i
dropInlineParent (Subscript i :: [Inline]
i) = [Inline]
i
dropInlineParent (SmallCaps i :: [Inline]
i) = [Inline]
i
dropInlineParent (Cite _ i :: [Inline]
i) = [Inline]
i
dropInlineParent (Image _ i :: [Inline]
i _) = [Inline]
i
dropInlineParent (Span _ i :: [Inline]
i) = [Inline]
i
dropInlineParent (Quoted _ i :: [Inline]
i) = [Inline]
i
dropInlineParent i :: Inline
i = [Inline
i]
setInlineChildren :: Inline -> [Inline] -> Inline
setInlineChildren :: Inline -> [Inline] -> Inline
setInlineChildren (Link a :: Attr
a _ t :: (Text, Text)
t) i :: [Inline]
i = Attr -> [Inline] -> (Text, Text) -> Inline
Link Attr
a [Inline]
i (Text, Text)
t
setInlineChildren (Emph _) i :: [Inline]
i = [Inline] -> Inline
Emph [Inline]
i
setInlineChildren (Underline _) i :: [Inline]
i = [Inline] -> Inline
Underline [Inline]
i
setInlineChildren (Strong _) i :: [Inline]
i = [Inline] -> Inline
Strong [Inline]
i
setInlineChildren (Strikeout _) i :: [Inline]
i = [Inline] -> Inline
Strikeout [Inline]
i
setInlineChildren (Superscript _) i :: [Inline]
i = [Inline] -> Inline
Superscript [Inline]
i
setInlineChildren (Subscript _) i :: [Inline]
i = [Inline] -> Inline
Subscript [Inline]
i
setInlineChildren (SmallCaps _) i :: [Inline]
i = [Inline] -> Inline
SmallCaps [Inline]
i
setInlineChildren (Quoted q :: QuoteType
q _) i :: [Inline]
i = QuoteType -> [Inline] -> Inline
Quoted QuoteType
q [Inline]
i
setInlineChildren (Cite c :: [Citation]
c _) i :: [Inline]
i = [Citation] -> [Inline] -> Inline
Cite [Citation]
c [Inline]
i
setInlineChildren (Image a :: Attr
a _ t :: (Text, Text)
t) i :: [Inline]
i = Attr -> [Inline] -> (Text, Text) -> Inline
Image Attr
a [Inline]
i (Text, Text)
t
setInlineChildren (Span a :: Attr
a _) i :: [Inline]
i = Attr -> [Inline] -> Inline
Span Attr
a [Inline]
i
setInlineChildren leaf :: Inline
leaf _ = 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 lst :: [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 (_,_,kvs :: [(Text, Text)]
kvs) ils :: [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 "role" [(Text, Text)]
kvs of
Just role :: Text
role -> ":" 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
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> "`"
Nothing -> Doc Text
contents
inlineToRST (Emph lst :: [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
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> "*"
inlineToRST (Underline lst :: [Inline]
lst) =
Inline -> RST m (Doc Text)
forall (m :: * -> *). PandocMonad m => Inline -> RST m (Doc Text)
inlineToRST ([Inline] -> Inline
Emph [Inline]
lst)
inlineToRST (Strong lst :: [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
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> "**"
inlineToRST (Strikeout lst :: [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
$ "[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
<> "]"
inlineToRST (Superscript lst :: [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
$ ":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
<> "`"
inlineToRST (Subscript lst :: [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
$ ":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
<> "`"
inlineToRST (SmallCaps lst :: [Inline]
lst) = [Inline] -> RST m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> RST m (Doc Text)
writeInlines [Inline]
lst
inlineToRST (Quoted SingleQuote lst :: [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
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> "'"
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
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> "’"
inlineToRST (Quoted DoubleQuote lst :: [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
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> "\""
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
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> "”"
inlineToRST (Cite _ lst :: [Inline]
lst) =
[Inline] -> RST m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> RST m (Doc Text)
writeInlines [Inline]
lst
inlineToRST (Code (_,["interpreted-text"],[("role",role :: Text
role)]) str :: 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
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
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
<> "`"
inlineToRST (Code _ 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
$
if '`' Char -> Text -> Bool
`elemText` Text
str
then ":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
<> "`"
else "``" 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
<> "``"
inlineToRST (Str 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 t :: MathType
t str :: 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
$ \st :: 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 ":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
<> "`"
else if '\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
$$ ".. 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 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
$$ (".. 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 f :: Format
f x :: Text
x)
| Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== "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
== "latex" Bool -> Bool -> Bool
|| Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== "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
$ \st :: 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
$ ":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
<> "`"
| 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 LineBreak = Doc Text -> RST m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
cr
inlineToRST Space = Doc Text -> RST m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
space
inlineToRST 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
WrapPreserve -> Doc Text -> RST m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
cr
WrapAuto -> Doc Text -> RST m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
space
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 _ [Str str :: Text
str] (src :: Text
src, _))
| Text -> Bool
isURI Text
src Bool -> Bool -> Bool
&&
if "mailto:" Text -> Text -> Bool
`T.isPrefixOf` Text
src
then Text
src Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Text
escapeURI ("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 "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 _ [Image attr :: Attr
attr alt :: [Inline]
alt (imgsrc :: Text
imgsrc,imgtit :: Text
imgtit)] (src :: Text
src, _tit :: 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
forall a. Semigroup a => a -> a -> a
<> Doc Text
label Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> "|"
inlineToRST (Link _ txt :: [Inline]
txt (src :: Text
src, tit :: 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 (src' :: Text
src',tit' :: 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
forall a. Semigroup a => a -> a -> a
<> Doc Text
linktext Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> "`_"
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
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
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
<> ">`__"
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
$ \st :: 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
forall a. Semigroup a => a -> a -> a
<> Doc Text
linktext Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> "`_"
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
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
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
<> ">`__"
inlineToRST (Image attr :: Attr
attr alternate :: [Inline]
alternate (source :: Text
source, tit :: 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
forall a. Semigroup a => a -> a -> a
<> Doc Text
label Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> "|"
inlineToRST (Note contents :: [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
$ \st :: 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
+ 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
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
<> "]_"
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
attr alt :: [Inline]
alt (src :: Text
src,tit :: Text
tit) mbtarget :: 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
$ \st :: WriterState
st -> WriterState
st{ stImageId :: Int
stImageId = Int
imgId Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1 }
[Inline] -> StateT WriterState m [Inline]
forall (m :: * -> *) a. Monad m => a -> m a
return [Text -> Inline
Str ("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 (a :: Attr
a,s :: Text
s,t :: Text
t,mbt :: 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
$ \st :: 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'
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 ""]
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
$ \st :: 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
attr = do
let (ident :: Text
ident, _, _) = Attr
attr
name :: Doc Text
name = if Text -> Bool
T.null Text
ident
then Doc Text
forall a. Doc a
empty
else ":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 dir :: Direction
dir = let cols :: a -> Doc a
cols d :: a
d = ":" 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
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 a :: Double
a) ->
case Direction
dir of
Height -> Doc a
forall a. Doc a
empty
Width -> Dimension -> Doc a
forall a a. (HasChars a, Show a) => a -> Doc a
cols (Double -> Dimension
Percent Double
a)
Just dim :: Dimension
dim -> Dimension -> Doc a
forall a a. (HasChars a, Show a) => a -> Doc a
cols Dimension
dim
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 opts :: WriterOptions
opts blocksToDoc :: WriterOptions -> [Block] -> m (Doc Text)
blocksToDoc headers :: [[Block]]
headers rows :: [[[Block]]]
rows = do
let fixEmpties :: [Doc a] -> [Doc a]
fixEmpties (d :: Doc a
d:ds :: [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 "\\ " 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 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 1 " ") ([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 (\n :: Int
n -> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Int -> Text -> Text
T.replicate Int
n "=")) [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