{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns      #-}
{- |
   Module      : Text.Pandoc.Writers.RST
   Copyright   : Copyright (C) 2006-2024 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 }
  StateT WriterState m Text -> WriterState -> m Text
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (Pandoc -> StateT WriterState m Text
forall (m :: * -> *). PandocMonad m => Pandoc -> RST m Text
pandocToRST Pandoc
document) WriterState
st

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

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

-- | Return RST representation of a reference key.
keyToRST :: PandocMonad m => ([Inline], (Text, Text)) -> RST m (Doc Text)
keyToRST :: forall (m :: * -> *).
PandocMonad m =>
([Inline], (Text, Text)) -> RST m (Doc Text)
keyToRST ([Inline]
label, (Text
src, Text
_)) = do
  label' <- [Inline] -> RST m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> RST m (Doc Text)
inlineListToRST [Inline]
label
  let label'' = if (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
':') (Char -> Bool) -> Text -> Bool
`T.any` (Maybe Int -> Doc Text -> Text
forall a. HasChars a => Maybe Int -> Doc a -> a
render Maybe Int
forall a. Maybe a
Nothing Doc Text
label' :: Text)
                   then Char -> Doc Text
forall a. HasChars a => Char -> Doc a
char Char
'`' Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
label' Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Char -> Doc Text
forall a. HasChars a => Char -> Doc a
char Char
'`'
                   else Doc Text
label'
  return $ nowrap $ ".. _" <> label'' <> ": " <> literal 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 =
   [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vsep ([Doc Text] -> Doc Text)
-> StateT WriterState m [Doc Text]
-> StateT WriterState m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> [Block] -> StateT WriterState m (Doc Text))
-> [Int] -> [[Block]] -> StateT WriterState m [Doc Text]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM Int -> [Block] -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Int -> [Block] -> RST m (Doc Text)
noteToRST [Int
1..] [[Block]]
notes

-- | Return RST representation of a note.
noteToRST :: PandocMonad m => Int -> [Block] -> RST m (Doc Text)
noteToRST :: forall (m :: * -> *).
PandocMonad m =>
Int -> [Block] -> RST m (Doc Text)
noteToRST Int
num [Block]
note = do
  contents <- [Block] -> RST m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> RST m (Doc Text)
blockListToRST [Block]
note
  let marker = Doc Text
".. [" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> String -> Doc Text
forall a. HasChars a => String -> Doc a
text (Int -> String
forall a. Show a => a -> String
show Int
num) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"]"
  return $ nowrap $ marker $$ nest 3 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 =
   [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat ([Doc Text] -> Doc Text)
-> StateT WriterState m [Doc Text]
-> StateT WriterState m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (([Inline], (Attr, Text, Text, Maybe Text))
 -> StateT WriterState m (Doc Text))
-> [([Inline], (Attr, Text, Text, Maybe Text))]
-> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ([Inline], (Attr, Text, Text, Maybe Text))
-> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
([Inline], (Attr, Text, Text, Maybe Text)) -> RST m (Doc Text)
pictToRST [([Inline], (Attr, Text, Text, Maybe Text))]
refs

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

-- | Escape special characters for RST.
escapeText :: WriterOptions -> Text -> Text
escapeText :: WriterOptions -> Text -> Text
escapeText WriterOptions
opts Text
t =
  if (Char -> Bool) -> Text -> Bool
T.any Char -> Bool
isSpecial Text
t
     then String -> Text
T.pack (String -> Text) -> (Text -> String) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> String -> String
escapeString' Bool
True (String -> String) -> (Text -> String) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text
t
     else Text
t -- optimization
 where
  isSmart :: Bool
isSmart = Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_smart WriterOptions
opts
  isSpecial :: Char -> Bool
isSpecial Char
c = Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\\' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'`' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'*' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'|'
                Bool -> Bool -> Bool
|| (Bool
isSmart Bool -> Bool -> Bool
&& (Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'"' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\''))
  canFollowInlineMarkup :: Char -> Bool
canFollowInlineMarkup Char
c = Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
',' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':'
                    Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
';' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'!' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'?' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\''
                    Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'"' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
')' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
']' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'}'
                    Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
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 GeneralCategory -> [GeneralCategory] -> Bool
forall a. Eq a => a -> [a] -> Bool
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 Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\''
                     Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'"' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'<' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'(' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'['
                     Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
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 GeneralCategory -> [GeneralCategory] -> Bool
forall a. Eq a => a -> [a] -> Bool
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 Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\\'
        -> Char
'\\' Char -> String -> String
forall a. a -> [a] -> [a]
: Char
d Char -> String -> String
forall a. a -> [a] -> [a]
: Bool -> String -> String
escapeString' Bool
False String
ds
      Char
'\'':String
ds
        | Bool
isSmart
        -> Char
'\\' Char -> String -> String
forall a. a -> [a] -> [a]
: Char
'\'' Char -> String -> String
forall a. a -> [a] -> [a]
: Bool -> String -> String
escapeString' Bool
True String
ds
      Char
'"':String
ds
        | Bool
isSmart
        -> Char
'\\' Char -> String -> String
forall a. a -> [a] -> [a]
: Char
'"' Char -> String -> String
forall a. a -> [a] -> [a]
: Bool -> String -> String
escapeString' Bool
True String
ds
      Char
'-':Char
'-':String
ds
        | Bool
isSmart
        -> Char
'\\' Char -> String -> String
forall a. a -> [a] -> [a]
: Char
'-' Char -> String -> String
forall a. a -> [a] -> [a]
: Bool -> String -> String
escapeString' Bool
False (Char
'-'Char -> String -> String
forall a. a -> [a] -> [a]
:String
ds)
      Char
'.':Char
'.':Char
'.':String
ds
        | Bool
isSmart
        -> Char
'\\' Char -> String -> String
forall a. a -> [a] -> [a]
: Char
'.' Char -> String -> String
forall a. a -> [a] -> [a]
: Bool -> String -> String
escapeString' Bool
False (Char
'.'Char -> String -> String
forall a. a -> [a] -> [a]
:Char
'.'Char -> String -> String
forall a. a -> [a] -> [a]
:String
ds)
      [Char
e]
        | Char
e Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'*' Bool -> Bool -> Bool
|| Char
e Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_' Bool -> Bool -> Bool
|| Char
e Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'|' Bool -> Bool -> Bool
|| Char
e Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'`'
        -> [Char
'\\',Char
e]
      Char
d:String
ds
        | Char -> Bool
canPrecedeInlineMarkup Char
d
        -> Char
d Char -> String -> String
forall a. a -> [a] -> [a]
: Bool -> String -> String
escapeString' Bool
True String
ds
      Char
e:Char
d:String
ds
        | Char
e Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'*' Bool -> Bool -> Bool
|| Char
e Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_' Bool -> Bool -> Bool
|| Char
e Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'|' Bool -> Bool -> Bool
|| Char
e Char -> Char -> Bool
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
'\\' Char -> String -> String
forall a. a -> [a] -> [a]
: Char
e Char -> String -> String
forall a. a -> [a] -> [a]
: Bool -> String -> String
escapeString' Bool
False (Char
dChar -> String -> String
forall a. a -> [a] -> [a]
:String
ds)
      Char
'_':Char
d:String
ds
        | Bool -> Bool
not (Char -> Bool
isAlphaNum Char
d)
        -> Char
'\\' Char -> String -> String
forall a. a -> [a] -> [a]
: Char
'_' Char -> String -> String
forall a. a -> [a] -> [a]
: Bool -> String -> String
escapeString' Bool
False (Char
dChar -> String -> String
forall a. a -> [a] -> [a]
:String
ds)
      Char
d:String
ds -> Char
d Char -> String -> String
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]
_ = Doc Text -> StateT WriterState m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
titleToRST [Inline]
tit [Inline]
subtit = do
  title <- [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> RST m (Doc Text)
inlineListToRST [Inline]
tit
  subtitle <- inlineListToRST subtit
  return $ bordered title '=' $$ bordered subtitle '-'

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

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

endsWithList :: [Block] -> Bool
endsWithList :: [Block] -> Bool
endsWithList [Block]
bs = case [Block] -> Maybe Block
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
  label' <- [Inline] -> RST m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> RST m (Doc Text)
inlineListToRST [Inline]
label
  contents <- liftM vcat $ mapM blockListToRST defs
  -- if definition list starts with block quote, we need to insert
  -- an empty comment to fix the indentation point (#10236)
  let contents' = case [[Block]]
defs of
                    (BlockQuote{}:[Block]
_):[[Block]]
_ -> Doc Text
".." Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$+$ Doc Text
contents
                    [[Block]]
_ -> Doc Text
contents
  return $ nowrap label' $$ nest 3 (nestle contents') $$
      if isTightList defs
         then cr
         else 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
  lns <- ([Inline] -> StateT WriterState m (Doc Text))
-> [[Inline]] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> RST m (Doc Text)
inlineListToRST [[Inline]]
inlineLines
  return $
                      vcat (map (hang 2 (literal "| ")) lns) <> 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 Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: Block
commentSep Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: Block
b2 Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block] -> [Block]
fixBlocks [Block]
bs
        where
          toClose :: Block -> Bool
toClose Plain{}                  = Bool
False
          toClose Header{}                 = Bool
False
          toClose LineBlock{}              = Bool
False
          toClose Block
HorizontalRule           = Bool
False
          toClose SimpleFigure{}           = Bool
True
          toClose Para{}                   = Bool
False
          toClose Block
_                        = Bool
True
          commentSep :: Block
commentSep  = Format -> Text -> Block
RawBlock Format
"rst" Text
"..\n\n"
      fixBlocks (Block
b:[Block]
bs) = Block
b Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block] -> [Block]
fixBlocks [Block]
bs
      fixBlocks [] = []
  tl <- (WriterState -> Bool) -> StateT WriterState m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stTopLevel
  modify (\WriterState
s->WriterState
s{stTopLevel=topLevel})
  res <- vcat `fmap` mapM blockToRST (fixBlocks blocks)
  modify (\WriterState
s->WriterState
s{stTopLevel=tl})
  return res

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

{-

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 Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
spaceArgs Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
cr Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
block
  where marker :: Doc Text
marker = Doc Text
".. " Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
typ Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"::"
        block :: Doc Text
block = Int -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a
nest Int
3 (Doc Text
fieldList Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
                        Doc Text
forall a. Doc a
blankline Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
                        Doc Text
content Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
                        Doc Text
forall a. Doc a
blankline)
        spaceArgs :: Doc Text
spaceArgs = if Doc Text -> Bool
forall a. Doc a -> Bool
isEmpty Doc Text
args then Doc Text
"" else Doc Text
" " Doc Text -> Doc Text -> 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 = (Doc Text -> Doc Text -> Doc Text)
-> Doc Text -> [Doc Text] -> Doc Text
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
($$) Doc Text
"" ([Doc Text] -> Doc Text) -> [Doc Text] -> Doc Text
forall a b. (a -> b) -> a -> b
$ ((Doc Text, Doc Text) -> Doc Text)
-> [(Doc Text, Doc Text)] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map (Doc Text, Doc Text) -> Doc Text
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
":" a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
name a -> a -> a
forall a. Semigroup a => a -> a -> 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
  captionRST <- [Inline] -> RST m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> RST m (Doc Text)
inlineListToRST [Inline]
caption
  opts       <- gets stOptions
  content    <- listTableContent toWrite
  pure $ toRSTDirective "list-table" captionRST (directiveOptions opts) content
  where directiveOptions :: WriterOptions -> [(Doc Text, Doc Text)]
directiveOptions WriterOptions
opts = Int -> [Double] -> [(Doc Text, Doc Text)]
forall {a}. IsString a => Int -> [Double] -> [(a, Doc Text)]
widths (WriterOptions -> Int
writerColumns WriterOptions
opts) [Double]
propWidths [(Doc Text, Doc Text)]
-> [(Doc Text, Doc Text)] -> [(Doc Text, Doc Text)]
forall a. Semigroup a => a -> a -> a
<>
                                [(Doc Text, Doc Text)]
headerRows
        toWrite :: [[[Block]]]
toWrite = if Bool
noHeaders then [[[Block]]]
rows else [[Block]]
headers[[Block]] -> [[[Block]]] -> [[[Block]]]
forall a. a -> [a] -> [a]
:[[[Block]]]
rows
        headerRows :: [(Doc Text, Doc Text)]
headerRows = [(Doc Text
"header-rows", String -> Doc Text
forall a. HasChars a => String -> Doc a
text (String -> Doc Text) -> String -> Doc Text
forall a b. (a -> b) -> a -> b
$ Int -> String
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 ([Double] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Double]
propWidths Bool -> Bool -> Bool
|| (Double -> Bool) -> [Double] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
==Double
0.0) [Double]
propWidths)]
        noHeaders :: Bool
noHeaders = ([Block] -> Bool) -> [[Block]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all [Block] -> Bool
forall a. [a] -> Bool
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 = String -> Doc Text
forall a. HasChars a => String -> Doc a
text (String -> Doc Text)
-> ([Double] -> String) -> [Double] -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unwords ([String] -> String)
-> ([Double] -> [String]) -> [Double] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> String) -> [Double] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> String
forall a. Show a => a -> String
show (Int -> String) -> (Double -> Int) -> Double -> String
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 = Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Double
p Double -> Double -> Double
forall a. Num a => a -> a -> a
* Int -> Double
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 = ([Doc Text] -> Doc Text)
-> StateT WriterState m [Doc Text]
-> StateT WriterState m (Doc Text)
forall a b.
(a -> b) -> StateT WriterState m a -> StateT WriterState m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat (StateT WriterState m [Doc Text]
 -> StateT WriterState m (Doc Text))
-> ([[[Block]]] -> StateT WriterState m [Doc Text])
-> [[[Block]]]
-> StateT WriterState m (Doc Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
          ([[Block]] -> StateT WriterState m (Doc Text))
-> [[[Block]]] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (([Doc Text] -> Doc Text)
-> StateT WriterState m [Doc Text]
-> StateT WriterState m (Doc Text)
forall a b.
(a -> b) -> StateT WriterState m a -> StateT WriterState m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Doc Text -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a -> Doc a
hang Int
2 (String -> Doc Text
forall a. HasChars a => String -> Doc a
text String
"* ") (Doc Text -> Doc Text)
-> ([Doc Text] -> Doc Text) -> [Doc Text] -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat) (StateT WriterState m [Doc Text]
 -> StateT WriterState m (Doc Text))
-> ([[Block]] -> StateT WriterState m [Doc Text])
-> [[Block]]
-> StateT WriterState m (Doc Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Block] -> StateT WriterState m (Doc Text))
-> [[Block]] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM [Block] -> StateT WriterState m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> RST m (Doc Text)
bulletListItemToRST)

