{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns      #-}
{- |
   Module      : Text.Pandoc.Writers.RST
   Copyright   : Copyright (C) 2006-2021 John MacFarlane
   License     : GNU GPL, version 2 or above

   Maintainer  : John MacFarlane <jgm@berkeley.edu>
   Stability   : alpha
   Portability : portable

Conversion of 'Pandoc' documents to reStructuredText.

reStructuredText:  <http://docutils.sourceforge.net/rst.html>
-}
module Text.Pandoc.Writers.RST ( writeRST, flatten ) where
import Control.Monad.State.Strict
import Data.Char (isSpace)
import Data.List (transpose, intersperse, foldl')
import qualified Data.List.NonEmpty as NE
import Data.Maybe (fromMaybe)
import qualified Data.Text as T
import Data.Text (Text)
import qualified Text.Pandoc.Builder as B
import Text.Pandoc.Class.PandocMonad (PandocMonad, report)
import Text.Pandoc.Definition
import Text.Pandoc.ImageSize
import Text.Pandoc.Logging
import Text.Pandoc.Options
import Text.DocLayout
import Text.Pandoc.Shared
import Text.Pandoc.Templates (renderTemplate)
import Text.Pandoc.Writers.Shared
import Text.Pandoc.Walk

type Refs = [([Inline], Target)]

data WriterState =
  WriterState { WriterState -> [[Block]]
stNotes       :: [[Block]]
              , WriterState -> Refs
stLinks       :: Refs
              , WriterState -> [([Inline], (Attr, Text, Text, Maybe Text))]
stImages      :: [([Inline], (Attr, Text, Text, Maybe Text))]
              , WriterState -> Bool
stHasMath     :: Bool
              , WriterState -> Bool
stHasRawTeX   :: Bool
              , WriterState -> WriterOptions
stOptions     :: WriterOptions
              , WriterState -> Bool
stTopLevel    :: Bool
              , WriterState -> Int
stImageId     :: Int
              }

type RST = StateT WriterState

-- | Convert Pandoc to RST.
writeRST :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writeRST :: WriterOptions -> Pandoc -> m Text
writeRST WriterOptions
opts Pandoc
document = do
  let st :: WriterState
st = WriterState :: [[Block]]
-> Refs
-> [([Inline], (Attr, Text, Text, Maybe Text))]
-> Bool
-> Bool
-> WriterOptions
-> Bool
-> Int
-> WriterState
WriterState { stNotes :: [[Block]]
stNotes = [], stLinks :: Refs
stLinks = [],
                         stImages :: [([Inline], (Attr, Text, Text, Maybe Text))]
stImages = [], stHasMath :: Bool
stHasMath = Bool
False,
                         stHasRawTeX :: Bool
stHasRawTeX = Bool
False, stOptions :: WriterOptions
stOptions = WriterOptions
opts,
                         stTopLevel :: Bool
stTopLevel = Bool
True, stImageId :: Int
stImageId = Int
1 }
  StateT WriterState m Text -> WriterState -> m Text
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (Pandoc -> StateT WriterState m Text
forall (m :: * -> *). PandocMonad m => Pandoc -> RST m Text
pandocToRST Pandoc
document) WriterState
st

-- | Return RST representation of document.
pandocToRST :: PandocMonad m => Pandoc -> RST m Text
pandocToRST :: Pandoc -> RST m Text
pandocToRST (Pandoc Meta
meta [Block]
blocks) = do
  WriterOptions
opts <- (WriterState -> WriterOptions)
-> StateT WriterState m WriterOptions
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> WriterOptions
stOptions
  let colwidth :: Maybe Int
colwidth = if WriterOptions -> WrapOption
writerWrapText WriterOptions
opts WrapOption -> WrapOption -> Bool
forall a. Eq a => a -> a -> Bool
== WrapOption
WrapAuto
                    then Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ WriterOptions -> Int
writerColumns WriterOptions
opts
                    else Maybe Int
forall a. Maybe a
Nothing
  let subtit :: [Inline]
subtit = Text -> Meta -> [Inline]
lookupMetaInlines Text
"subtitle" Meta
meta
  Doc Text
title <- [Inline] -> [Inline] -> RST m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
[Inline] -> [Inline] -> RST m (Doc Text)
titleToRST (Meta -> [Inline]
docTitle Meta
meta) [Inline]
subtit
  Context Text
metadata <- WriterOptions
-> ([Block] -> RST m (Doc Text))
-> ([Inline] -> RST m (Doc Text))
-> Meta
-> StateT WriterState m (Context Text)
forall (m :: * -> *) a.
(Monad m, TemplateTarget a) =>
WriterOptions
-> ([Block] -> m (Doc a))
-> ([Inline] -> m (Doc a))
-> Meta
-> m (Context a)
metaToContext WriterOptions
opts
                [Block] -> RST m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> RST m (Doc Text)
blockListToRST
                ((Doc Text -> Doc Text) -> RST m (Doc Text) -> RST m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Doc Text -> Doc Text
forall a. Doc a -> Doc a
chomp (RST m (Doc Text) -> RST m (Doc Text))
-> ([Inline] -> RST m (Doc Text)) -> [Inline] -> RST m (Doc Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> RST m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> RST m (Doc Text)
inlineListToRST)
                Meta
meta
  Doc Text
body <- Bool -> [Block] -> RST m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Bool -> [Block] -> RST m (Doc Text)
blockListToRST' Bool
True ([Block] -> RST m (Doc Text)) -> [Block] -> RST m (Doc Text)
forall a b. (a -> b) -> a -> b
$ case WriterOptions -> Maybe (Template Text)
writerTemplate WriterOptions
opts of
                                      Just Template Text
_  -> Int -> [Block] -> [Block]
normalizeHeadings Int
1 [Block]
blocks
                                      Maybe (Template Text)
Nothing -> [Block]
blocks
  Doc Text
notes <- (WriterState -> [[Block]]) -> StateT WriterState m [[Block]]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ([[Block]] -> [[Block]]
forall a. [a] -> [a]
reverse ([[Block]] -> [[Block]])
-> (WriterState -> [[Block]]) -> WriterState -> [[Block]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterState -> [[Block]]
stNotes) StateT WriterState m [[Block]]
-> ([[Block]] -> RST m (Doc Text)) -> RST m (Doc Text)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [[Block]] -> RST m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
[[Block]] -> RST m (Doc Text)
notesToRST
  -- note that the notes may contain refs, so we do them first
  Doc Text
refs <- (WriterState -> Refs) -> StateT WriterState m Refs
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Refs -> Refs
forall a. [a] -> [a]
reverse (Refs -> Refs) -> (WriterState -> Refs) -> WriterState -> Refs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterState -> Refs
stLinks) StateT WriterState m Refs
-> (Refs -> RST m (Doc Text)) -> RST m (Doc Text)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Refs -> RST m (Doc Text)
forall (m :: * -> *). PandocMonad m => Refs -> RST m (Doc Text)
refsToRST
  Doc Text
pics <- (WriterState -> [([Inline], (Attr, Text, Text, Maybe Text))])
-> StateT
     WriterState m [([Inline], (Attr, Text, Text, Maybe Text))]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ([([Inline], (Attr, Text, Text, Maybe Text))]
-> [([Inline], (Attr, Text, Text, Maybe Text))]
forall a. [a] -> [a]
reverse ([([Inline], (Attr, Text, Text, Maybe Text))]
 -> [([Inline], (Attr, Text, Text, Maybe Text))])
-> (WriterState -> [([Inline], (Attr, Text, Text, Maybe Text))])
-> WriterState
-> [([Inline], (Attr, Text, Text, Maybe Text))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterState -> [([Inline], (Attr, Text, Text, Maybe Text))]
stImages) StateT WriterState m [([Inline], (Attr, Text, Text, Maybe Text))]
-> ([([Inline], (Attr, Text, Text, Maybe Text))]
    -> RST m (Doc Text))
-> RST m (Doc Text)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [([Inline], (Attr, Text, Text, Maybe Text))] -> RST m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
[([Inline], (Attr, Text, Text, Maybe Text))] -> RST m (Doc Text)
pictRefsToRST
  Bool
hasMath <- (WriterState -> Bool) -> StateT WriterState m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stHasMath
  Bool
rawTeX <- (WriterState -> Bool) -> StateT WriterState m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stHasRawTeX
  let main :: Doc Text
main = [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vsep [Doc Text
body, Doc Text
notes, Doc Text
refs, Doc Text
pics]
  let context :: Context Text
context = Text -> Doc Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"body" Doc Text
main
              (Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$ Text -> Bool -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"toc" (WriterOptions -> Bool
writerTableOfContents WriterOptions
opts)
              (Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"toc-depth" (Int -> Text
forall a. Show a => a -> Text
tshow (Int -> Text) -> Int -> Text
forall a b. (a -> b) -> a -> b
$ WriterOptions -> Int
writerTOCDepth WriterOptions
opts)
              (Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$ Text -> Bool -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"number-sections" (WriterOptions -> Bool
writerNumberSections WriterOptions
opts)
              (Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$ Text -> Bool -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"math" Bool
hasMath
              (Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"titleblock" (Maybe Int -> Doc Text -> Text
forall a. HasChars a => Maybe Int -> Doc a -> a
render Maybe Int
forall a. Maybe a
Nothing Doc Text
title :: Text)
              (Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$ Text -> Bool -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"math" Bool
hasMath
              (Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$ Text -> Bool -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"rawtex" Bool
rawTeX Context Text
metadata
  Text -> RST m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> RST m Text) -> Text -> RST m Text
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Doc Text -> Text
forall a. HasChars a => Maybe Int -> Doc a -> a
render Maybe Int
colwidth (Doc Text -> Text) -> Doc Text -> Text
forall a b. (a -> b) -> a -> b
$
    case WriterOptions -> Maybe (Template Text)
writerTemplate WriterOptions
opts of
       Maybe (Template Text)
Nothing  -> Doc Text
main
       Just Template Text
tpl -> Template Text -> Context Text -> Doc Text
forall a b.
(TemplateTarget a, ToContext a b) =>
Template a -> b -> Doc a
renderTemplate Template Text
tpl Context Text
context
  where
    normalizeHeadings :: Int -> [Block] -> [Block]
normalizeHeadings Int
lev (Header Int
l Attr
a [Inline]
i:[Block]
bs) =
      Int -> Attr -> [Inline] -> Block
Header Int
lev Attr
a [Inline]
iBlock -> [Block] -> [Block]
forall a. a -> [a] -> [a]
:Int -> [Block] -> [Block]
normalizeHeadings (Int
levInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) [Block]
cont [Block] -> [Block] -> [Block]
forall a. [a] -> [a] -> [a]
++ Int -> [Block] -> [Block]
normalizeHeadings Int
lev [Block]
bs'
      where ([Block]
cont,[Block]
bs') = (Block -> Bool) -> [Block] -> ([Block], [Block])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Int -> Block -> Bool
headerLtEq Int
l) [Block]
bs
            headerLtEq :: Int -> Block -> Bool
headerLtEq Int
level (Header Int
l' Attr
_ [Inline]
_) = Int
l' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
level
            headerLtEq Int
_ Block
_                   = Bool
False
    normalizeHeadings Int
lev (Block
b:[Block]
bs) = Block
bBlock -> [Block] -> [Block]
forall a. a -> [a] -> [a]
:Int -> [Block] -> [Block]
normalizeHeadings Int
lev [Block]
bs
    normalizeHeadings Int
_   []     = []

-- | Return RST representation of reference key table.
refsToRST :: PandocMonad m => Refs -> RST m (Doc Text)
refsToRST :: Refs -> RST m (Doc Text)
refsToRST Refs
refs =
   [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat ([Doc Text] -> Doc Text)
-> StateT WriterState m [Doc Text] -> RST m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (([Inline], (Text, Text)) -> RST m (Doc Text))
-> Refs -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ([Inline], (Text, Text)) -> RST m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
([Inline], (Text, Text)) -> RST m (Doc Text)
keyToRST Refs
refs

-- | Return RST representation of a reference key.
keyToRST :: PandocMonad m => ([Inline], (Text, Text)) -> RST m (Doc Text)
keyToRST :: ([Inline], (Text, Text)) -> RST m (Doc Text)
keyToRST ([Inline]
label, (Text
src, Text
_)) = do
  Doc Text
label' <- [Inline] -> RST m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> RST m (Doc Text)
inlineListToRST [Inline]
label
  let label'' :: Doc Text
label'' = if (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
':') (Char -> Bool) -> Text -> Bool
`T.any` (Maybe Int -> Doc Text -> Text
forall a. HasChars a => Maybe Int -> Doc a -> a
render Maybe Int
forall a. Maybe a
Nothing Doc Text
label' :: Text)
                   then Char -> Doc Text
forall a. HasChars a => Char -> Doc a
char Char
'`' Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
label' Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Char -> Doc Text
forall a. HasChars a => Char -> Doc a
char Char
'`'
                   else Doc Text
label'
  Doc Text -> RST m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> RST m (Doc Text)) -> Doc Text -> RST m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text -> Doc Text
forall a. IsString a => Doc a -> Doc a
nowrap (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Doc Text
".. _" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
label'' Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
": " Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
src

-- | Return RST representation of notes.
notesToRST :: PandocMonad m => [[Block]] -> RST m (Doc Text)
notesToRST :: [[Block]] -> RST m (Doc Text)
notesToRST [[Block]]
notes =
   [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vsep ([Doc Text] -> Doc Text)
-> StateT WriterState m [Doc Text] -> RST m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> [Block] -> RST m (Doc Text))
-> [Int] -> [[Block]] -> StateT WriterState m [Doc Text]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM Int -> [Block] -> RST m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Int -> [Block] -> RST m (Doc Text)
noteToRST [Int
1..] [[Block]]
notes

-- | Return RST representation of a note.
noteToRST :: PandocMonad m => Int -> [Block] -> RST m (Doc Text)
noteToRST :: Int -> [Block] -> RST m (Doc Text)
noteToRST Int
num [Block]
note = do
  Doc Text
contents <- [Block] -> RST m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> RST m (Doc Text)
blockListToRST [Block]
note
  let marker :: Doc Text
marker = Doc Text
".. [" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> String -> Doc Text
forall a. HasChars a => String -> Doc a
text (Int -> String
forall a. Show a => a -> String
show Int
num) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"]"
  Doc Text -> RST m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> RST m (Doc Text)) -> Doc Text -> RST m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text -> Doc Text
forall a. IsString a => Doc a -> Doc a
nowrap (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Doc Text
marker Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Int -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a
nest Int
3 Doc Text
contents

-- | Return RST representation of picture reference table.
pictRefsToRST :: PandocMonad m
              => [([Inline], (Attr, Text, Text, Maybe Text))]
              -> RST m (Doc Text)
pictRefsToRST :: [([Inline], (Attr, Text, Text, Maybe Text))] -> RST m (Doc Text)
pictRefsToRST [([Inline], (Attr, Text, Text, Maybe Text))]
refs =
   [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat ([Doc Text] -> Doc Text)
-> StateT WriterState m [Doc Text] -> RST m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (([Inline], (Attr, Text, Text, Maybe Text)) -> RST m (Doc Text))
-> [([Inline], (Attr, Text, Text, Maybe Text))]
-> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ([Inline], (Attr, Text, Text, Maybe Text)) -> RST m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
([Inline], (Attr, Text, Text, Maybe Text)) -> RST m (Doc Text)
pictToRST [([Inline], (Attr, Text, Text, Maybe Text))]
refs

-- | Return RST representation of a picture substitution reference.
pictToRST :: PandocMonad m
          => ([Inline], (Attr, Text, Text, Maybe Text))
          -> RST m (Doc Text)
pictToRST :: ([Inline], (Attr, Text, Text, Maybe Text)) -> RST m (Doc Text)
pictToRST ([Inline]
label, (Attr
attr, Text
src, Text
_, Maybe Text
mbtarget)) = do
  Doc Text
label' <- [Inline] -> RST m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> RST m (Doc Text)
inlineListToRST [Inline]
label
  Doc Text
dims   <- Attr -> RST m (Doc Text)
forall (m :: * -> *). PandocMonad m => Attr -> RST m (Doc Text)
imageDimsToRST Attr
attr
  let (Text
_, [Text]
cls, [(Text, Text)]
_) = Attr
attr
      classes :: Doc Text
classes = case [Text]
cls of
                   []               -> Doc Text
forall a. Doc a
empty
                   [Text
"align-top"]    -> Doc Text
":align: top"
                   [Text
"align-middle"] -> Doc Text
":align: middle"
                   [Text
"align-bottom"] -> Doc Text
":align: bottom"
                   [Text
"align-center"] -> Doc Text
forall a. Doc a
empty
                   [Text
"align-right"]  -> Doc Text
forall a. Doc a
empty
                   [Text
"align-left"]   -> Doc Text
forall a. Doc a
empty
                   [Text]
_                -> Doc Text
":class: " Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal ([Text] -> Text
T.unwords [Text]
cls)
  Doc Text -> RST m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> RST m (Doc Text)) -> Doc Text -> RST m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text -> Doc Text
forall a. IsString a => Doc a -> Doc a
nowrap
         (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Doc Text
".. |" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
label' Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"| image:: " Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
src Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Int -> Doc Text -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a -> Doc a
hang Int
3 Doc Text
forall a. Doc a
empty (Doc Text
classes Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
dims)
         Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ case Maybe Text
mbtarget of
                 Maybe Text
Nothing -> Doc Text
forall a. Doc a
empty
                 Just Text
t  -> Doc Text
"   :target: " Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
t

-- | Escape special characters for RST.
escapeText :: WriterOptions -> Text -> Text
escapeText :: WriterOptions -> Text -> Text
escapeText WriterOptions
o = String -> Text
T.pack (String -> Text) -> (Text -> String) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> WriterOptions -> String -> String
forall a. HasSyntaxExtensions a => Bool -> a -> String -> String
escapeString' Bool
True WriterOptions
o (String -> String) -> (Text -> String) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack -- This ought to be parser
  where
  escapeString' :: Bool -> a -> String -> String
escapeString' Bool
_ a
_  [] = []
  escapeString' Bool
firstChar a
opts (Char
c:String
cs) =
    case Char
c of
         Char
_    | Char
c Char -> Text -> Bool
`elemText` Text
"\\`*_|" Bool -> Bool -> Bool
&&
                (Bool
firstChar Bool -> Bool -> Bool
|| String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
cs) -> Char
'\\'Char -> String -> String
forall a. a -> [a] -> [a]
:Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:Bool -> a -> String -> String
escapeString' Bool
False a
opts String
cs
         Char
'\'' | Extension -> a -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_smart a
opts -> Char
'\\'Char -> String -> String
forall a. a -> [a] -> [a]
:Char
'\''Char -> String -> String
forall a. a -> [a] -> [a]
:Bool -> a -> String -> String
escapeString' Bool
False a
opts String
cs
         Char
'"'  | Extension -> a -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_smart a
opts -> Char
'\\'Char -> String -> String
forall a. a -> [a] -> [a]
:Char
'"'Char -> String -> String
forall a. a -> [a] -> [a]
:Bool -> a -> String -> String
escapeString' Bool
False a
opts String
cs
         Char
'-'  | Extension -> a -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_smart a
opts ->
                  case String
cs of
                    Char
'-':String
_ -> Char
'\\'Char -> String -> String
forall a. a -> [a] -> [a]
:Char
'-'Char -> String -> String
forall a. a -> [a] -> [a]
:Bool -> a -> String -> String
escapeString' Bool
False a
opts String
cs
                    String
_     -> Char
'-'Char -> String -> String
forall a. a -> [a] -> [a]
:Bool -> a -> String -> String
escapeString' Bool
False a
opts String
cs
         Char
'.'  | Extension -> a -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_smart a
opts ->
                  case String
cs of
                    Char
'.':Char
'.':String
rest -> Char
'\\'Char -> String -> String
forall a. a -> [a] -> [a]
:Char
'.'Char -> String -> String
forall a. a -> [a] -> [a]
:Char
'.'Char -> String -> String
forall a. a -> [a] -> [a]
:Char
'.'Char -> String -> String
forall a. a -> [a] -> [a]
:Bool -> a -> String -> String
escapeString' Bool
False a
opts String
rest
                    String
_            -> Char
'.'Char -> String -> String
forall a. a -> [a] -> [a]
:Bool -> a -> String -> String
escapeString' Bool
False a
opts String
cs
         Char
_ -> Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: Bool -> a -> String -> String
escapeString' Bool
False a
opts String
cs

titleToRST :: PandocMonad m => [Inline] -> [Inline] -> RST m (Doc Text)
titleToRST :: [Inline] -> [Inline] -> RST m (Doc Text)
titleToRST [] [Inline]
_ = Doc Text -> RST m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
titleToRST [Inline]
tit [Inline]
subtit = do
  Doc Text
title <- [Inline] -> RST m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> RST m (Doc Text)
inlineListToRST [Inline]
tit
  Doc Text
subtitle <- [Inline] -> RST m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> RST m (Doc Text)
inlineListToRST [Inline]
subtit
  Doc Text -> RST m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> RST m (Doc Text)) -> Doc Text -> RST m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text -> Char -> Doc Text
bordered Doc Text
title Char
'=' Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text -> Char -> Doc Text
bordered Doc Text
subtitle Char
'-'

bordered :: Doc Text -> Char -> Doc Text
bordered :: Doc Text -> Char -> Doc Text
bordered Doc Text
contents Char
c =
  if Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
     then Doc Text
border Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
border
     else Doc Text
forall a. Doc a
empty
   where len :: Int
len = Doc Text -> Int
forall a. (IsString a, HasChars a) => Doc a -> Int
offset Doc Text
contents
         border :: Doc Text
border = Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Int -> Text -> Text
T.replicate Int
len (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Char -> Text
T.singleton Char
c)

-- | Convert Pandoc block element to RST.
blockToRST :: PandocMonad m
           => Block         -- ^ Block element
           -> RST m (Doc Text)
blockToRST :: Block -> RST m (Doc Text)
blockToRST Block
Null = Doc Text -> RST m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
blockToRST (Div (Text
"",[Text
"title"],[]) [Block]
_) = Doc Text -> RST m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
  -- this is generated by the rst reader and can safely be
  -- omitted when we're generating rst
blockToRST (Div (Text
ident,[Text]
classes,[(Text, Text)]
_kvs) [Block]
bs) = do
  Doc Text
contents <- [Block] -> RST m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> RST m (Doc Text)
blockListToRST [Block]
bs
  let admonitions :: [Text]
admonitions = [Text
"attention",Text
"caution",Text
"danger",Text
"error",Text
"hint",
                     Text
"important",Text
"note",Text
"tip",Text
"warning",Text
"admonition"]
  let admonition :: Doc Text
admonition = case [Text]
classes of
                        (Text
cl:[Text]
_)
                          | Text
cl Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
admonitions
                          -> Doc Text
".. " Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
cl Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"::"
                        [Text]
cls -> Doc Text
".. container::" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
space Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>
                                   Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal ([Text] -> Text
T.unwords ((Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"container") [Text]
cls))
  Doc Text -> RST m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> RST m (Doc Text)) -> Doc Text -> RST m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
forall a. Doc a
blankline Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
           Doc Text
admonition Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
           (if Text -> Bool
T.null Text
ident
               then Doc Text
forall a. Doc a
blankline
               else Doc Text
"   :name: " Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
ident Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
forall a. Doc a
blankline) Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
           Int -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a
nest Int
3 Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
           Doc Text
forall a. Doc a
blankline
blockToRST (Plain [Inline]
inlines) = [Inline] -> RST m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> RST m (Doc Text)
inlineListToRST [Inline]
inlines
blockToRST (SimpleFigure Attr
attr [Inline]
txt (Text
src, 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 = Doc Text
"figure:: " Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
src
      alt :: Doc Text
alt = Doc Text
":alt: " Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> if Text -> Bool
T.null Text
tit then Doc Text
description else Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
tit
      capt :: Doc Text
capt = Doc Text
description
      (Text
_,[Text]
cls,[(Text, Text)]
_) = Attr
attr
      classes :: Doc Text
classes = case [Text]
cls of
                   []               -> Doc Text
forall a. Doc a
empty
                   [Text
"align-right"]  -> Doc Text
":align: right"
                   [Text
"align-left"]   -> Doc Text
":align: left"
                   [Text
"align-center"] -> Doc Text
":align: center"
                   [Text]
_ -> Doc Text
":figclass: " Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal ([Text] -> Text
T.unwords [Text]
cls)
  Doc Text -> RST m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> RST m (Doc Text)) -> Doc Text -> RST m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Int -> Doc Text -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a -> Doc a
hang Int
3 Doc Text
".. " (Doc Text
fig Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
alt Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
classes Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
dims Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$+$ Doc Text
capt) Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
forall a. Doc a
blankline
blockToRST (Para [Image Attr
attr [Inline]
txt (Text
src, Text
_)]) = 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 = Doc Text
"image:: " Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
src
      alt :: Doc Text
alt | [Inline] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
txt = Doc Text
forall a. Doc a
empty
          | Bool
otherwise = Doc Text
":alt: " Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
description
      capt :: Doc a
capt = Doc a
forall a. Doc a
empty
      (Text
_,[Text]
cls,[(Text, Text)]
_) = Attr
attr
      classes :: Doc Text
classes = case [Text]
cls of
                   []               -> Doc Text
forall a. Doc a
empty
                   [Text
"align-right"]  -> Doc Text
":align: right"
                   [Text
"align-left"]   -> Doc Text
":align: left"
                   [Text
"align-center"] -> Doc Text
":align: center"
                   [Text]
_ -> Doc Text
":class: " Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal ([Text] -> Text
T.unwords [Text]
cls)
  Doc Text -> RST m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> RST m (Doc Text)) -> Doc Text -> RST m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Int -> Doc Text -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a -> Doc a
hang Int
3 Doc Text
".. " (Doc Text
fig Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
alt Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
classes Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
dims Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$+$ Doc Text
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 [Inline]
inlines)
  | Inline
LineBreak Inline -> [Inline] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Inline]
inlines =
      [[Inline]] -> RST m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
[[Inline]] -> RST m (Doc Text)
linesToLineBlock ([[Inline]] -> RST m (Doc Text)) -> [[Inline]] -> RST m (Doc Text)
forall a b. (a -> b) -> a -> b
$ (Inline -> Bool) -> [Inline] -> [[Inline]]
forall a. (a -> Bool) -> [a] -> [[a]]
splitBy (Inline -> Inline -> Bool
forall a. Eq a => a -> a -> Bool
==Inline
LineBreak) [Inline]
inlines
  | Bool
otherwise = do
      Doc Text
contents <- [Inline] -> RST m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> RST m (Doc Text)
inlineListToRST [Inline]
inlines
      Doc Text -> RST m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> RST m (Doc Text)) -> Doc Text -> RST m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
blankline
blockToRST (LineBlock [[Inline]]
lns) =
  [[Inline]] -> RST m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
[[Inline]] -> RST m (Doc Text)
linesToLineBlock [[Inline]]
lns
blockToRST (RawBlock f :: Format
f@(Format Text
f') Text
str)
  | Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Format
"rst" = Doc Text -> RST m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> RST m (Doc Text)) -> Doc Text -> RST m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
str
  | Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Format
"tex" = Block -> RST m (Doc Text)
forall (m :: * -> *). PandocMonad m => Block -> RST m (Doc Text)
blockToRST (Format -> Text -> Block
RawBlock (Text -> Format
Format Text
"latex") Text
str)
  | Bool
otherwise  = Doc Text -> RST m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> RST m (Doc Text)) -> Doc Text -> RST m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
forall a. Doc a
blankline Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
".. raw:: " Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>
                    Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Text
T.toLower Text
f') Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$+$
                    Int -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a
nest Int
3 (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
str) Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
forall a. Doc a
blankline
blockToRST Block
HorizontalRule =
  Doc Text -> RST m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> RST m (Doc Text)) -> Doc Text -> RST m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
forall a. Doc a
blankline Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
"--------------" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
forall a. Doc a
blankline
blockToRST (Header Int
level (Text
name,[Text]
classes,[(Text, Text)]
_) [Inline]
inlines) = do
  Doc Text
contents <- [Inline] -> RST m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> RST m (Doc Text)
inlineListToRST [Inline]
inlines
  -- we calculate the id that would be used by auto_identifiers
  -- so we know whether to print an explicit identifier
  WriterOptions
opts <- (WriterState -> WriterOptions)
-> StateT WriterState m WriterOptions
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> WriterOptions
stOptions
  let autoId :: Text
autoId = Extensions -> [Inline] -> Set Text -> Text
uniqueIdent (WriterOptions -> Extensions
writerExtensions WriterOptions
opts) [Inline]
inlines Set Text
forall a. Monoid a => a
mempty
  Bool
isTopLevel <- (WriterState -> Bool) -> StateT WriterState m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stTopLevel
  if Bool
isTopLevel
    then do
          let headerChar :: Char
headerChar = if Int
level Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
5 then Char
' ' else String
"=-~^'" String -> Int -> Char
forall a. [a] -> Int -> a
!! (Int
level Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
          let border :: Doc Text
border = Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.replicate (Doc Text -> Int
forall a. (IsString a, HasChars a) => Doc a -> Int
offset Doc Text
contents) (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Char -> Text
T.singleton Char
headerChar
          let anchor :: Doc Text
anchor | Text -> Bool
T.null Text
name Bool -> Bool -> Bool
|| Text
name Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
autoId = Doc Text
forall a. Doc a
empty
                     | Bool
otherwise = Doc Text
".. _" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>
                                   (if (Char -> Bool) -> Text -> Bool
T.any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
':') Text
name Bool -> Bool -> Bool
||
                                        Int -> Text -> Text
T.take Int
1 Text
name Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"_"
                                       then Doc Text
"`" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
name Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"`"
                                       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 -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
forall a. Doc a
blankline
          Doc Text -> RST m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> RST m (Doc Text)) -> Doc Text -> RST m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text -> Doc Text
forall a. IsString a => Doc a -> Doc a
nowrap (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Doc Text
anchor Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
border Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
forall a. Doc a
blankline
    else do
          let rub :: Doc Text
rub     = Doc Text
"rubric:: " Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents
          let name' :: Doc Text
name' | Text -> Bool
T.null Text
name    = Doc Text
forall a. Doc a
empty
                    | Bool
otherwise      = Doc Text
":name: " Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
name
          let cls :: Doc Text
cls   | [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
classes   = Doc Text
forall a. Doc a
empty
                    | Bool
otherwise      = Doc Text
":class: " Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal ([Text] -> Text
T.unwords [Text]
classes)
          Doc Text -> RST m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> RST m (Doc Text)) -> Doc Text -> RST m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text -> Doc Text
forall a. IsString a => Doc a -> Doc a
nowrap (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Int -> Doc Text -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a -> Doc a
hang Int
3 Doc Text
".. " (Doc Text
rub Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
name' Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
cls) Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
forall a. Doc a
blankline
blockToRST (CodeBlock (Text
_,[Text]
classes,[(Text, Text)]
kvs) Text
str) = do
  WriterOptions
opts <- (WriterState -> WriterOptions)
-> StateT WriterState m WriterOptions
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> WriterOptions
stOptions
  let startnum :: Doc Text
startnum = Doc Text -> (Text -> Doc Text) -> Maybe Text -> Doc Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc Text
"" (\Text
x -> Doc Text
" " Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
x) (Maybe Text -> Doc Text) -> Maybe Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"startFrom" [(Text, Text)]
kvs
  let numberlines :: Doc Text
numberlines = if Text
"numberLines" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes
                       then Doc Text
"   :number-lines:" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
startnum
                       else Doc Text
forall a. Doc a
empty
  if Text
"haskell" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes Bool -> Bool -> Bool
&& Text
"literate" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes Bool -> Bool -> Bool
&&
                  Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_literate_haskell WriterOptions
opts
     then Doc Text -> RST m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> RST m (Doc Text)) -> Doc Text -> RST m (Doc Text)
forall a b. (a -> b) -> a -> b
$ String -> Doc Text -> Doc Text
forall a. IsString a => String -> Doc a -> Doc a
prefixed String
"> " (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
str) Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
forall a. Doc a
blankline
     else Doc Text -> RST m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> RST m (Doc Text)) -> Doc Text -> RST m (Doc Text)
forall a b. (a -> b) -> a -> b
$
          (case [Text
c | Text
c <- [Text]
classes,
                     Text
c Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Text
"sourceCode",Text
"literate",Text
"numberLines",
                                  Text
"number-lines",Text
"example"]] of
             []       -> Doc Text
"::"
             (Text
lang:[Text]
_) -> (Doc Text
".. code:: " Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
lang) Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
numberlines)
          Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$+$ Int -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a
nest Int
3 (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
str) Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
forall a. Doc a
blankline
blockToRST (BlockQuote [Block]
blocks) = do
  Doc Text
contents <- [Block] -> RST m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> RST m (Doc Text)
blockListToRST [Block]
blocks
  Doc Text -> RST m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> RST m (Doc Text)) -> Doc Text -> RST m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Int -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a
nest Int
3 Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
blankline
blockToRST (Table Attr
_ Caption
blkCapt [ColSpec]
specs TableHead
thead [TableBody]
tbody TableFoot
tfoot) = do
  let ([Inline]
caption, [Alignment]
aligns, [Double]
widths, [[Block]]
headers, [[[Block]]]
rows) = Caption
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> ([Inline], [Alignment], [Double], [[Block]], [[[Block]]])
toLegacyTable Caption
blkCapt [ColSpec]
specs TableHead
thead [TableBody]
tbody TableFoot
tfoot
  Doc Text
caption' <- [Inline] -> RST m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> RST m (Doc Text)
inlineListToRST [Inline]
caption
  let blocksToDoc :: WriterOptions -> [Block] -> StateT WriterState m (Doc Text)
blocksToDoc WriterOptions
opts [Block]
bs = do
         WriterOptions
oldOpts <- (WriterState -> WriterOptions)
-> StateT WriterState m WriterOptions
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> WriterOptions
stOptions
         (WriterState -> WriterState) -> StateT WriterState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState) -> StateT WriterState m ())
-> (WriterState -> WriterState) -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st{ stOptions :: WriterOptions
stOptions = WriterOptions
opts }
         Doc Text
result <- [Block] -> StateT WriterState m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> RST m (Doc Text)
blockListToRST [Block]
bs
         (WriterState -> WriterState) -> StateT WriterState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState) -> StateT WriterState m ())
-> (WriterState -> WriterState) -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st{ stOptions :: WriterOptions
stOptions = WriterOptions
oldOpts }
         Doc Text -> StateT WriterState m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
result
  WriterOptions
opts <- (WriterState -> WriterOptions)
-> StateT WriterState m WriterOptions
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> WriterOptions
stOptions
  let isSimple :: Bool
isSimple = (Double -> Bool) -> [Double] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
0) [Double]
widths Bool -> Bool -> Bool
&& [Double] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Double]
widths Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1
  Doc Text
tbl <- if Bool
isSimple
            then do
              Doc Text
tbl' <- WriterOptions
-> (WriterOptions -> [Block] -> RST m (Doc Text))
-> [[Block]]
-> [[[Block]]]
-> RST m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions
-> (WriterOptions -> [Block] -> m (Doc Text))
-> [[Block]]
-> [[[Block]]]
-> m (Doc Text)
simpleTable WriterOptions
opts WriterOptions -> [Block] -> RST m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> StateT WriterState m (Doc Text)
blocksToDoc [[Block]]
headers [[[Block]]]
rows
              if Doc Text -> Int
forall a. (IsString a, HasChars a) => Doc a -> Int
offset Doc Text
tbl' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> WriterOptions -> Int
writerColumns WriterOptions
opts
                 then WriterOptions
-> (WriterOptions -> [Block] -> RST m (Doc Text))
-> Bool
-> [Alignment]
-> [Double]
-> [[Block]]
-> [[[Block]]]
-> RST m (Doc Text)
forall (m :: * -> *) a.
(Monad m, HasChars a) =>
WriterOptions
-> (WriterOptions -> [Block] -> m (Doc a))
-> Bool
-> [Alignment]
-> [Double]
-> [[Block]]
-> [[[Block]]]
-> m (Doc a)
gridTable WriterOptions
opts WriterOptions -> [Block] -> RST m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> StateT WriterState m (Doc Text)
blocksToDoc (([Block] -> Bool) -> [[Block]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all [Block] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Block]]
headers)
                      ((Alignment -> Alignment) -> [Alignment] -> [Alignment]
forall a b. (a -> b) -> [a] -> [b]
map (Alignment -> Alignment -> Alignment
forall a b. a -> b -> a
const Alignment
AlignDefault) [Alignment]
aligns) [Double]
widths
                      [[Block]]
