{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns      #-}
{- |
   Module      : Text.Pandoc.Writers.RST
   Copyright   : Copyright (C) 2006-2023 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 ( StateT, gets, modify, evalStateT )
import Control.Monad (zipWithM, liftM)
import Data.Char (isSpace, generalCategory, isAscii, isAlphaNum,
                  GeneralCategory(
                        ClosePunctuation, OpenPunctuation, InitialQuote,
                         FinalQuote, DashPunctuation, OtherPunctuation))
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.URI
import Text.Pandoc.Templates (renderTemplate)
import Text.Pandoc.Writers.Shared
import Text.Pandoc.Walk
import Safe (lastMay, headMay)

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

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

type RST = StateT WriterState

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

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

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

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

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

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

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

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

-- | Escape special characters for RST.
escapeText :: WriterOptions -> Text -> Text
escapeText :: WriterOptions -> Text -> Text
escapeText WriterOptions
opts Text
t =
  if (Char -> Bool) -> Text -> Bool
T.any Char -> Bool
isSpecial Text
t
     then String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> String -> String
escapeString' Bool
True forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack forall a b. (a -> b) -> a -> b
$ Text
t
     else Text
t -- optimization
 where
  isSmart :: Bool
isSmart = forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_smart WriterOptions
opts
  isSpecial :: Char -> Bool
isSpecial Char
c = Char
c forall a. Eq a => a -> a -> Bool
== Char
'\\' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'_' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'`' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'*' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'|'
                Bool -> Bool -> Bool
|| (Bool
isSmart Bool -> Bool -> Bool
&& (Char
c forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'.' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'"' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'\''))
  canFollowInlineMarkup :: Char -> Bool
canFollowInlineMarkup Char
c = Char
c forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'.' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
',' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
':'
                    Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
';' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'!' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'?' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'\''
                    Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'"' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
')' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
']' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'}'
                    Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'>' Bool -> Bool -> Bool
|| Char -> Bool
isSpace Char
c
                    Bool -> Bool -> Bool
|| (Bool -> Bool
not (Char -> Bool
isAscii Char
c) Bool -> Bool -> Bool
&&
                        Char -> GeneralCategory
generalCategory Char
c forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem`
                        [GeneralCategory
OpenPunctuation, GeneralCategory
InitialQuote, GeneralCategory
FinalQuote,
                         GeneralCategory
DashPunctuation, GeneralCategory
OtherPunctuation])
  canPrecedeInlineMarkup :: Char -> Bool
canPrecedeInlineMarkup Char
c = Char
c forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
':' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'/' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'\''
                     Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'"' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'<' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'(' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'['
                     Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'{' Bool -> Bool -> Bool
|| Char -> Bool
isSpace Char
c
                     Bool -> Bool -> Bool
|| (Bool -> Bool
not (Char -> Bool
isAscii Char
c) Bool -> Bool -> Bool
&&
                          Char -> GeneralCategory
generalCategory Char
c forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem`
                          [GeneralCategory
ClosePunctuation, GeneralCategory
InitialQuote, GeneralCategory
FinalQuote,
                          GeneralCategory
DashPunctuation, GeneralCategory
OtherPunctuation])
  escapeString' :: Bool -> String -> String
escapeString' Bool
canStart String
cs =
    case String
cs of
      [] -> []
      Char
d:String
ds
        | Char
d forall a. Eq a => a -> a -> Bool
== Char
'\\'
        -> Char
'\\' forall a. a -> [a] -> [a]
: Char
d forall a. a -> [a] -> [a]
: Bool -> String -> String
escapeString' Bool
False String
ds
      Char
'\'':String
ds
        | Bool
isSmart
        -> Char
'\\' forall a. a -> [a] -> [a]
: Char
'\'' forall a. a -> [a] -> [a]
: Bool -> String -> String
escapeString' Bool
True String
ds
      Char
'"':String
ds
        | Bool
isSmart
        -> Char
'\\' forall a. a -> [a] -> [a]
: Char
'"' forall a. a -> [a] -> [a]
: Bool -> String -> String
escapeString' Bool
True String
ds
      Char
'-':Char
'-':String
ds
        | Bool
isSmart
        -> Char
'\\' forall a. a -> [a] -> [a]
: Char
'-' forall a. a -> [a] -> [a]
: Bool -> String -> String
escapeString' Bool
False (Char
'-'forall a. a -> [a] -> [a]
:String
ds)
      Char
'.':Char
'.':Char
'.':String
ds
        | Bool
isSmart
        -> Char
'\\' forall a. a -> [a] -> [a]
: Char
'.' forall a. a -> [a] -> [a]
: Bool -> String -> String
escapeString' Bool
False (Char
'.'forall a. a -> [a] -> [a]
:Char
'.'forall a. a -> [a] -> [a]
:String
ds)
      [Char
e]
        | Char
e forall a. Eq a => a -> a -> Bool
== Char
'*' Bool -> Bool -> Bool
|| Char
e forall a. Eq a => a -> a -> Bool
== Char
'_' Bool -> Bool -> Bool
|| Char
e forall a. Eq a => a -> a -> Bool
== Char
'|' Bool -> Bool -> Bool
|| Char
e forall a. Eq a => a -> a -> Bool
== Char
'`'
        -> [Char
'\\',Char
e]
      Char
d:String
ds
        | Char -> Bool
canPrecedeInlineMarkup Char
d
        -> Char
d forall a. a -> [a] -> [a]
: Bool -> String -> String
escapeString' Bool
True String
ds
      Char
e:Char
d:String
ds
        | Char
e forall a. Eq a => a -> a -> Bool
== Char
'*' Bool -> Bool -> Bool
|| Char
e forall a. Eq a => a -> a -> Bool
== Char
'_' Bool -> Bool -> Bool
|| Char
e forall a. Eq a => a -> a -> Bool
== Char
'|' Bool -> Bool -> Bool
|| Char
e forall a. Eq a => a -> a -> Bool
== Char
'`'
        , (Bool -> Bool
not Bool
canStart Bool -> Bool -> Bool
&& Char -> Bool
canFollowInlineMarkup Char
d)
          Bool -> Bool -> Bool
|| (Bool
canStart Bool -> Bool -> Bool
&& Bool -> Bool
not (Char -> Bool
isSpace Char
d))
        -> Char
'\\' forall a. a -> [a] -> [a]
: Char
e forall a. a -> [a] -> [a]
: Bool -> String -> String
escapeString' Bool
False (Char
dforall a. a -> [a] -> [a]
:String
ds)
      Char
'_':Char
d:String
ds
        | Bool -> Bool
not (Char -> Bool
isAlphaNum Char
d)
        -> Char
'\\' forall a. a -> [a] -> [a]
: Char
'_' forall a. a -> [a] -> [a]
: Bool -> String -> String
escapeString' Bool
False (Char
dforall a. a -> [a] -> [a]
:String
ds)
      Char
d:String
ds -> Char
d forall a. a -> [a] -> [a]
: Bool -> String -> String
escapeString' Bool
False String
ds

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

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

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

blockToRST (Figure (Text
ident, [Text]
classes, [(Text, Text)]
_kvs)
             (Caption Maybe [Inline]
_ [Block]
longCapt) [Block]
body) = do
  let figure :: Attr -> [Inline] -> (Text, Text) -> StateT WriterState m (Doc Text)
figure Attr
attr [Inline]
txt (Text
src, Text
tit) = do
        Doc Text
description <- forall (m :: * -> *). PandocMonad m => [Inline] -> RST m (Doc Text)
inlineListToRST [Inline]
txt
        Doc Text
capt <- forall (m :: * -> *). PandocMonad m => [Block] -> RST m (Doc Text)
blockListToRST [Block]
longCapt
        Doc Text
dims <- forall (m :: * -> *). PandocMonad m => Attr -> RST m (Doc Text)
imageDimsToRST Attr
attr
        let fig :: Doc Text
fig = Doc Text
"figure::" forall a. Doc a -> Doc a -> Doc a
<+> forall a. HasChars a => a -> Doc a
literal Text
src
            alt :: Doc Text
alt = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
txt
                     then if Text -> Bool
T.null Text
tit
                              then forall a. Doc a
empty
                              else Doc Text
":alt:" forall a. Doc a -> Doc a -> Doc a
<+> forall a. HasChars a => a -> Doc a
literal Text
tit
                     else Doc Text
":alt:" forall a. Doc a -> Doc a -> Doc a
<+> Doc Text
description
            name :: Doc Text
name = if Text -> Bool
T.null Text
ident
                      then forall a. Doc a
empty
                      else Doc Text
"name:" forall a. Doc a -> Doc a -> Doc a
<+> forall a. HasChars a => a -> Doc a
literal Text
ident
            (Text
_,[Text]
cls,[(Text, Text)]
_) = Attr
attr
            align :: Doc Text
align = case [Text]
cls of
                      []               -> forall a. Doc a
empty
                      [Text
"align-right"]  -> Doc Text
":align: right"
                      [Text
"align-left"]   -> Doc Text
":align: left"
                      [Text
"align-center"] -> Doc Text
":align: center"
                      [Text]
_ -> Doc Text
":figclass: " forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal ([Text] -> Text
T.unwords [Text]
cls)
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. IsString a => Int -> Doc a -> Doc a -> Doc a
hang Int
3 Doc Text
".. " (Doc Text
fig forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
name forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
alt forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
align forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
dims forall a. Doc a -> Doc a -> Doc a
$+$ Doc Text
capt)
              forall a. Doc a -> Doc a -> Doc a
$$ forall a. Doc a
blankline
  case [Block]
body of
    [Para  [Image Attr
attr [Inline]
txt (Text, Text)
tgt]] -> forall {m :: * -> *}.
PandocMonad m =>
Attr -> [Inline] -> (Text, Text) -> StateT WriterState m (Doc Text)
figure Attr
attr [Inline]
txt (Text, Text)
tgt
    [Plain [Image Attr
attr [Inline]
txt (Text, Text)
tgt]] -> forall {m :: * -> *}.
PandocMonad m =>
Attr -> [Inline] -> (Text, Text) -> StateT WriterState m (Doc Text)
figure Attr
attr [Inline]
txt (Text, Text)
tgt
    [Block]
_ -> do
      Doc Text
content <- forall (m :: * -> *). PandocMonad m => [Block] -> RST m (Doc Text)
blockListToRST [Block]
body
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Doc a
blankline forall a. Doc a -> Doc a -> Doc a
$$ (
        Doc Text
".. container:: float" forall a. Semigroup a => a -> a -> a
<> forall a. Doc a
space forall a. Semigroup a => a -> a -> a
<>
        forall a. HasChars a => a -> Doc a
literal ([Text] -> Text
T.unwords (forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/= Text
"container") [Text]
classes))) forall a. Doc a -> Doc a -> Doc a
$$
        (if Text -> Bool
T.null Text
ident
         then forall a. Doc a
blankline
         else Doc Text
"   :name: " forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal Text
ident forall a. Doc a -> Doc a -> Doc a
$$ forall a. Doc a
blankline) forall a. Doc a -> Doc a -> Doc a
$$
        forall a. IsString a => Int -> Doc a -> Doc a
nest Int
3 Doc Text
content forall a. Doc a -> Doc a -> Doc a
$$
        forall a. Doc a
blankline

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

-- | 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 :: forall (m :: * -> *).
PandocMonad m =>
Text -> [Block] -> RST m (Doc Text)
orderedListItemToRST Text
marker [Block]
items = do
  Doc Text
contents <- forall (m :: * -> *). PandocMonad m => [Block] -> RST m (Doc Text)
blockListToRST [Block]
items
  let marker' :: Text
marker' = Text
marker forall a. Semigroup a => a -> a -> a
<> Text
" "
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. IsString a => Int -> Doc a -> Doc a -> Doc a
hang (Text -> Int
T.length Text
marker') (forall a. HasChars a => a -> Doc a
literal Text
marker') Doc Text
contents forall a. Doc a -> Doc a -> Doc a
$$
      if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Block]
items Bool -> Bool -> Bool
|| ([Block] -> Bool
endsWithPlain [Block]
items Bool -> Bool -> Bool
&& Bool -> Bool
not ([Block] -> Bool
endsWithList [Block]
items))
         then forall a. Doc a
cr
         else forall a. Doc a
blankline

endsWithList :: [Block] -> Bool
endsWithList :: [Block] -> Bool
endsWithList [Block]
bs = case forall a. [a] -> Maybe a
lastMay [Block]
bs of
                    Just (BulletList{}) -> Bool
True
                    Just (OrderedList{}) -> Bool
True
                    Maybe Block
_ -> Bool
False

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

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

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

blockListToRST :: PandocMonad m
               => [Block]       -- ^ List of block elements
               -> RST m (Doc Text)
blockListToRST :: forall (m :: * -> *). PandocMonad m => [Block] -> RST m (Doc Text)
blockListToRST = forall (m :: * -> *).
PandocMonad m =>
Bool -> [Block] -> RST m (Doc Text)
blockListToRST' Bool
False

{-

http://docutils.sourceforge.net/docs/ref/rst/restructuredtext.html#directives

According to the terminology used in the spec, a marker includes a
final whitespace and a block includes the directive arguments. Here
the variable names have slightly different meanings because we don't
want to finish the line with a space if there are no arguments, it
would produce rST that differs from what users expect in a way that's
not easy to detect

-}
toRSTDirective :: Doc Text -> Doc Text -> [(Doc Text, Doc Text)] -> Doc Text -> Doc Text
toRSTDirective :: Doc Text
-> Doc Text -> [(Doc Text, Doc Text)] -> Doc Text -> Doc Text
toRSTDirective Doc Text
typ Doc Text
args [(Doc Text, Doc Text)]
options Doc Text
content = Doc Text
marker forall a. Semigroup a => a -> a -> a
<> Doc Text
spaceArgs forall a. Semigroup a => a -> a -> a
<> forall a. Doc a
cr forall a. Semigroup a => a -> a -> a
<> Doc Text
block
  where marker :: Doc Text
marker = Doc Text
".. " forall a. Semigroup a => a -> a -> a
<> Doc Text
typ forall a. Semigroup a => a -> a -> a
<> Doc Text
"::"
        block :: Doc Text
block = forall a. IsString a => Int -> Doc a -> Doc a
nest Int
3 (Doc Text
fieldList forall a. Doc a -> Doc a -> Doc a
$$
                        forall a. Doc a
blankline forall a. Doc a -> Doc a -> Doc a
$$
                        Doc Text
content forall a. Doc a -> Doc a -> Doc a
$$
                        forall a. Doc a
blankline)
        spaceArgs :: Doc Text
spaceArgs = if forall a. Doc a -> Bool
isEmpty Doc Text
args then Doc Text
"" else Doc Text
" " forall a. Semigroup a => a -> a -> a
<> Doc Text
args
        -- a field list could end up being an empty doc thus being
        -- omitted by $$
        fieldList :: Doc Text
fieldList = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl forall a. Doc a -> Doc a -> Doc a
($$) Doc Text
"" forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall {a}. (Semigroup a, IsString a) => (a, a) -> a
joinField [(Doc Text, Doc Text)]
options
        -- a field body can contain multiple lines
        joinField :: (a, a) -> a
joinField (a
name, a
body) = a
":" forall a. Semigroup a => a -> a -> a
<> a
name forall a. Semigroup a => a -> a -> a
<> a
": " forall a. Semigroup a => a -> a -> a
<> a
body

tableToRSTList :: PandocMonad m
             => [Inline]
             -> [Alignment]
             -> [Double]
             -> [[Block]]
             -> [[[Block]]]
             -> RST m (Doc Text)
tableToRSTList :: forall (m :: * -> *).
PandocMonad m =>
[Inline]
-> [Alignment]
-> [Double]
-> [[Block]]
-> [[[Block]]]
-> RST m (Doc Text)
tableToRSTList [Inline]
caption [Alignment]
_ [Double]
propWidths [[Block]]
headers [[[Block]]]
rows = do
  Doc Text
captionRST <- forall (m :: * -> *). PandocMonad m => [Inline] -> RST m (Doc Text)
inlineListToRST [Inline]
caption
  WriterOptions
opts       <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> WriterOptions
stOptions
  Doc Text
content    <- forall (m :: * -> *).
PandocMonad m =>
[[[Block]]] -> RST m (Doc Text)
listTableContent [[[Block]]]
toWrite
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Doc Text
-> Doc Text -> [(Doc Text, Doc Text)] -> Doc Text -> Doc Text
toRSTDirective Doc Text
"list-table" Doc Text
captionRST (WriterOptions -> [(Doc Text, Doc Text)]
directiveOptions WriterOptions
opts) Doc Text
content
  where directiveOptions :: WriterOptions -> [(Doc Text, Doc Text)]
directiveOptions WriterOptions
opts = forall {a}. IsString a => Int -> [Double] -> [(a, Doc Text)]
widths (WriterOptions -> Int
writerColumns WriterOptions
opts) [Double]
propWidths forall a. Semigroup a => a -> a -> a
<>
                                [(Doc Text, Doc Text)]
headerRows
        toWrite :: [[[Block]]]
toWrite = if Bool
noHeaders then [[[Block]]]
rows else [[Block]]
headersforall a. a -> [a] -> [a]
:[[[Block]]]
rows
        headerRows :: [(Doc Text, Doc Text)]
headerRows = [(Doc Text
"header-rows", forall a. HasChars a => String -> Doc a
text forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show (Int
1 :: Int)) | Bool -> Bool
not Bool
noHeaders]
        widths :: Int -> [Double] -> [(a, Doc Text)]
widths Int
tot [Double]
pro = [(a
"widths", Int -> [Double] -> Doc Text
showWidths Int
tot [Double]
pro) |
                          Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Double]
propWidths Bool -> Bool -> Bool
|| forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall a. Eq a => a -> a -> Bool
==Double
0.0) [Double]
propWidths)]
        noHeaders :: Bool