transformInlines :: [Inline] -> [Inline]
transformInlines :: [Inline] -> [Inline]
transformInlines =  [Inline] -> [Inline]
insertBS ([Inline] -> [Inline])
-> ([Inline] -> [Inline]) -> [Inline] -> [Inline]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    (Inline -> Bool) -> [Inline] -> [Inline]
forall a. (a -> Bool) -> [a] -> [a]
filter Inline -> Bool
hasContents ([Inline] -> [Inline])
-> ([Inline] -> [Inline]) -> [Inline] -> [Inline]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    [Inline] -> [Inline]
removeSpaceAfterDisplayMath ([Inline] -> [Inline])
-> ([Inline] -> [Inline]) -> [Inline] -> [Inline]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    (Inline -> [Inline]) -> [Inline] -> [Inline]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([Inline] -> [Inline]
transformNested ([Inline] -> [Inline])
-> (Inline -> [Inline]) -> Inline -> [Inline]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inline -> [Inline]
flatten)
  where -- empty inlines are not valid RST syntax
        hasContents :: Inline -> Bool
        hasContents :: Inline -> Bool
hasContents (Str Text
"")              = Bool
False
        hasContents (Emph [])             = Bool
False
        hasContents (Underline [])        = Bool
False
        hasContents (Strong [])           = Bool