headers [[[Block]]]
rows
                 else Doc Text -> RST m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
tbl'
            else WriterOptions
-> (WriterOptions -> [Block] -> RST m (Doc Text))
-> Bool
-> [Alignment]
-> [Double]
-> [[Block]]
-> [[[Block]]]
-> RST m (Doc Text)
forall (m :: * -> *) a.
(Monad m, HasChars a) =>
WriterOptions
-> (WriterOptions -> [Block] -> m (Doc a))
-> Bool
-> [Alignment]
-> [Double]
-> [[Block]]
-> [[[Block]]]
-> m (Doc a)
gridTable WriterOptions
opts WriterOptions -> [Block] -> RST m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> StateT WriterState m (Doc Text)
blocksToDoc (([Block] -> Bool) -> [[Block]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all [Block] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Block]]
headers)
                  ((Alignment -> Alignment) -> [Alignment] -> [Alignment]
forall a b. (a -> b) -> [a] -> [b]
map (Alignment -> Alignment -> Alignment
forall a b. a -> b -> a
const Alignment
AlignDefault) [Alignment]
aligns) [Double]
widths
                  [[Block]]
headers [[[Block]]]
rows
  Doc Text -> RST m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> RST m (Doc Text)) -> Doc Text -> RST m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
forall a. Doc a
blankline Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
           (if [Inline] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
caption
               then Doc Text
tbl
               else (Doc Text
".. table:: " Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
caption') Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
forall a. Doc a
blankline Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Int -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a
nest Int
3 Doc Text
tbl) Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
           Doc Text
forall a. Doc a
blankline
blockToRST (BulletList [[Block]]
items) = do
  [Doc Text]
contents <- ([Block] -> RST m (Doc Text))
-> [[Block]] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM [Block] -> RST m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> RST m (Doc Text)
bulletListItemToRST [[Block]]
items
  -- ensure that sublists have preceding blank line
  Doc Text -> RST m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> RST m (Doc Text)) -> Doc Text -> RST m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