noHeaders = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Block]]
headers
        -- >>> showWidths 70 [0.5, 0.5]
        -- "35 35"
        showWidths :: Int -> [Double] -> Doc Text
        showWidths :: Int -> [Double] -> Doc Text
showWidths Int
tot = forall a. HasChars a => String -> Doc a
text forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unwords forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Double -> Int
toColumns Int
tot)
        -- toColumns converts a width expressed as a proportion of the
        -- total into a width expressed as a number of columns
        toColumns :: Int -> Double -> Int
        toColumns :: Int -> Double -> Int
toColumns Int
t Double
p = forall a b. (RealFrac a, Integral b) => a -> b
round (Double
p forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
t)
        listTableContent :: PandocMonad m => [[[Block]]] -> RST m (Doc Text)
        listTableContent :: forall (m :: * -> *).
PandocMonad m =>
[[[Block]]] -> RST m (Doc Text)
listTableContent = forall a. ([a] -> a) -> ([a] -> a) -> [[a]] -> a
joinTable forall (m :: * -> *).
PandocMonad m =>
[RST m (Doc Text)] -> RST m (Doc Text)
joinDocsM forall (m :: * -> *).
PandocMonad m =>
[RST m (Doc Text)] -> RST m (Doc Text)
joinDocsM forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                           forall a b. (a -> b) -> [[a]] -> [[b]]
mapTable forall (m :: * -> *). PandocMonad m => [Block] -> RST m (Doc Text)
blockListToRST
        -- joinDocsM adapts joinDocs in order to work in the `RST m` monad
        joinDocsM :: PandocMonad m => [RST m (Doc Text)] -> RST m (Doc Text)
        joinDocsM :: forall (m :: * -> *).