False
        hasContents (Strikeout [])        = Bool
False
        hasContents (Superscript [])      = Bool
False
        hasContents (Subscript [])        = Bool
False
        hasContents (SmallCaps [])        = Bool
False
        hasContents (Quoted QuoteType
_ [])         = Bool
False
        hasContents (Cite [Citation]
_ [])           = Bool
False
        hasContents (Span Attr
_ [])           = Bool
False
        hasContents (Link Attr
_ [] (Text
"", Text
""))  = Bool
False
        hasContents (Image Attr
_ [] (Text
"", Text
"")) = Bool
False
        hasContents Inline
_                     = Bool
True
        -- remove spaces after displaymath, as they screw up indentation:
        removeSpaceAfterDisplayMath :: [Inline] -> [Inline]
removeSpaceAfterDisplayMath (Math MathType
DisplayMath Text
x : [Inline]
zs) =
              MathType -> Text -> Inline
Math MathType
DisplayMath Text
x Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: (Inline -> Bool) -> [Inline] -> [Inline]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Inline -> Inline -> Bool
forall a. Eq a => a -> a -> Bool
==Inline
Space) [Inline]
zs
        removeSpaceAfterDisplayMath (Inline
x:[Inline]
xs) = Inline
x Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline] -> [Inline]
removeSpaceAfterDisplayMath [Inline]
xs
        removeSpaceAfterDisplayMath [] = []
        insertBS :: [Inline] -> [Inline] -- insert '\ ' where needed
        insertBS :: [Inline] -> [Inline]