forall a. Doc a
blankline Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
           (if [[Block]] -> Bool
isTightList [[Block]]
items then [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat else [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vsep) [Doc Text]
contents Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
           Doc Text
forall a. Doc a
blankline
blockToRST (OrderedList (Int
start, ListNumberStyle
style', ListNumberDelim
delim) [[Block]]
items) = do
  let markers :: [Text]
markers = if Int
start Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> Bool -> Bool
&& ListNumberStyle
style' ListNumberStyle -> ListNumberStyle -> Bool
forall a. Eq a => a -> a -> Bool
== ListNumberStyle
DefaultStyle Bool -> Bool -> Bool
&& ListNumberDelim
delim ListNumberDelim -> ListNumberDelim -> Bool
forall a. Eq a => a -> a -> Bool
== ListNumberDelim
DefaultDelim
                   then Int -> Text -> [Text]
forall a. Int -> a -> [a]
replicate ([[Block]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Block]]
items) Text
"#."
                   else Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
take ([[Block]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Block]]
items) ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ (Int, ListNumberStyle, ListNumberDelim) -> [Text]
orderedListMarkers
                                              (Int
start, ListNumberStyle
style', ListNumberDelim
delim)
  let maxMarkerLength :: Int
maxMarkerLength = Int -> (NonEmpty Int -> Int) -> Maybe (NonEmpty Int) -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 NonEmpty Int -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (Maybe (NonEmpty Int) -> Int) -> Maybe (NonEmpty Int) -> Int
forall a b. (a -> b) -> a -> b
$ [Int] -> Maybe (NonEmpty Int)
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty ([Int] -> Maybe (NonEmpty Int)) -> [Int] -> Maybe (NonEmpty Int)
forall a b. (a -> b) -> a -> b
$ (Text -> Int) -> [Text] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Int
T.length [Text]
markers
  let markers' :: [Text]