PandocMonad m =>
[RST m (Doc Text)] -> RST m (Doc Text)
joinDocsM = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Doc Text] -> Doc Text
joinDocs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
        -- joinDocs will be used to join cells and to join rows
        joinDocs :: [Doc Text] -> Doc Text
        joinDocs :: [Doc Text] -> Doc Text
joinDocs [Doc Text]
items = forall a. Doc a
blankline forall a. Doc a -> Doc a -> Doc a
$$
                         (forall a. Doc a -> Doc a
chomp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Doc a] -> Doc a
vcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Doc Text -> Doc Text
formatItem) [Doc Text]
items forall a. Doc a -> Doc a -> Doc a
$$
                         forall a. Doc a
blankline
        formatItem :: Doc Text -> Doc Text
        formatItem :: Doc Text -> Doc Text
formatItem Doc Text
i = forall a. IsString a => Int -> Doc a -> Doc a -> Doc a
hang Int
3 Doc Text
"- " (Doc Text
i forall a. Semigroup a => a -> a -> a
<> forall a. Doc a
cr)
        -- apply a function to all table cells changing their type
        mapTable :: (a -> b) -> [[a]] -> [[b]]
        mapTable :: forall a b. (a -> b) -> [[a]] -> [[b]]
mapTable = forall a b. (a -> b) -> [a] -> [b]
map forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map
        -- function hor to join cells and function ver to join rows
        joinTable :: ([a] -> a) -> ([a] -> a) -> [[a]] -> a
        joinTable :: forall a. ([a] -> a) -> ([a] -> a) -> [[a]] -> a