insertBS (Inline
x:Inline
y:Inline
z:[Inline]
zs)
          | Inline -> Bool
isComplex Inline
y Bool -> Bool -> Bool
&& Inline -> Inline -> Bool
surroundComplex Inline
x Inline
z =
              Inline
x Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Inline
y Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline] -> [Inline]
insertBS (Inline
z Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
zs)
        insertBS (Inline
x:Inline
y:[Inline]
zs)
          | Inline -> Bool
isComplex Inline
x Bool -> Bool -> Bool
&& Bool -> Bool
not (Inline -> Bool
okAfterComplex Inline
y) =
              Inline
x Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Format -> Text -> Inline
RawInline Format
"rst" Text
"\\ " Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline] -> [Inline]
insertBS (Inline
y Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
zs)
          | Inline -> Bool
isComplex Inline
y Bool -> Bool -> Bool
&& Bool -> Bool
not (Inline -> Bool
okBeforeComplex Inline
x) =
              Inline
x Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Format -> Text -> Inline
RawInline Format
"rst" Text
"\\ " Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline] -> [Inline]
insertBS (Inline
y Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
zs)
          | Bool
otherwise =
              Inline
x Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline] -> [Inline]
insertBS (Inline
y Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
zs)
        insertBS (Inline
x:[Inline]
ys) = Inline
x Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline] -> [Inline]
insertBS [Inline]
ys
        insertBS [] = []
        transformNested :: [Inline] -> [Inline]
        transformNested :: [Inline] -> [Inline]