markers' = (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (\Text
m -> let s :: Int
s = Int
maxMarkerLength Int -> Int -> Int
forall a. Num a => a -> a -> a
- Text -> Int
T.length Text
m
                            in  Text
m Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.replicate Int
s Text
" ") [Text]
markers
  [Doc Text]
contents <- (Text -> [Block] -> RST m (Doc Text))
-> [Text] -> [[Block]] -> StateT WriterState m [Doc Text]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM Text -> [Block] -> RST m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Text -> [Block] -> RST m (Doc Text)
orderedListItemToRST [Text]
markers' [[Block]]
items
  -- ensure that sublists have preceding blank line
  Doc Text -> RST m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> RST m (Doc Text)) -> Doc Text -> RST m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
forall a. Doc a
blankline Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
           (if [[Block]] -> Bool
isTightList [[Block]]
items then [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat else [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vsep) [Doc Text]
contents Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
           Doc Text
forall a. Doc a
blankline
blockToRST (DefinitionList [([Inline], [[Block]])]
items) = do
  [Doc Text]
contents <- (([Inline], [[Block]]) -> RST m (Doc Text))
-> [([Inline], [[Block]])] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ([Inline], [[Block]]) -> RST m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
([Inline], [[Block]]) -> RST m (Doc Text)
definitionListItemToRST [([Inline], [[Block]])]
items
  -- ensure that sublists have preceding blank line
  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

-- | Convert bullet list item (list of blocks) to RST.
bulletListItemToRST :: PandocMonad m => [Block] -> RST m (Doc Text)
bulletListItemToRST :: [Block] -> RST m (Doc Text)
bulletListItemToRST [Block]
items = do
  Doc Text
contents <- [Block] -> RST m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> RST m (Doc Text)
blockListToRST [Block]
items
  Doc Text -> RST m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> RST m (Doc Text)) -> Doc Text -> RST m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Int -> Doc Text -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a -> Doc a
hang Int
3 Doc Text
"-  " Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
      if [Block] -> Bool
endsWithPlain [Block]
items
         then Doc Text
forall a. Doc a
cr
         else Doc Text
forall a. Doc a
blankline

-- | Convert ordered list item (a list of blocks) to RST.
orderedListItemToRST :: PandocMonad m
                     => Text   -- ^ marker for list item
                     -> [Block]  -- ^ list item (list of blocks)
                     -> RST m (Doc Text)
orderedListItemToRST :: Text -> [Block] -> RST m (Doc Text)
orderedListItemToRST Text
marker [Block]
items = do
  Doc Text
contents <- [Block] -> RST m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> RST m (Doc Text)
blockListToRST [Block]
items
  let marker' :: Text
marker' = Text
marker Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" "
  Doc Text -> RST m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> RST m (Doc Text)) -> Doc Text -> RST m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Int -> Doc Text -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a -> Doc a
hang (Text -> Int
T.length Text
marker') (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
marker') Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
      if [Block] -> Bool
endsWithPlain [Block]
items
         then Doc Text
forall a. Doc a
cr
         else Doc Text
forall a. Doc a
blankline

-- | Convert definition list item (label, list of blocks) to RST.
definitionListItemToRST :: PandocMonad m => ([Inline], [[Block]]) -> RST m (Doc Text)
definitionListItemToRST :: ([Inline], [[Block]]) -> RST m (Doc Text)
definitionListItemToRST ([Inline]
label, [[Block]]
defs) = do
  Doc Text
label' <- [Inline] -> RST m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> RST m (Doc Text)
inlineListToRST [Inline]
label
  Doc Text
contents <- ([Doc Text] -> Doc Text)
-> StateT WriterState m [Doc Text] -> RST m (Doc Text)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat (StateT WriterState m [Doc Text] -> RST m (Doc Text))
-> StateT WriterState m [Doc Text] -> RST m (Doc Text)
forall a b. (a -> b) -> a -> b
$ ([Block] -> RST m (Doc Text))
-> [[Block]] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM [Block] -> RST m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> RST m (Doc Text)
blockListToRST [[Block]]
defs
  Doc Text -> RST m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> RST m (Doc Text)) -> Doc Text -> RST m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text -> Doc Text
forall a. IsString a => Doc a -> Doc a
nowrap Doc Text
label' Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Int -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a
nest Int
3 (Doc Text -> Doc Text
forall a. Doc a -> Doc a
nestle Doc Text
contents) Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
      if [[Block]] -> Bool
isTightList [[Block]]
defs
         then Doc Text
forall a. Doc a
cr
         else Doc Text
forall a. Doc a
blankline

-- | Format a list of lines as line block.
linesToLineBlock :: PandocMonad m => [[Inline]] -> RST m (Doc Text)
linesToLineBlock :: [[Inline]] -> RST m (Doc Text)
linesToLineBlock [[Inline]]
inlineLines = do
  [Doc Text]