joinTable [a] -> a
hor [a] -> a
ver = [a] -> a
ver forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map [a] -> a
hor

transformInlines :: [Inline] -> [Inline]
transformInlines :: [Inline] -> [Inline]
transformInlines =  [Inline] -> [Inline]
insertBS forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    forall a. (a -> Bool) -> [a] -> [a]
filter Inline -> Bool
hasContents forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    [Inline] -> [Inline]
removeSpaceAfterDisplayMath forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([Inline] -> [Inline]
transformNested forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inline -> [Inline]
flatten)
  where -- 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 forall a. a -> [a] -> [a]
: forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Eq a => a -> a -> Bool
==Inline
Space) [Inline]
zs
        removeSpaceAfterDisplayMath (Inline
x:[Inline]
xs) = Inline
x forall a. a -> [a] -> [a]
: [Inline] -> [Inline]
removeSpaceAfterDisplayMath [Inline]
xs
        removeSpaceAfterDisplayMath [] = []
        insertBS :: [Inline] -> [Inline] -- 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 forall a. a -> [a] -> [a]
: Inline
y forall a. a -> [a] -> [a]
: [Inline] -> [Inline]
insertBS (Inline
z forall a. a -> [a] -> [a]
: [Inline]
zs)
        insertBS (Inline
x:Inline
y:[Inline]
zs)
          | Inline -> Bool