transformNested = (Inline -> [Inline]) -> [Inline] -> [Inline]
forall (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 = [Inline] -> Maybe Inline
forall a. [a] -> Maybe a
headMay [Inline]
contents Maybe Inline -> Maybe Inline -> Bool
forall a. Eq a => a -> a -> Bool
== Inline -> Maybe Inline
forall a. a -> Maybe a
Just Inline
Space
                 lastSpace :: Bool
lastSpace = [Inline] -> Maybe Inline
forall a. [a] -> Maybe a
lastMay [Inline]
contents Maybe Inline -> Maybe Inline -> Bool
forall a. Eq a => a -> a -> Bool
== Inline -> Maybe Inline
forall a. a -> Maybe a
Just Inline
Space
              in (if Bool
headSpace then (Inline
SpaceInline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
:) else [Inline] -> [Inline]
forall a. a -> a
id) ([Inline] -> [Inline])
-> ([Inline] -> [Inline]) -> [Inline] -> [Inline]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                 (if Bool
lastSpace then ([Inline] -> [Inline] -> [Inline]
forall a. [a] -> [a] -> [a]
++ [Inline
Space]) else [Inline] -> [Inline]
forall a. a -> a
id) ([Inline] -> [Inline]) -> [Inline] -> [Inline]
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 (Char -> Char -> Bool
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 (Char -> Char -> Bool
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
  | [Inline] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
contents = [Inline
outer]
  | Bool
otherwise     = [Inline] -> [Inline]
combineAll [Inline]
contents
  where contents :: [Inline]
contents = Inline -> [Inline]
dropInlineParent Inline
outer
        combineAll :: [Inline] -> [Inline]
combineAll = ([Inline] -> Inline -> [Inline])
-> [Inline] -> [Inline] -> [Inline]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' [Inline] -> Inline -> [Inline]
combine []

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

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

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

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

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

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

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

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

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

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
  pics <- (WriterState -> [([Inline], (Attr, Text, Text, Maybe Text))])
-> StateT
     WriterState m [([Inline], (Attr, Text, Text, Maybe Text))]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> [([Inline], (Attr, Text, Text, Maybe Text))]
stImages
  imgId <- gets stImageId
  let getImageName = do
        (WriterState -> WriterState) -> StateT WriterState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState) -> StateT WriterState m ())
-> (WriterState -> WriterState) -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st{ stImageId = imgId + 1 }
        [Inline] -> StateT WriterState m [Inline]
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return [Text -> Inline
Str (Text
"image" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
imgId)]
  txt <- case lookup alt pics of
               Just (Attr
a,Text
s,Text
t,Maybe Text
mbt) ->
                 if (Attr
a,Text
s,Text
t,Maybe Text
mbt) (Attr, Text, Text, Maybe Text)
-> (Attr, Text, Text, Maybe Text) -> Bool
forall a. Eq a => a -> a -> Bool
== (Attr
attr,Text
src,Text
tit,Maybe Text
mbtarget)
                    then [Inline] -> StateT WriterState m [Inline]
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return [Inline]
alt
                    else do
                        alt' <- StateT WriterState m [Inline]
getImageName
                        modify $ \WriterState
st -> WriterState
st { stImages =
                           (alt', (attr,src,tit, mbtarget)):stImages st }
                        return alt'
               Maybe (Attr, Text, Text, Maybe Text)
Nothing -> do
                 alt' <- if [Inline] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
alt Bool -> Bool -> Bool
|| [Inline]
alt [Inline] -> [Inline] -> Bool
forall a. Eq a => a -> a -> Bool
== [Text -> Inline
Str Text
""]
                            then StateT WriterState m [Inline]
getImageName
                            else [Inline] -> StateT WriterState m [Inline]
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return [Inline]
alt
                 modify $ \WriterState
st -> WriterState
st { stImages =
                        (alt', (attr,src,tit, mbtarget)):stImages st }
                 return alt'
  inlineListToRST 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 Doc Text
forall a. Doc a
empty
                else Doc Text
":name: " Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
ident
      showDim :: Direction -> Doc a
showDim Direction
dir = let cols :: a -> Doc a
cols a
d = Doc a
":" Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> String -> Doc a
forall a. HasChars a => String -> Doc a
text (Direction -> String
forall a. Show a => a -> String
show Direction
dir) Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a
": " Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> String -> Doc a
forall a. HasChars a => String -> Doc a
text (a -> String
forall a. Show a => a -> String
show a
d)
                    in  case Direction -> Attr -> Maybe Dimension
dimension Direction
dir Attr
attr of
                          Just (Percent Double
a) ->
                            case Direction
dir of
                              Direction
Height -> Doc a
forall a. Doc a
empty
                              Direction
Width  -> Dimension -> Doc a
forall {a} {a}. (HasChars a, Show a) => a -> Doc a
cols (Double -> Dimension
Percent Double
a)
                          Just Dimension
dim -> Dimension -> Doc a
forall {a} {a}. (HasChars a, Show a) => a -> Doc a
cols Dimension
dim
                          Maybe Dimension
Nothing  -> Doc a
forall a. Doc a
empty
  Doc Text -> StateT WriterState m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> StateT WriterState m (Doc Text))
-> Doc Text -> StateT WriterState m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
forall a. Doc a
cr Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
name Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Direction -> Doc Text
forall {a}. HasChars a => Direction -> Doc a
showDim Direction
Width Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Direction -> Doc Text
forall {a}. HasChars a => Direction -> Doc a
showDim Direction
Height

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