lns <- ([Inline] -> RST m (Doc Text))
-> [[Inline]] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM [Inline] -> RST m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> RST m (Doc Text)
inlineListToRST [[Inline]]
inlineLines
  Doc Text -> RST m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> RST m (Doc Text)) -> Doc Text -> RST m (Doc Text)
forall a b. (a -> b) -> a -> b
$
                      [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat ((Doc Text -> Doc Text) -> [Doc Text] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Doc Text -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a -> Doc a
hang Int
2 (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
"| ")) [Doc Text]
lns) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
blankline

-- | Convert list of Pandoc block elements to RST.
blockListToRST' :: PandocMonad m
                => Bool
                -> [Block]       -- ^ List of block elements
                -> RST m (Doc Text)
blockListToRST' :: Bool -> [Block] -> RST m (Doc Text)
blockListToRST' Bool
topLevel [Block]
blocks = do
  -- insert comment between list and quoted blocks, see #4248 and #3675
  let fixBlocks :: [Block] -> [Block]
fixBlocks (Block
b1:b2 :: Block
b2@(BlockQuote [Block]
_):[Block]
bs)
        | Block -> Bool
toClose Block
b1 = Block
b1 Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: Block
commentSep Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: Block
b2 Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block] -> [Block]
fixBlocks [Block]
bs
        where
          toClose :: Block -> Bool
toClose Plain{}                  = Bool
False
          toClose Header{}                 = Bool
False
          toClose LineBlock{}              = Bool
False
          toClose Block
HorizontalRule           = Bool
False
          toClose SimpleFigure{}           = Bool
True
          toClose Para{}                   = Bool
False
          toClose Block
_                        = Bool
True
          commentSep :: Block
commentSep  = Format -> Text -> Block
RawBlock Format
"rst" Text
"..\n\n"
      fixBlocks (Block
b:[Block]
bs) = Block
b Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block] -> [Block]
fixBlocks [Block]
bs
      fixBlocks [] = []
  Bool
tl <- (WriterState -> Bool) -> StateT WriterState m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stTopLevel
  (WriterState -> WriterState) -> StateT WriterState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\WriterState
s->WriterState
s{stTopLevel :: Bool
stTopLevel=Bool
topLevel})
  Doc Text