isComplex Inline
x Bool -> Bool -> Bool
&& Bool -> Bool
not (Inline -> Bool
okAfterComplex Inline
y) =
              Inline
x forall a. a -> [a] -> [a]
: Format -> Text -> Inline
RawInline Format
"rst" Text
"\\ " forall a. a -> [a] -> [a]
: [Inline] -> [Inline]
insertBS (Inline
y forall a. a -> [a] -> [a]
: [Inline]
zs)
          | Inline -> Bool
isComplex Inline
y Bool -> Bool -> Bool
&& Bool -> Bool
not (Inline -> Bool
okBeforeComplex Inline
x) =
              Inline
x forall a. a -> [a] -> [a]
: Format -> Text -> Inline
RawInline Format
"rst" Text
"\\ " forall a. a -> [a] -> [a]
: [Inline] -> [Inline]
insertBS (Inline
y forall a. a -> [a] -> [a]
: [Inline]
zs)
          | Bool
otherwise =
              Inline
x forall a. a -> [a] -> [a]
: [Inline] -> [Inline]
insertBS (Inline
y forall a. a -> [a] -> [a]
: [Inline]
zs)
        insertBS (Inline
x:[Inline]
ys) = Inline
x forall a. a -> [a] -> [a]
: [Inline] -> [Inline]
insertBS [Inline]
ys
        insertBS [] = []
        transformNested :: [Inline] -> [Inline]
        transformNested :: [Inline] -> [Inline]