res <- [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat ([Doc Text] -> Doc Text)
-> StateT WriterState m [Doc Text] -> RST m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` (Block -> RST m (Doc Text))
-> [Block] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Block -> RST m (Doc Text)
forall (m :: * -> *). PandocMonad m => Block -> RST m (Doc Text)
blockToRST ([Block] -> [Block]
fixBlocks [Block]
blocks)
  (WriterState -> WriterState) -> StateT WriterState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\WriterState
s->WriterState
s{stTopLevel :: Bool
stTopLevel=Bool
tl})
  Doc Text -> RST m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
res

blockListToRST :: PandocMonad m
               => [Block]       -- ^ List of block elements
               -> 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 -- empty inlines are not valid RST syntax
        hasContents :: Inline -> Bool
        hasContents :: Inline -> Bool
hasContents (Str Text
"")              = Bool
False
        hasContents (Emph [])             = Bool
False
        hasContents (Underline [])        = Bool
False
        hasContents (Strong [])           = Bool
False
        hasContents (Strikeout [])        = Bool
False
        hasContents (Superscript [])      = Bool
False
        hasContents (Subscript [])        = Bool
False
        hasContents (SmallCaps [])        = Bool
False
        hasContents (Quoted QuoteType
_ [])         = Bool
False
        hasContents (Cite [Citation]
_ [])           = Bool
False
        hasContents (Span Attr
_ [])           = Bool
False
        hasContents (Link Attr
_ [] (Text
"", Text
""))  = Bool
False
        hasContents (Image Attr
_ [] (Text
"", Text
"")) = Bool
False
        hasContents Inline
_                     = Bool
True
        -- remove spaces after displaymath, as they screw up indentation:
        removeSpaceAfterDisplayMath :: [Inline] -> [Inline]
removeSpaceAfterDisplayMath (Math MathType
DisplayMath Text
x : [Inline]
zs) =
              MathType -> Text -> Inline
Math MathType
DisplayMath Text
x Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: (Inline -> Bool) -> [Inline] -> [Inline]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Inline -> Inline -> Bool
forall a. Eq a => a -> a -> Bool
==Inline
Space) [Inline]
zs
        removeSpaceAfterDisplayMath (Inline
x:[Inline]
xs) = Inline
x Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline] -> [Inline]
removeSpaceAfterDisplayMath [Inline]
xs
        removeSpaceAfterDisplayMath [] = []
        insertBS :: [Inline] -> [Inline] -- insert '\ ' where needed
        insertBS :: [Inline] -> [Inline]
insertBS (Inline
x:Inline
y:Inline
z:[Inline]
zs)
          | Inline -> Bool
isComplex Inline
y Bool -> Bool -> Bool
&& Inline -> Inline -> Bool
surroundComplex Inline
x Inline
z =
              Inline
x Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Inline
y Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline] -> [Inline]
insertBS (Inline
z Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
zs)
        insertBS (Inline
x:Inline
y:[Inline]
zs)
          | Inline -> Bool
isComplex Inline
x Bool -> Bool -> Bool
&& Bool -> Bool
not (Inline -> Bool
okAfterComplex Inline
y) =
              Inline
x Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Format -> Text -> Inline
RawInline Format
"rst" Text
"\\ " Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline] -> [Inline]
insertBS (Inline
y Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
zs)
          | Inline -> Bool
isComplex Inline
y Bool -> Bool -> Bool
&& Bool -> Bool
not (Inline -> Bool
okBeforeComplex Inline
x) =
              Inline
x Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Format -> Text -> Inline
RawInline Format
"rst" Text
"\\ " Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline] -> [Inline]
insertBS (Inline
y Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
zs)
          | Bool
otherwise =
              Inline
x Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline] -> [Inline]
insertBS (Inline
y Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
zs)
        insertBS (Inline
x:[Inline]
ys) = Inline
x Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline] -> [Inline]
insertBS [Inline]
ys
        insertBS [] = []
        transformNested :: [Inline] -> [Inline]
        transformNested :: [Inline] -> [Inline]
transformNested = (Inline -> Inline) -> [Inline] -> [Inline]
forall a b. (a -> b) -> [a] -> [b]
map (([Inline] -> [Inline]) -> Inline -> Inline
mapNested [Inline] -> [Inline]
stripLeadingTrailingSpace)
        surroundComplex :: Inline -> Inline -> Bool
        surroundComplex :: Inline -> Inline -> Bool
surroundComplex (Str Text
s) (Str Text
s')
          | Just (Text
_, Char
c)  <- Text -> Maybe (Text, Char)
T.unsnoc Text
s
          , Just (Char
c', Text
_) <- Text -> Maybe (Char, Text)
T.uncons Text
s'
          = case (Char
c, Char
c') of
              (Char
'\'',Char
'\'') -> Bool
True
              (Char
'"',Char
'"')   -> Bool
True
              (Char
'<',Char
'>')   -> Bool
True
              (Char
'[',Char
']')   -> Bool
True
              (Char
'{',Char
'}')   -> Bool
True
              (Char, Char)
_           -> Bool
False
        surroundComplex Inline
_ Inline
_ = Bool
False
        okAfterComplex :: Inline -> Bool
        okAfterComplex :: Inline -> Bool
okAfterComplex Inline
Space = Bool
True
        okAfterComplex Inline
SoftBreak = Bool
True
        okAfterComplex Inline
LineBreak = Bool
True
        okAfterComplex (Str (Text -> Maybe (Char, Text)
T.uncons -> Just (Char
c,Text
_)))
          = Char -> Bool
isSpace Char
c Bool -> Bool -> Bool
|| Char
c Char -> Text -> Bool
`elemText` Text
"-.,:;!?\\/'\")]}>–—"
        okAfterComplex Inline
_ = Bool
False
        okBeforeComplex :: Inline -> Bool
        okBeforeComplex :: Inline -> Bool
okBeforeComplex Inline
Space = Bool
True
        okBeforeComplex Inline
SoftBreak = Bool
True
        okBeforeComplex Inline
LineBreak = Bool
True
        okBeforeComplex (Str (Text -> Maybe (Text, Char)
T.unsnoc -> Just (Text
_,Char
c)))
                          = Char -> Bool
isSpace Char
c Bool -> Bool -> Bool
|| Char
c Char -> Text -> Bool
`elemText` Text
"-:/'\"<([{–—"
        okBeforeComplex Inline
_ = Bool
False
        isComplex :: Inline -> Bool
        isComplex :: Inline -> Bool
isComplex (Emph [Inline]
_)        = Bool
True
        isComplex (Underline [Inline]
_)   = Bool
True
        isComplex (Strong [Inline]
_)      = Bool
True
        isComplex (SmallCaps [Inline]
_)   = Bool
True
        isComplex (Strikeout [Inline]
_)   = Bool
True
        isComplex (Superscript [Inline]
_) = Bool
True
        isComplex (Subscript [Inline]
_)   = Bool
True
        isComplex Link{}          = Bool
True
        isComplex Image{}         = Bool
True
        isComplex (Code Attr
_ Text
_)      = Bool
True
        isComplex (Math MathType
_ Text
_)      = Bool
True
        isComplex (Cite [Citation]
_ (Inline
x:[Inline]
_))  = Inline -> Bool
isComplex Inline
x
        isComplex (Span Attr
_ (Inline
x:[Inline]
_))  = Inline -> Bool
isComplex Inline
x
        isComplex Inline
_               = Bool
False

-- | Flattens nested inlines. Extracts nested inlines and goes through
-- them either collapsing them in the outer inline container or
-- pulling them out of it
flatten :: Inline -> [Inline]
flatten :: Inline -> [Inline]
flatten Inline
outer
  | [Inline] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
contents = [Inline
outer]
  | Bool
otherwise     = [Inline] -> [Inline]
combineAll [Inline]
contents
  where contents :: [Inline]
contents = Inline -> [Inline]
dropInlineParent Inline
outer
        combineAll :: [Inline] -> [Inline]
combineAll = ([Inline] -> Inline -> [Inline])
-> [Inline] -> [Inline] -> [Inline]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' [Inline] -> Inline -> [Inline]
combine []

        combine :: [Inline] -> Inline -> [Inline]
        combine :: [Inline] -> Inline -> [Inline]
combine [Inline]
f Inline
i =
          case (Inline
outer, Inline
i) of
          -- quotes are not rendered using RST inlines, so we can keep
          -- them and they will be readable and parsable
          (Quoted QuoteType
_ [Inline]
_, Inline
_)          -> [Inline] -> Inline -> [Inline]
keep [Inline]
f Inline
i
          (Inline
_, Quoted QuoteType
_ [Inline]
_)          -> [Inline] -> Inline -> [Inline]
keep [Inline]
f Inline
i
          -- spans are not rendered using RST inlines, so we can keep them
          (Span (Text
_,[Text]
_,[]) [Inline]
_, Inline
_)   -> [Inline] -> Inline -> [Inline]
keep [Inline]
f Inline
i
          (Inline
_, Span (Text
_,[Text]
_,[]) [Inline]
_)   -> [Inline] -> Inline -> [Inline]
keep [Inline]
f Inline
i
          -- inlineToRST handles this case properly so it's safe to keep
          ( Link{}, Image{})       -> [Inline] -> Inline -> [Inline]
keep [Inline]
f Inline
i
          -- parent inlines would prevent links from being correctly
          -- parsed, in this case we prioritise the content over the
          -- style
          (Inline
_, Link{})              -> [Inline] -> Inline -> [Inline]
forall a. [a] -> a -> [a]
emerge [Inline]
f Inline
i
          -- always give priority to strong text over emphasis
          (Emph [Inline]
_, Strong [Inline]
_)       -> [Inline] -> Inline -> [Inline]
forall a. [a] -> a -> [a]
emerge [Inline]
f Inline
i
          -- drop all other nested styles
          (Inline
_, Inline
_)                   -> [Inline] -> Inline -> [Inline]
collapse [Inline]
f Inline
i

        emerge :: [a] -> a -> [a]
emerge [a]
f a
i = [a]
f [a] -> [a] -> [a]
forall a. Semigroup a => a -> a -> a
<> [a
i]
        keep :: [Inline] -> Inline -> [Inline]
keep [Inline]
f Inline
i = [Inline] -> [Inline] -> [Inline]
appendToLast [Inline]
f [Inline
i]
        collapse :: [Inline] -> Inline -> [Inline]
collapse [Inline]
f Inline
i = [Inline] -> [Inline] -> [Inline]
appendToLast [Inline]
f ([Inline] -> [Inline]) -> [Inline] -> [Inline]
forall a b. (a -> b) -> a -> b
$ Inline -> [Inline]
dropInlineParent Inline
i

        appendToLast :: [Inline] -> [Inline] -> [Inline]
        appendToLast :: [Inline] -> [Inline] -> [Inline]
appendToLast [Inline]
flattened [Inline]
toAppend =
          case [Inline] -> Maybe (NonEmpty Inline)
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [Inline]
flattened of
            Maybe (NonEmpty Inline)
Nothing -> [Inline -> [Inline] -> Inline
setInlineChildren Inline
outer [Inline]
toAppend]
            Just NonEmpty Inline
xs ->
              if Inline -> Bool
isOuter Inline
lastFlat
                 then NonEmpty Inline -> [Inline]
forall a. NonEmpty a -> [a]
NE.init NonEmpty Inline
xs [Inline] -> [Inline] -> [Inline]
forall a. Semigroup a => a -> a -> a
<> [Inline -> [Inline] -> Inline
appendTo Inline
lastFlat [Inline]
toAppend]
                 else [Inline]
flattened [Inline] -> [Inline] -> [Inline]
forall a. Semigroup a => a -> a -> a
<> [Inline -> [Inline] -> Inline
setInlineChildren Inline
outer [Inline]
toAppend]
               where
                lastFlat :: Inline
lastFlat = NonEmpty Inline -> Inline
forall a. NonEmpty a -> a
NE.last NonEmpty Inline
xs
                appendTo :: Inline -> [Inline] -> Inline
appendTo Inline
o [Inline]
i = ([Inline] -> [Inline]) -> Inline -> Inline
mapNested ([Inline] -> [Inline] -> [Inline]
forall a. Semigroup a => a -> a -> a
<> [Inline]
i) Inline
o
                isOuter :: Inline -> Bool
isOuter Inline
i = Inline -> Inline
emptyParent Inline
i Inline -> Inline -> Bool
forall a. Eq a => a -> a -> Bool
== Inline -> Inline
emptyParent Inline
outer
                emptyParent :: Inline -> Inline
emptyParent Inline
i = Inline -> [Inline] -> Inline
setInlineChildren Inline
i []

mapNested :: ([Inline] -> [Inline]) -> Inline -> Inline
mapNested :: ([Inline] -> [Inline]) -> Inline -> Inline
mapNested [Inline] -> [Inline]
f Inline
i = Inline -> [Inline] -> Inline
setInlineChildren Inline
i ([Inline] -> [Inline]
f (Inline -> [Inline]
dropInlineParent Inline
i))

dropInlineParent :: Inline -> [Inline]
dropInlineParent :: Inline -> [Inline]
dropInlineParent (Link Attr
_ [Inline]
i (Text, Text)
_)    = [Inline]
i
dropInlineParent (Emph [Inline]
i)        = [Inline]
i
dropInlineParent (Underline [Inline]
i)   = [Inline]
i
dropInlineParent (Strong [Inline]
i)      = [Inline]
i
dropInlineParent (Strikeout [Inline]
i)   = [Inline]
i
dropInlineParent (Superscript [Inline]
i) = [Inline]
i
dropInlineParent (Subscript [Inline]
i)   = [Inline]
i
dropInlineParent (SmallCaps [Inline]
i)   = [Inline]
i
dropInlineParent (Cite [Citation]
_ [Inline]
i)      = [Inline]
i
dropInlineParent (Image Attr
_ [Inline]
i (Text, Text)
_)   = [Inline]
i
dropInlineParent (Span Attr
_ [Inline]
i)      = [Inline]
i
dropInlineParent (Quoted QuoteType
_ [Inline]
i)    = [Inline]
i
dropInlineParent Inline
i               = [Inline
i] -- not a parent, like Str or Space

setInlineChildren :: Inline -> [Inline] -> Inline
setInlineChildren :: Inline -> [Inline] -> Inline
setInlineChildren (Link Attr
a [Inline]
_ (Text, Text)
t) [Inline]
i    = Attr -> [Inline] -> (Text, Text) -> Inline
Link Attr
a [Inline]
i (Text, Text)
t
setInlineChildren (Emph [Inline]
_) [Inline]
i        = [Inline] -> Inline
Emph [Inline]
i
setInlineChildren (Underline [Inline]
_) [Inline]
i   = [Inline] -> Inline
Underline [Inline]
i
setInlineChildren (Strong [Inline]
_) [Inline]
i      = [Inline] -> Inline
Strong [Inline]
i
setInlineChildren (Strikeout [Inline]
_) [Inline]
i   = [Inline] -> Inline
Strikeout [Inline]
i
setInlineChildren (Superscript [Inline]
_) [Inline]
i = [Inline] -> Inline
Superscript [Inline]
i
setInlineChildren (Subscript [Inline]
_) [Inline]
i   = [Inline] -> Inline
Subscript [Inline]
i
setInlineChildren (SmallCaps [Inline]
_) [Inline]
i   = [Inline] -> Inline
SmallCaps [Inline]
i
setInlineChildren (Quoted QuoteType
q [Inline]
_) [Inline]
i    = QuoteType -> [Inline] -> Inline
Quoted QuoteType
q [Inline]
i
setInlineChildren (Cite [Citation]
c [Inline]
_) [Inline]
i      = [Citation] -> [Inline] -> Inline
Cite [Citation]
c [Inline]
i
setInlineChildren (Image Attr
a [Inline]
_ (Text, Text)
t) [Inline]
i   = Attr -> [Inline] -> (Text, Text) -> Inline
Image Attr
a [Inline]
i (Text, Text)
t
setInlineChildren (Span Attr
a [Inline]
_) [Inline]
i      = Attr -> [Inline] -> Inline
Span Attr
a [Inline]
i
setInlineChildren Inline
leaf [Inline]
_            = Inline
leaf

inlineListToRST :: PandocMonad m => [Inline] -> RST m (Doc Text)
inlineListToRST :: [Inline] -> RST m (Doc Text)
inlineListToRST = [Inline] -> RST m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> RST m (Doc Text)
writeInlines ([Inline] -> RST m (Doc Text))
-> ([Inline] -> [Inline]) -> [Inline] -> RST m (Doc Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Inline] -> [Inline]) -> [Inline] -> [Inline]
forall a b. Walkable a b => (a -> a) -> b -> b
walk [Inline] -> [Inline]
transformInlines

-- | Convert list of Pandoc inline elements to RST.
writeInlines :: PandocMonad m => [Inline] -> RST m (Doc Text)
writeInlines :: [Inline] -> RST m (Doc Text)
writeInlines [Inline]
lst =
   [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
hcat ([Doc Text] -> Doc Text)
-> StateT WriterState m [Doc Text] -> RST m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Inline -> RST m (Doc Text))
-> [Inline] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Inline -> RST m (Doc Text)
forall (m :: * -> *). PandocMonad m => Inline -> RST m (Doc Text)
inlineToRST [Inline]
lst

-- | Convert Pandoc inline element to RST.
inlineToRST :: PandocMonad m => Inline -> RST m (Doc Text)
inlineToRST :: Inline -> RST m (Doc Text)
inlineToRST (Span (Text
_,[Text]
_,[(Text, Text)]
kvs) [Inline]
ils) = do
  Doc Text
contents <- [Inline] -> RST m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> RST m (Doc Text)
writeInlines [Inline]
ils
  Doc Text -> RST m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> RST m (Doc Text)) -> Doc Text -> RST m (Doc Text)
forall a b. (a -> b) -> a -> b
$
    case Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"role" [(Text, Text)]
kvs of
          Just Text
role -> Doc Text
":" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
role Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
":`" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"`"
          Maybe Text
Nothing   -> Doc Text
contents
inlineToRST (Emph [Inline]
lst) = do
  Doc Text
contents <- [Inline] -> RST m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> RST m (Doc Text)
writeInlines [Inline]
lst
  Doc Text -> RST m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> RST m (Doc Text)) -> Doc Text -> RST m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
"*" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"*"
-- Underline is not supported, fall back to Emph
inlineToRST (Underline [Inline]
lst) =
  Inline -> RST m (Doc Text)
forall (m :: * -> *). PandocMonad m => Inline -> RST m (Doc Text)
inlineToRST ([Inline] -> Inline
Emph [Inline]
lst)
inlineToRST (Strong [Inline]
lst) = do
  Doc Text
contents <- [Inline] -> RST m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> RST m (Doc Text)
writeInlines [Inline]
lst
  Doc Text -> RST m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> RST m (Doc Text)) -> Doc Text -> RST m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
"**" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"**"
inlineToRST (Strikeout [Inline]
lst) = do
  Doc Text
contents <- [Inline] -> RST m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> RST m (Doc Text)
writeInlines [Inline]
lst
  Doc Text -> RST m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> RST m (Doc Text)) -> Doc Text -> RST m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
"[STRIKEOUT:" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"]"
inlineToRST (Superscript [Inline]
lst) = do
  Doc Text
contents <- [Inline] -> RST m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> RST m (Doc Text)
writeInlines [Inline]
lst
  Doc Text -> RST m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> RST m (Doc Text)) -> Doc Text -> RST m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
":sup:`" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"`"
inlineToRST (Subscript [Inline]
lst) = do
  Doc Text
contents <- [Inline] -> RST m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> RST m (Doc Text)
writeInlines [Inline]
lst
  Doc Text -> RST m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> RST m (Doc Text)) -> Doc Text -> RST m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
":sub:`" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"`"
inlineToRST (SmallCaps [Inline]
lst) = [Inline] -> RST m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> RST m (Doc Text)
writeInlines [Inline]
lst
inlineToRST (Quoted QuoteType
SingleQuote [Inline]
lst) = do
  Doc Text
contents <- [Inline] -> RST m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> RST m (Doc Text)
writeInlines [Inline]
lst
  WriterOptions
opts <- (WriterState -> WriterOptions)
-> StateT WriterState m WriterOptions
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> WriterOptions
stOptions
  if Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_smart WriterOptions
opts
     then Doc Text -> RST m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> RST m (Doc Text)) -> Doc Text -> RST m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
"'" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"'"
     else Doc Text -> RST m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> RST m (Doc Text)) -> Doc Text -> RST m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
"‘" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"’"
inlineToRST (Quoted QuoteType
DoubleQuote [Inline]
lst) = do
  Doc Text
contents <- [Inline] -> RST m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> RST m (Doc Text)
writeInlines [Inline]
lst
  WriterOptions
opts <- (WriterState -> WriterOptions)
-> StateT WriterState m WriterOptions
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> WriterOptions
stOptions
  if Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_smart WriterOptions
opts
     then Doc Text -> RST m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> RST m (Doc Text)) -> Doc Text -> RST m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
"\"" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"\""
     else Doc Text -> RST m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> RST m (Doc Text)) -> Doc Text -> RST m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
"“" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"”"
inlineToRST (Cite [Citation]
_  [Inline]
lst) =
  [Inline] -> RST m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> RST m (Doc Text)
writeInlines [Inline]
lst
inlineToRST (Code (Text
_,[Text
"interpreted-text"],[(Text
"role",Text
role)]) Text
str) =
  Doc Text -> RST m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> RST m (Doc Text)) -> Doc Text -> RST m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
":" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
role Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
":`" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
str Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"`"
inlineToRST (Code Attr
_ Text
str) = do
  WriterOptions
opts <- (WriterState -> WriterOptions)
-> StateT WriterState m WriterOptions
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> WriterOptions
stOptions
  -- we trim the string because the delimiters must adjoin a
  -- non-space character; see #3496
  -- we use :literal: when the code contains backticks, since
  -- :literal: allows backslash-escapes; see #3974
  Doc Text -> RST m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> RST m (Doc Text)) -> Doc Text -> RST m (Doc Text)
forall a b. (a -> b) -> a -> b
$
    if Char
'`' Char -> Text -> Bool
`elemText` Text
str
       then Doc Text
":literal:`" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (WriterOptions -> Text -> Text
escapeText WriterOptions
opts (Text -> Text
trim Text
str)) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"`"
       else Doc Text
"``" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Text
trim Text
str) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"``"
inlineToRST (Str Text
str) = do
  WriterOptions
opts <- (WriterState -> WriterOptions)
-> StateT WriterState m WriterOptions
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> WriterOptions
stOptions
  Doc Text -> RST m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> RST m (Doc Text)) -> Doc Text -> RST m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> Text -> Doc Text
forall a b. (a -> b) -> a -> b
$
    (if Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_smart WriterOptions
opts
        then WriterOptions -> Text -> Text
unsmartify WriterOptions
opts
        else Text -> Text
forall a. a -> a
id) (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ WriterOptions -> Text -> Text
escapeText WriterOptions
opts Text
str
inlineToRST (Math MathType
t Text
str) = do
  (WriterState -> WriterState) -> StateT WriterState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState) -> StateT WriterState m ())
-> (WriterState -> WriterState) -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st{ stHasMath :: Bool
stHasMath = Bool
True }
  Doc Text -> RST m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> RST m (Doc Text)) -> Doc Text -> RST m (Doc Text)
forall a b. (a -> b) -> a -> b
$ if MathType
t MathType -> MathType -> Bool
forall a. Eq a => a -> a -> Bool
== MathType
InlineMath
              then Doc Text
":math:`" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
str Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"`"
              else if Char
'\n' Char -> Text -> Bool
`elemText` Text
str
                   then Doc Text
forall a. Doc a
blankline Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
".. math::" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
                        Doc Text
forall a. Doc a
blankline Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Int -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a
nest Int
3 (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
str) Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
forall a. Doc a
blankline
                   else Doc Text
forall a. Doc a
blankline Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ (Doc Text
".. math:: " Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
str) Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
forall a. Doc a
blankline
inlineToRST il :: Inline
il@(RawInline Format
f Text
x)
  | Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Format
"rst" = Doc Text -> RST m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> RST m (Doc Text)) -> Doc Text -> RST m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
x
  | Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Format
"latex" Bool -> Bool -> Bool
|| Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Format
"tex" = do
      (WriterState -> WriterState) -> StateT WriterState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState) -> StateT WriterState m ())
-> (WriterState -> WriterState) -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st{ stHasRawTeX :: Bool
stHasRawTeX = Bool
True }
      Doc Text -> RST m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> RST m (Doc Text)) -> Doc Text -> RST m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
":raw-latex:`" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
x Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"`"
  | Bool
otherwise  = Doc Text
forall a. Doc a
empty Doc Text -> StateT WriterState m () -> RST m (Doc Text)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ LogMessage -> StateT WriterState m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (Inline -> LogMessage
InlineNotRendered Inline
il)
inlineToRST Inline
LineBreak = Doc Text -> RST m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
cr -- there's no line break in RST (see Para)
inlineToRST Inline
Space = Doc Text -> RST m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
space
inlineToRST Inline
SoftBreak = do
  WrapOption
wrapText <- (WriterState -> WrapOption) -> StateT WriterState m WrapOption
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((WriterState -> WrapOption) -> StateT WriterState m WrapOption)
-> (WriterState -> WrapOption) -> StateT WriterState m WrapOption
forall a b. (a -> b) -> a -> b
$ WriterOptions -> WrapOption
writerWrapText (WriterOptions -> WrapOption)
-> (WriterState -> WriterOptions) -> WriterState -> WrapOption
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterState -> WriterOptions
stOptions
  case WrapOption
wrapText of
        WrapOption
WrapPreserve -> Doc Text -> RST m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
cr
        WrapOption
WrapAuto     -> Doc Text -> RST m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
space
        WrapOption
WrapNone     -> Doc Text -> RST m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
space
-- autolink
inlineToRST (Link Attr
_ [Str Text
str] (Text
src, Text
_))
  | Text -> Bool
isURI Text
src Bool -> Bool -> Bool
&&
    if Text
"mailto:" Text -> Text -> Bool
`T.isPrefixOf` Text
src
       then Text
src Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Text
escapeURI (Text
"mailto:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
str)
       else Text
src Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Text
escapeURI Text
str = do
  let srcSuffix :: Text
srcSuffix = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
src (Text -> Text -> Maybe Text
T.stripPrefix Text
"mailto:" Text
src)
  Doc Text -> RST m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> RST m (Doc Text)) -> Doc Text -> RST m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
srcSuffix
inlineToRST (Link Attr
_ [Image Attr
attr [Inline]
alt (Text
imgsrc,Text
imgtit)] (Text
src, Text
_tit)) = do
  Doc Text
label <- Attr -> [Inline] -> (Text, Text) -> Maybe Text -> RST m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Attr -> [Inline] -> (Text, Text) -> Maybe Text -> RST m (Doc Text)
registerImage Attr
attr [Inline]
alt (Text
imgsrc,Text
imgtit) (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
src)
  Doc Text -> RST m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> RST m (Doc Text)) -> Doc Text -> RST m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
"|" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
label Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"|"
inlineToRST (Link Attr
_ [Inline]
txt (Text
src, Text
tit)) = do
  Bool
useReferenceLinks <- (WriterState -> Bool) -> StateT WriterState m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((WriterState -> Bool) -> StateT WriterState m Bool)
-> (WriterState -> Bool) -> StateT WriterState m Bool
forall a b. (a -> b) -> a -> b
$ WriterOptions -> Bool
writerReferenceLinks (WriterOptions -> Bool)
-> (WriterState -> WriterOptions) -> WriterState -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterState -> WriterOptions
stOptions
  Doc Text
linktext <- [Inline] -> RST m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> RST m (Doc Text)
writeInlines ([Inline] -> RST m (Doc Text)) -> [Inline] -> RST m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Many Inline -> [Inline]
forall a. Many a -> [a]
B.toList (Many Inline -> [Inline])
-> ([Inline] -> Many Inline) -> [Inline] -> [Inline]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Many Inline -> Many Inline
B.trimInlines (Many Inline -> Many Inline)
-> ([Inline] -> Many Inline) -> [Inline] -> Many Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> Many Inline
forall a. [a] -> Many a
B.fromList ([Inline] -> [Inline]) -> [Inline] -> [Inline]
forall a b. (a -> b) -> a -> b
$ [Inline]
txt
  if Bool
useReferenceLinks
    then do Refs
refs <- (WriterState -> Refs) -> StateT WriterState m Refs
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Refs
stLinks
            case [Inline] -> Refs -> Maybe (Text, Text)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup [Inline]
txt Refs
refs of
                 Just (Text
src',Text
tit') ->
                   if Text
src Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
src' Bool -> Bool -> Bool
&& Text
tit Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
tit'
                      then Doc Text -> RST m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> RST m (Doc Text)) -> Doc Text -> RST m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
"`" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
linktext Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"`_"
                      else
                        Doc Text -> RST m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> RST m (Doc Text)) -> Doc Text -> RST m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
"`" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
linktext Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
" <" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
src Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
">`__"
                 Maybe (Text, Text)
Nothing -> do
                   (WriterState -> WriterState) -> StateT WriterState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState) -> StateT WriterState m ())
-> (WriterState -> WriterState) -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st { stLinks :: Refs
stLinks = ([Inline]
txt,(Text
src,Text
tit))([Inline], (Text, Text)) -> Refs -> Refs
forall a. a -> [a] -> [a]
:Refs
refs }
                   Doc Text -> RST m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> RST m (Doc Text)) -> Doc Text -> RST m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
"`" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
linktext Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"`_"
    else Doc Text -> RST m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> RST m (Doc Text)) -> Doc Text -> RST m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
"`" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
linktext Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
" <" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
src Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
">`__"
inlineToRST (Image Attr
attr [Inline]
alternate (Text
source, Text
tit)) = do
  Doc Text
label <- Attr -> [Inline] -> (Text, Text) -> Maybe Text -> RST m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Attr -> [Inline] -> (Text, Text) -> Maybe Text -> RST m (Doc Text)
registerImage Attr
attr [Inline]
alternate (Text
source,Text
tit) Maybe Text
forall a. Maybe a
Nothing
  Doc Text -> RST m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> RST m (Doc Text)) -> Doc Text -> RST m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
"|" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
label Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"|"
inlineToRST (Note [Block]
contents) = do
  -- add to notes in state
  [[Block]]
notes <- (WriterState -> [[Block]]) -> StateT WriterState m [[Block]]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> [[Block]]
stNotes
  (WriterState -> WriterState) -> StateT WriterState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState) -> StateT WriterState m ())
-> (WriterState -> WriterState) -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st { stNotes :: [[Block]]
stNotes = [Block]
contents[Block] -> [[Block]] -> [[Block]]
forall a. a -> [a] -> [a]
:[[Block]]
notes }
  let ref :: String
ref = Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ [[Block]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Block]]
notes Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
  Doc Text -> RST m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> RST m (Doc Text)) -> Doc Text -> RST m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
" [" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> String -> Doc Text
forall a. HasChars a => String -> Doc a
text String
ref Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"]_"

registerImage :: PandocMonad m => Attr -> [Inline] -> Target -> Maybe Text -> RST m (Doc Text)
registerImage :: Attr -> [Inline] -> (Text, Text) -> Maybe Text -> RST m (Doc Text)
registerImage Attr
attr [Inline]
alt (Text
src,Text
tit) Maybe Text
mbtarget = do
  [([Inline], (Attr, Text, Text, Maybe Text))]