transformNested = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Inline -> [Inline]
exportLeadingTrailingSpace
        exportLeadingTrailingSpace :: Inline -> [Inline]
        exportLeadingTrailingSpace :: Inline -> [Inline]
exportLeadingTrailingSpace Inline
il
          | Inline -> Bool
isComplex Inline
il =
             let contents :: [Inline]
contents = Inline -> [Inline]
dropInlineParent Inline
il
                 headSpace :: Bool
headSpace = forall a. [a] -> Maybe a
headMay [Inline]
contents forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Inline
Space
                 lastSpace :: Bool
lastSpace = forall a. [a] -> Maybe a
lastMay [Inline]
contents forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Inline
Space
              in (if Bool
headSpace then (Inline
Spaceforall a. a -> [a] -> [a]
:) else forall a. a -> a
id) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                 (if Bool
lastSpace then (forall a. [a] -> [a] -> [a]
++ [Inline
Space]) else forall a. a -> a
id) forall a b. (a -> b) -> a -> b
$
                 [Inline -> [Inline] -> Inline
setInlineChildren Inline
il ([Inline] -> [Inline]
stripLeadingTrailingSpace [Inline]
contents)]
          | Bool
otherwise = [Inline
il]

        surroundComplex :: Inline -> Inline -> Bool
        surroundComplex :: Inline -> Inline -> Bool