pics <- (WriterState -> [([Inline], (Attr, Text, Text, Maybe Text))])
-> StateT
     WriterState m [([Inline], (Attr, Text, Text, Maybe Text))]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> [([Inline], (Attr, Text, Text, Maybe Text))]
stImages
  Int
imgId <- (WriterState -> Int) -> StateT WriterState m Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Int
stImageId
  let getImageName :: StateT WriterState m [Inline]
getImageName = do
        (WriterState -> WriterState) -> StateT WriterState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState) -> StateT WriterState m ())
-> (WriterState -> WriterState) -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st{ stImageId :: Int
stImageId = Int
imgId Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 }
        [Inline] -> StateT WriterState m [Inline]
forall (m :: * -> *) a. Monad m => a -> m a
return [Text -> Inline
Str (Text
"image" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
imgId)]
  [Inline]
txt <- case [Inline]
-> [([Inline], (Attr, Text, Text, Maybe Text))]
-> Maybe (Attr, Text, Text, Maybe Text)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup [Inline]
alt [([Inline], (Attr, Text, Text, Maybe Text))]
pics of
               Just (Attr
a,Text
s,Text
t,Maybe Text
mbt) ->
                 if (Attr
a,Text
s,Text
t,Maybe Text
mbt) (Attr, Text, Text, Maybe Text)
-> (Attr, Text, Text, Maybe Text) -> Bool
forall a. Eq a => a -> a -> Bool
== (Attr
attr,Text
src,Text
tit,Maybe Text
mbtarget)
                    then [Inline] -> StateT WriterState m [Inline]
forall (m :: * -> *) a. Monad m => a -> m a
return [Inline]
alt
                    else do
                        [Inline]
alt' <- StateT WriterState m [Inline]
getImageName
                        (WriterState -> WriterState) -> StateT WriterState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState) -> StateT WriterState m ())
-> (WriterState -> WriterState) -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st { stImages :: [([Inline], (Attr, Text, Text, Maybe Text))]
stImages =
                           ([Inline]
alt', (Attr
attr,Text
src,Text
tit, Maybe Text
mbtarget))([Inline], (Attr, Text, Text, Maybe Text))
-> [([Inline], (Attr, Text, Text, Maybe Text))]
-> [([Inline], (Attr, Text, Text, Maybe Text))]
forall a. a -> [a] -> [a]
:WriterState -> [([Inline], (Attr, Text, Text, Maybe Text))]
stImages WriterState
st }
                        [Inline] -> StateT WriterState m [Inline]
forall (m :: * -> *) a. Monad m => a -> m a
return [Inline]
alt'
               Maybe (Attr, Text, Text, Maybe Text)
Nothing -> do
                 [Inline]
alt' <- if [Inline] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
alt Bool -> Bool -> Bool
|| [Inline]
alt [Inline] -> [Inline] -> Bool
forall a. Eq a => a -> a -> Bool
== [Text -> Inline
Str Text
""]
                            then StateT WriterState m [Inline]
getImageName
                            else [Inline] -> StateT WriterState m [Inline]
forall (m :: * -> *) a. Monad m => a -> m a
return [Inline]
alt
                 (WriterState -> WriterState) -> StateT WriterState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState) -> StateT WriterState m ())
-> (WriterState -> WriterState) -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st { stImages :: [([Inline], (Attr, Text, Text, Maybe Text))]
stImages =
                        ([Inline]
alt', (Attr
attr,Text
src,Text
tit, Maybe Text
mbtarget))([Inline], (Attr, Text, Text, Maybe Text))
-> [([Inline], (Attr, Text, Text, Maybe Text))]
-> [([Inline], (Attr, Text, Text, Maybe Text))]
forall a. a -> [a] -> [a]
:WriterState -> [([Inline], (Attr, Text, Text, Maybe Text))]
stImages WriterState
st }
                 [Inline] -> StateT WriterState m [Inline]
forall (m :: * -> *) a. Monad m => a -> m a
return [Inline]
alt'
  [Inline] -> RST m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> RST m (Doc Text)
inlineListToRST [Inline]
txt

imageDimsToRST :: PandocMonad m => Attr -> RST m (Doc Text)
imageDimsToRST :: Attr -> RST m (Doc Text)
imageDimsToRST Attr
attr = do
  let (Text
ident, [Text]
_, [(Text, Text)]
_) = Attr
attr
      name :: Doc Text
name = if Text -> Bool
T.null Text
ident
                then Doc Text
forall a. Doc a
empty
                else Doc Text
":name: " Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
ident
      showDim :: Direction -> Doc a
showDim Direction
dir = let cols :: a -> Doc a
cols a
d = Doc a
":" Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> String -> Doc a
forall a. HasChars a => String -> Doc a
text (Direction -> String
forall a. Show a => a -> String
show Direction
dir) Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a
": " Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> String -> Doc a
forall a. HasChars a => String -> Doc a
text (a -> String
forall a. Show a => a -> String
show a
d)
                    in  case Direction -> Attr -> Maybe Dimension
dimension Direction
dir Attr
attr of
                          Just (Percent Double
a) ->
                            case Direction
dir of
                              Direction
Height -> Doc a
forall a. Doc a
empty
                              Direction
Width  -> Dimension -> Doc a
forall a a. (HasChars a, Show a) => a -> Doc a
cols (Double -> Dimension
Percent Double
a)
                          Just Dimension
dim -> Dimension -> Doc a
forall a a. (HasChars a, Show a) => a -> Doc a
cols Dimension
dim
                          Maybe Dimension
Nothing  -> Doc a
forall a. Doc a
empty
  Doc Text -> RST m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> RST m (Doc Text)) -> Doc Text -> RST m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
forall a. Doc a
cr Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
name Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Direction -> Doc Text
forall a. HasChars a => Direction -> Doc a
showDim Direction
Width Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Direction -> Doc Text
forall a. HasChars a => Direction -> Doc a
showDim Direction
Height

simpleTable :: PandocMonad m
            => WriterOptions
            -> (WriterOptions -> [Block] -> m (Doc Text))
            -> [[Block]]
            -> [[[Block]]]
            -> m (Doc Text)
simpleTable :: WriterOptions
-> (WriterOptions -> [Block] -> m (Doc Text))
-> [[Block]]
-> [[[Block]]]
-> m (Doc Text)
simpleTable WriterOptions
opts WriterOptions -> [Block] -> m (Doc Text)
blocksToDoc [[Block]]
headers [[[Block]]]
rows = do
  -- can't have empty cells in first column:
  let fixEmpties :: [Doc a] -> [Doc a]
fixEmpties (Doc a
d:[Doc a]
ds) = if Doc a -> Bool
forall a. Doc a -> Bool
isEmpty Doc a
d
                             then a -> Doc a
forall a. HasChars a => a -> Doc a
literal a
"\\ " Doc a -> [Doc a] -> [Doc a]
forall a. a -> [a] -> [a]
: [Doc a]
ds
                             else Doc a
d Doc a -> [Doc a] -> [Doc a]
forall a. a -> [a] -> [a]
: [Doc a]
ds
      fixEmpties [] = []
  [Doc Text]
headerDocs <- if ([Block] -> Bool) -> [[Block]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all [Block] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Block]]
headers
                   then [Doc Text] -> m [Doc Text]
forall (m :: * -> *) a. Monad m => a -> m a
return []
                   else [Doc Text] -> [Doc Text]
forall a. HasChars a => [Doc a] -> [Doc a]
fixEmpties ([Doc Text] -> [Doc Text]) -> m [Doc Text] -> m [Doc Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Block] -> m (Doc Text)) -> [[Block]] -> m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (WriterOptions -> [Block] -> m (Doc Text)
blocksToDoc WriterOptions
opts) [[Block]]
headers
  [[Doc Text]]
rowDocs <- ([[Block]] -> m [Doc Text]) -> [[[Block]]] -> m [[Doc Text]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (([Doc Text] -> [Doc Text]) -> m [Doc Text] -> m [Doc Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Doc Text] -> [Doc Text]
forall a. HasChars a => [Doc a] -> [Doc a]
fixEmpties (m [Doc Text] -> m [Doc Text])
-> ([[Block]] -> m [Doc Text]) -> [[Block]] -> m [Doc Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Block] -> m (Doc Text)) -> [[Block]] -> m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (WriterOptions -> [Block] -> m (Doc Text)
blocksToDoc WriterOptions
opts)) [[[Block]]]
rows
  let numChars :: [Doc Text] -> Int
numChars = Int -> (NonEmpty Int -> Int) -> Maybe (NonEmpty Int) -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 NonEmpty Int -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (Maybe (NonEmpty Int) -> Int)
-> ([Doc Text] -> Maybe (NonEmpty Int)) -> [Doc Text] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> Maybe (NonEmpty Int)
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty ([Int] -> Maybe (NonEmpty Int))
-> ([Doc Text] -> [Int]) -> [Doc Text] -> Maybe (NonEmpty Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Doc Text -> Int) -> [Doc Text] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Doc Text -> Int
forall a. (IsString a, HasChars a) => Doc a -> Int
offset
  let colWidths :: [Int]
colWidths = ([Doc Text] -> Int) -> [[Doc Text]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map [Doc Text] -> Int
numChars ([[Doc Text]] -> [Int]) -> [[Doc Text]] -> [Int]
forall a b. (a -> b) -> a -> b
$ [[Doc Text]] -> [[Doc Text]]
forall a. [[a]] -> [[a]]
transpose ([Doc Text]
headerDocs [Doc Text] -> [[Doc Text]] -> [[Doc Text]]
forall a. a -> [a] -> [a]
: [[Doc Text]]
rowDocs)
  let toRow :: [Doc Text] -> Doc Text
toRow = [Doc Text] -> Doc Text
forall a. Monoid a => [a] -> a
mconcat ([Doc Text] -> Doc Text)
-> ([Doc Text] -> [Doc Text]) -> [Doc Text] -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc Text -> [Doc Text] -> [Doc Text]
forall a. a -> [a] -> [a]
intersperse (Int -> Doc Text -> Doc Text
forall a. HasChars a => Int -> Doc a -> Doc a
lblock Int
1 Doc Text
" ") ([Doc Text] -> [Doc Text])
-> ([Doc Text] -> [Doc Text]) -> [Doc Text] -> [Doc Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Doc Text -> Doc Text) -> [Int] -> [Doc Text] -> [Doc Text]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> Doc Text -> Doc Text
forall a. HasChars a => Int -> Doc a -> Doc a
lblock [Int]
colWidths
  let hline :: Doc Text
hline = Doc Text -> Doc Text
forall a. IsString a => Doc a -> Doc a
nowrap (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
hsep ((Int -> Doc Text) -> [Int] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
n -> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Int -> Text -> Text
T.replicate Int
n Text
"=")) [Int]
colWidths)
  let hdr :: Doc Text
hdr = if ([Block] -> Bool) -> [[Block]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all [Block] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Block]]
headers
               then Doc Text
forall a. Monoid a => a
mempty
               else Doc Text
hline Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ [Doc Text] -> Doc Text
toRow [Doc Text]
headerDocs
  let bdy :: Doc Text
bdy = [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat ([Doc Text] -> Doc Text) -> [Doc Text] -> Doc Text
forall a b. (a -> b) -> a -> b
$ ([Doc Text] -> Doc Text) -> [[Doc Text]] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map [Doc Text] -> Doc Text
toRow [[Doc Text]]
rowDocs
  Doc Text -> m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> m (Doc Text)) -> Doc Text -> m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
hdr Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
hline Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
bdy Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
hline