surroundComplex (Str Text
s) (Str Text
s')
          | Just (Text
_, Char
c)  <- Text -> Maybe (Text, Char)
T.unsnoc Text
s
          , Just (Char
c', Text
_) <- Text -> Maybe (Char, Text)
T.uncons Text
s'
          = case (Char
c, Char
c') of
              (Char
'\'',Char
'\'') -> Bool
True
              (Char
'"',Char
'"')   -> Bool
True
              (Char
'<',Char
'>')   -> Bool
True
              (Char
'[',Char
']')   -> Bool
True
              (Char
'{',Char
'}')   -> Bool
True
              (Char, Char)
_           -> Bool
False
        surroundComplex Inline
_ Inline
_ = Bool
False
        okAfterComplex :: Inline -> Bool
        okAfterComplex :: Inline -> Bool
okAfterComplex Inline
Space = Bool
True
        okAfterComplex Inline
SoftBreak = Bool
True
        okAfterComplex Inline
LineBreak = Bool
True
        okAfterComplex (Str (Text -> Maybe (Char, Text)
T.uncons -> Just (Char
c,Text
_)))
          = Char -> Bool
isSpace Char
c Bool -> Bool -> Bool
|| (Char -> Bool) -> Text -> Bool
T.any (forall a. Eq a => a -> a -> Bool
== Char
c) 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 -> Bool) -> Text -> Bool
T.any (forall a. Eq a => a -> a -> Bool
== Char
c) 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
  | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
contents = [Inline
outer]
  | Bool
otherwise     = [Inline] -> [Inline]
combineAll [Inline]
contents
  where contents :: [Inline]
contents = Inline -> [Inline]
dropInlineParent Inline
outer
        combineAll :: [Inline] -> [Inline]
combineAll = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' [Inline] -> Inline -> [Inline]
combine []

        combine :: [Inline] -> Inline -> [Inline]
        combine :: [Inline] -> Inline -> [Inline]
combine [Inline]
f Inline
i =
          case (Inline
outer, Inline
i) of
          -- 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{})              -> forall {a}. [a] -> a -> [a]
emerge [Inline]
f Inline
i
          -- always give priority to strong text over emphasis
          (Emph [Inline]
_, Strong [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 forall a. Semigroup a => a -> a -> a
<> [a
i]
        keep :: [Inline] -> Inline -> [Inline]
keep [Inline]
f Inline
i = [Inline] -> [Inline] -> [Inline]
appendToLast [Inline]
f [Inline
i]
        collapse :: [Inline] -> Inline -> [Inline]
collapse [Inline]
f Inline
i = [Inline] -> [Inline] -> [Inline]
appendToLast [Inline]
f forall a b. (a -> b) -> a -> b
$ Inline -> [Inline]
dropInlineParent Inline
i

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

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

dropInlineParent :: Inline -> [Inline]
dropInlineParent :: Inline -> [Inline]
dropInlineParent (Link Attr
_ [Inline]
i (Text, Text)
_)    = [Inline]
i
dropInlineParent (Emph [Inline]
i)        = [Inline]
i
dropInlineParent (Underline [Inline]
i)   = [Inline]
i
dropInlineParent (Strong [Inline]
i)      = [Inline]
i
dropInlineParent (Strikeout [Inline]
i)   = [Inline]
i
dropInlineParent (Superscript [Inline]
i) = [Inline]
i
dropInlineParent (Subscript [Inline]
i)   = [Inline]
i
dropInlineParent (SmallCaps [Inline]
i)   = [Inline]
i
dropInlineParent (Cite [Citation]
_ [Inline]
i)      = [Inline]
i
dropInlineParent (Image Attr
_ [Inline]
i (Text, Text)
_)   = [Inline]
i
dropInlineParent (Span Attr
_ [Inline]
i)      = [Inline]
i
dropInlineParent (Quoted QuoteType
_ [Inline]
i)    = [Inline]
i
dropInlineParent Inline
i               = [Inline
i] -- 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 :: forall (m :: * -> *). PandocMonad m => [Inline] -> RST m (Doc Text)
inlineListToRST = forall (m :: * -> *). PandocMonad m => [Inline] -> RST m (Doc Text)
writeInlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Walkable a b => (a -> a) -> b -> b
walk [Inline] -> [Inline]
transformInlines

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

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

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

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

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