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

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

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

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

-- | Escape special characters for RST.
escapeText :: WriterOptions -> Text -> Text
escapeText :: WriterOptions -> Text -> Text
escapeText WriterOptions
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
  Doc Text
title <- [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> RST m (Doc Text)
inlineListToRST [Inline]
tit
  Doc Text
subtitle <- [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> RST m (Doc Text)
inlineListToRST [Inline]
subtit
  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 -> Char -> Doc Text
bordered Doc Text
title Char
'=' Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text -> Char -> Doc Text
bordered Doc Text
subtitle Char
'-'

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

-- | Convert Pandoc block element to RST.
blockToRST :: PandocMonad m
           => Block         -- ^ Block element
           -> RST m (Doc Text)
blockToRST :: 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
  Doc Text
contents <- [Block] -> StateT WriterState m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> RST m (Doc Text)
blockListToRST [Block]
bs
  let admonitions :: [Text]
admonitions = [Text
"attention",Text
"caution",Text
"danger",Text
"error",Text
"hint",
                     Text
"important",Text
"note",Text
"tip",Text
"warning",Text
"admonition"]
  let admonition :: Doc Text
admonition = case [Text]
classes of
                        (Text
cl:[Text]
_)
                          | Text
cl Text -> [Text] -> Bool
forall 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))
  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
admonition Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
           (if Text -> Bool
T.null Text
ident
               then Doc Text
forall a. Doc a
blankline
               else Doc Text
"   :name: " Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
ident Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
forall a. Doc a
blankline) Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
           Int -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a
nest Int
3 Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
           Doc Text
forall a. Doc a
blankline
blockToRST (Plain [Inline]
inlines) = [Inline] -> 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
      Doc Text
contents <- [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> RST m (Doc Text)
inlineListToRST [Inline]
inlines
      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
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
blankline
blockToRST (LineBlock [[Inline]]
lns) =
  [[Inline]] -> 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
  Doc Text
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
  WriterOptions
opts <- (WriterState -> WriterOptions)
-> StateT WriterState m WriterOptions
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> WriterOptions
stOptions
  let autoId :: Text
autoId = Extensions -> [Inline] -> Set Text -> Text
uniqueIdent (WriterOptions -> Extensions
writerExtensions WriterOptions
opts) [Inline]
inlines Set Text
forall a. Monoid a => a
mempty
  Bool
isTopLevel <- (WriterState -> Bool) -> StateT WriterState m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stTopLevel
  if Bool
isTopLevel
    then do
          let headerChar :: Char
headerChar = if Int
level Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
5 then Char
' ' else String
"=-~^'" String -> Int -> Char
forall a. HasCallStack => [a] -> Int -> a
!! (Int
level Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
          let border :: Doc Text
border = Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.replicate (Doc Text -> Int
forall a. (IsString a, HasChars a) => Doc a -> Int
offset Doc Text
contents) (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Char -> Text
T.singleton Char
headerChar
          let anchor :: Doc Text
anchor | Text -> Bool
T.null Text
name Bool -> Bool -> Bool
|| Text
name Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
autoId = Doc Text
forall a. Doc a
empty
                     | Bool
otherwise = Doc Text
".. _" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>
                                   (if (Char -> Bool) -> Text -> Bool
T.any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
':') Text
name Bool -> Bool -> Bool
||
                                        Int -> Text -> Text
T.take Int
1 Text
name Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"_"
                                       then Doc Text
"`" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
name Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"`"
                                       else Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
name) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>
                                   Doc Text
":" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
forall a. Doc a
blankline
          Doc Text -> 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 -> Doc Text
forall a. IsString a => Doc a -> Doc a
nowrap (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Doc Text
anchor Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
border Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
forall a. Doc a
blankline
    else do
          let rub :: Doc Text
rub     = Doc Text
"rubric:: " Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents
          let name' :: Doc Text
name' | Text -> Bool
T.null Text
name    = Doc Text
forall a. Doc a
empty
                    | Bool
otherwise      = Doc Text
":name: " Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
name
          let cls :: Doc Text
cls   | [Text] -> Bool
forall 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)
          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 -> Doc Text
forall a. IsString a => Doc a -> Doc a
nowrap (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Int -> Doc Text -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a -> Doc a
hang Int
3 Doc Text
".. " (Doc Text
rub Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
name' Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
cls) Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
forall a. Doc a
blankline
blockToRST (CodeBlock (Text
_,[Text]
classes,[(Text, Text)]
kvs) Text
str) = do
  WriterOptions
opts <- (WriterState -> WriterOptions)
-> StateT WriterState m WriterOptions
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> WriterOptions
stOptions
  let startnum :: Doc Text
startnum = Doc Text -> (Text -> Doc Text) -> Maybe Text -> Doc Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc Text
"" (\Text
x -> Doc Text
" " Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
x) (Maybe Text -> Doc Text) -> Maybe Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"startFrom" [(Text, Text)]
kvs
  let numberlines :: Doc Text
numberlines = if Text
"numberLines" Text -> [Text] -> Bool
forall 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 Text
"haskell" Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes Bool -> Bool -> Bool
&& Text
"literate" Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes Bool -> Bool -> Bool
&&
                  Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_literate_haskell WriterOptions
opts
     then Doc Text -> 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
$ String -> Doc Text -> Doc Text
forall a. IsString a => String -> Doc a -> Doc a
prefixed String
"> " (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
str) Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
forall a. Doc a
blankline
     else Doc Text -> 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
$
          (case [Text
c | Text
c <- [Text]
classes,
                     Text
c Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Text
"sourceCode",Text
"literate",Text
"numberLines",
                                  Text
"number-lines",Text
"example"]] of
             []       -> Doc Text
"::"
             (Text
lang:[Text]
_) -> (Doc Text
".. code:: " Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
lang) Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
numberlines)
          Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$+$ Int -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a
nest Int
3 (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
str) Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
forall a. Doc a
blankline
blockToRST (BlockQuote [Block]
blocks) = do
  Doc Text
contents <- [Block] -> StateT WriterState m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> RST m (Doc Text)
blockListToRST [Block]
blocks
  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
$ Int -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a
nest Int
3 Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
blankline
blockToRST (Table Attr
_attrs Caption
blkCapt [ColSpec]
specs TableHead
thead [TableBody]
tbody TableFoot
tfoot) = do
  let ([Inline]
caption, [Alignment]
aligns, [Double]
widths, [[Block]]
headers, [[[Block]]]
rows) = Caption
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> ([Inline], [Alignment], [Double], [[Block]], [[[Block]]])
toLegacyTable Caption
blkCapt [ColSpec]
specs TableHead
thead [TableBody]
tbody TableFoot
tfoot
  Doc Text
caption' <- [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> RST m (Doc Text)
inlineListToRST [Inline]
caption
  let blocksToDoc :: WriterOptions -> [Block] -> StateT WriterState m (Doc Text)
blocksToDoc WriterOptions
opts [Block]
bs = do
         WriterOptions
oldOpts <- (WriterState -> WriterOptions)
-> StateT WriterState m WriterOptions
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> WriterOptions
stOptions
         (WriterState -> WriterState) -> StateT WriterState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState) -> StateT WriterState m ())
-> (WriterState -> WriterState) -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st{ stOptions = opts }
         Doc Text
result <- [Block] -> StateT WriterState m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> RST m (Doc Text)
blockListToRST [Block]
bs
         (WriterState -> WriterState) -> StateT WriterState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState) -> StateT WriterState m ())
-> (WriterState -> WriterState) -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st{ stOptions = oldOpts }
         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
result
  WriterOptions
opts <- (WriterState -> WriterOptions)
-> StateT WriterState m WriterOptions
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> WriterOptions
stOptions
  let renderGrid :: StateT WriterState m (Doc Text)
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 :: Bool
isSimple = (Double -> Bool) -> [Double] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
0) [Double]
widths Bool -> Bool -> Bool
&& [Double] -> Int
forall 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 :: StateT WriterState m (Doc Text)
renderSimple = do
        Doc Text
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 Doc Text -> Int
forall a. (IsString a, HasChars a) => Doc a -> Int
offset Doc Text
tbl' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> WriterOptions -> Int
writerColumns WriterOptions
opts
          then StateT WriterState m (Doc Text)
renderGrid
          else 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
tbl'
      isList :: Bool
isList = WriterOptions -> Bool
writerListTables WriterOptions
opts
      renderList :: StateT WriterState m (Doc Text)
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 :: StateT WriterState m (Doc Text)
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
  Doc Text
tbl <- StateT WriterState m (Doc Text)
rendered
  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
$$
           (if [Inline] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
caption
               then Doc Text
tbl
               else (Doc Text
".. table:: " Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
caption') Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
forall a. Doc a
blankline Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Int -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a
nest Int
3 Doc Text
tbl) Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
           Doc Text
forall a. Doc a
blankline
blockToRST (BulletList [[Block]]
items) = do
  [Doc Text]
contents <- ([Block] -> 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
  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
$$
           (if [[Block]] -> Bool
isTightList [[Block]]
items then [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat else [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vsep) [Doc Text]
contents Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
           Doc Text
forall a. Doc a
blankline
blockToRST (OrderedList (Int
start, ListNumberStyle
style', ListNumberDelim
delim) [[Block]]
items) = do
  let markers :: [Text]
markers = if Int
start Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> Bool -> Bool
&& ListNumberStyle
style' ListNumberStyle -> ListNumberStyle -> Bool
forall a. Eq a => a -> a -> Bool
== ListNumberStyle
DefaultStyle Bool -> Bool -> Bool
&& ListNumberDelim
delim ListNumberDelim -> ListNumberDelim -> Bool
forall a. Eq a => a -> a -> Bool
== ListNumberDelim
DefaultDelim
                   then Int -> Text -> [Text]
forall a. Int -> a -> [a]
replicate ([[Block]] -> Int
forall 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
  [Doc Text]
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
  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
$$
           (if [[Block]] -> Bool
isTightList [[Block]]
items then [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat else [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vsep) [Doc Text]
contents Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
           Doc Text
forall a. Doc a
blankline
blockToRST (DefinitionList [([Inline], [[Block]])]
items) = do
  [Doc Text]
contents <- (([Inline], [[Block]]) -> 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
  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
forall a. [Doc a] -> Doc a
vcat [Doc Text]
contents Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
forall a. Doc a
blankline

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

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

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

endsWithList :: [Block] -> Bool
endsWithList :: [Block] -> Bool
endsWithList [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
  Doc Text
label' <- [Inline] -> RST m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> RST m (Doc Text)
inlineListToRST [Inline]
label
  Doc Text
contents <- ([Doc Text] -> Doc Text)
-> StateT WriterState m [Doc Text] -> RST m (Doc Text)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat (StateT WriterState m [Doc Text] -> RST m (Doc Text))
-> StateT WriterState m [Doc Text] -> RST m (Doc Text)
forall a b. (a -> b) -> a -> b
$ ([Block] -> RST m (Doc Text))
-> [[Block]] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM [Block] -> RST m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> RST m (Doc Text)
blockListToRST [[Block]]
defs
  Doc Text -> RST m (Doc Text)
forall 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
forall a. IsString a => Doc a -> Doc a
nowrap Doc Text
label' Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Int -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a
nest Int
3 (Doc Text -> Doc Text
forall a. Doc a -> Doc a
nestle Doc Text
contents) Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
      if [[Block]] -> Bool
isTightList [[Block]]
defs
         then Doc Text
forall a. Doc a
cr
         else Doc Text
forall a. Doc a
blankline

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

-- | Convert list of Pandoc block elements to RST.
blockListToRST' :: PandocMonad m
                => Bool
                -> [Block]       -- ^ List of block elements
                -> RST m (Doc Text)
blockListToRST' :: 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 [] = []
  Bool
tl <- (WriterState -> Bool) -> StateT WriterState m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stTopLevel
  (WriterState -> WriterState) -> StateT WriterState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\WriterState
s->WriterState
s{stTopLevel=topLevel})
  Doc Text
res <- [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat ([Doc Text] -> Doc Text)
-> StateT WriterState m [Doc Text] -> RST m (Doc Text)
forall 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` (Block -> RST m (Doc Text))
-> [Block] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Block -> RST m (Doc Text)
forall (m :: * -> *). PandocMonad m => Block -> RST m (Doc Text)
blockToRST ([Block] -> [Block]
fixBlocks [Block]
blocks)
  (WriterState -> WriterState) -> StateT WriterState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\WriterState
s->WriterState
s{stTopLevel=tl})
  Doc Text -> RST m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
res

blockListToRST :: PandocMonad m
               => [Block]       -- ^ List of block elements
               -> RST m (Doc Text)
blockListToRST :: forall (m :: * -> *). PandocMonad m => [Block] -> RST m (Doc Text)
blockListToRST = 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
  Doc Text
captionRST <- [Inline] -> RST m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> RST m (Doc Text)
inlineListToRST [Inline]
caption
  WriterOptions
opts       <- (WriterState -> WriterOptions)
-> StateT WriterState m WriterOptions
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> WriterOptions
stOptions
  Doc Text
content    <- [[[Block]]] -> RST m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
[[[Block]]] -> RST m (Doc Text)
listTableContent [[[Block]]]
toWrite
  Doc Text -> RST m (Doc Text)
forall a. a -> StateT WriterState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (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)] -> Doc Text -> Doc Text
toRSTDirective Doc Text
"list-table" Doc Text
captionRST (WriterOptions -> [(Doc Text, Doc Text)]
directiveOptions WriterOptions
opts) Doc Text
content
  where directiveOptions :: WriterOptions -> [(Doc Text, Doc Text)]
directiveOptions WriterOptions
opts = 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 = ([RST m (Doc Text)] -> RST m (Doc Text))
-> ([RST m (Doc Text)] -> RST m (Doc Text))
-> [[RST m (Doc Text)]]
-> RST m (Doc Text)
forall a. ([a] -> a) -> ([a] -> a) -> [[a]] -> a
joinTable [RST m (Doc Text)] -> RST m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
[RST m (Doc Text)] -> RST m (Doc Text)
joinDocsM [RST m (Doc Text)] -> RST m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
[RST m (Doc Text)] -> RST m (Doc Text)
joinDocsM ([[RST m (Doc Text)]] -> RST m (Doc Text))
-> ([[[Block]]] -> [[RST m (Doc Text)]])
-> [[[Block]]]
-> RST m (Doc Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                           ([Block] -> RST m (Doc Text))
-> [[[Block]]] -> [[RST m (Doc Text)]]
forall a b. (a -> b) -> [[a]] -> [[b]]
mapTable [Block] -> RST m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> RST m (Doc Text)
blockListToRST
        -- joinDocsM adapts joinDocs in order to work in the `RST m` monad
        joinDocsM :: PandocMonad m => [RST m (Doc Text)] -> RST m (Doc Text)
        joinDocsM :: forall (m :: * -> *).
PandocMonad m =>
[RST m (Doc Text)] -> RST m (Doc Text)
joinDocsM = ([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
joinDocs (StateT WriterState m [Doc Text]
 -> StateT WriterState m (Doc Text))
-> ([StateT WriterState m (Doc Text)]
    -> StateT WriterState m [Doc Text])
-> [StateT WriterState m (Doc Text)]
-> StateT WriterState m (Doc Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [StateT WriterState m (Doc Text)]
-> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence
        -- joinDocs will be used to join cells and to join rows
        joinDocs :: [Doc Text] -> Doc Text
        joinDocs :: [Doc Text] -> Doc Text
joinDocs [Doc Text]
items = Doc Text
forall a. Doc a
blankline Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
                         (Doc Text -> Doc Text
forall a. Doc a -> Doc a
chomp (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 ([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] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map Doc Text -> Doc Text
formatItem) [Doc Text]
items Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
                         Doc Text
forall a. Doc a
blankline
        formatItem :: Doc Text -> Doc Text
        formatItem :: Doc Text -> Doc Text
formatItem Doc Text
i = Int -> Doc Text -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a -> Doc a
hang Int
3 Doc Text
"- " (Doc Text
i Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
cr)
        -- apply a function to all table cells changing their type
        mapTable :: (a -> b) -> [[a]] -> [[b]]
        mapTable :: forall a b. (a -> b) -> [[a]] -> [[b]]
mapTable = ([a] -> [b]) -> [[a]] -> [[b]]
forall a b. (a -> b) -> [a] -> [b]
map (([a] -> [b]) -> [[a]] -> [[b]])
-> ((a -> b) -> [a] -> [b]) -> (a -> b) -> [[a]] -> [[b]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map
        -- function hor to join cells and function ver to join rows
        joinTable :: ([a] -> a) -> ([a] -> a) -> [[a]] -> a
        joinTable :: forall a. ([a] -> a) -> ([a] -> a) -> [[a]] -> a
joinTable [a] -> a
hor [a] -> a
ver = [a] -> a
ver ([a] -> a) -> ([[a]] -> [a]) -> [[a]] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a] -> a) -> [[a]] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map [a] -> a
hor

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
  Doc Text
contents <- [Inline] -> RST m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> RST m (Doc Text)
writeInlines [Inline]
ils
  Doc Text -> RST m (Doc Text)
forall 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
":mark:`" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"`"
inlineToRST (Span (Text
_,[Text]
_,[(Text, Text)]
kvs) [Inline]
ils) = do
  Doc Text
contents <- [Inline] -> RST m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> RST m (Doc Text)
writeInlines [Inline]
ils
  Doc Text -> RST m (Doc Text)
forall 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
$
    case Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"role" [(Text, Text)]
kvs of
          Just Text
role -> Doc Text
":" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
role Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
":`" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"`"
          Maybe Text
Nothing   -> Doc Text
contents
inlineToRST (Emph [Inline]
lst) = do
  Doc Text
contents <- [Inline] -> RST m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> RST m (Doc Text)
writeInlines [Inline]
lst
  Doc Text -> RST m (Doc Text)
forall 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
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"*"
-- Underline is not supported, fall back to Emph
inlineToRST (Underline [Inline]
lst) =
  Inline -> RST m (Doc Text)
forall (m :: * -> *). PandocMonad m => Inline -> RST m (Doc Text)
inlineToRST ([Inline] -> Inline
Emph [Inline]
lst)
inlineToRST (Strong [Inline]
lst) = do
  Doc Text
contents <- [Inline] -> RST m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> RST m (Doc Text)
writeInlines [Inline]
lst
  Doc Text -> RST m (Doc Text)
forall 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
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"**"
inlineToRST (Strikeout [Inline]
lst) = do
  Doc Text
contents <- [Inline] -> RST m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> RST m (Doc Text)
writeInlines [Inline]
lst
  Doc Text -> RST m (Doc Text)
forall 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
"[STRIKEOUT:" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"]"
inlineToRST (Superscript [Inline]
lst) = do
  Doc Text
contents <- [Inline] -> RST m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> RST m (Doc Text)
writeInlines [Inline]
lst
  Doc Text -> RST m (Doc Text)
forall 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
":sup:`" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"`"
inlineToRST (Subscript [Inline]
lst) = do
  Doc Text
contents <- [Inline] -> RST m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> RST m (Doc Text)
writeInlines [Inline]
lst
  Doc Text -> RST m (Doc Text)
forall 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
":sub:`" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"`"
inlineToRST (SmallCaps [Inline]
lst) = [Inline] -> RST m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> RST m (Doc Text)
writeInlines [Inline]
lst
inlineToRST (Quoted QuoteType
SingleQuote [Inline]
lst) = do
  Doc Text
contents <- [Inline] -> RST m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> RST m (Doc Text)
writeInlines [Inline]
lst
  WriterOptions
opts <- (WriterState -> WriterOptions)
-> StateT WriterState m WriterOptions
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> WriterOptions
stOptions
  if Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_smart WriterOptions
opts
     then Doc Text -> RST m (Doc Text)
forall 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
contents 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
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"’"
inlineToRST (Quoted QuoteType
DoubleQuote [Inline]
lst) = do
  Doc Text
contents <- [Inline] -> RST m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> RST m (Doc Text)
writeInlines [Inline]
lst
  WriterOptions
opts <- (WriterState -> WriterOptions)
-> StateT WriterState m WriterOptions
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> WriterOptions
stOptions
  if Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_smart WriterOptions
opts
     then Doc Text -> RST m (Doc Text)
forall 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
contents 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
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"”"
inlineToRST (Cite [Citation]
_  [Inline]
lst) =
  [Inline] -> RST m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> RST m (Doc Text)
writeInlines [Inline]
lst
inlineToRST (Code (Text
_,[Text
"interpreted-text"],[(Text
"role",Text
role)]) Text
str) =
  Doc Text -> RST m (Doc Text)
forall 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
  WriterOptions
opts <- (WriterState -> WriterOptions)
-> StateT WriterState m WriterOptions
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> WriterOptions
stOptions
  -- we trim the string because the delimiters must adjoin a
  -- non-space character; see #3496
  -- we use :literal: when the code contains backticks, since
  -- :literal: allows backslash-escapes; see #3974
  Doc Text -> RST m (Doc Text)
forall 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 (Char -> Bool) -> Text -> Bool
T.any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'`') Text
str
       then Doc Text
":literal:`" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (WriterOptions -> Text -> Text
escapeText WriterOptions
opts (Text -> Text
trim Text
str)) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"`"
       else Doc Text
"``" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Text
trim Text
str) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"``"
inlineToRST (Str Text
str) = do
  WriterOptions
opts <- (WriterState -> WriterOptions)
-> StateT WriterState m WriterOptions
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> WriterOptions
stOptions
  Doc Text -> RST m (Doc Text)
forall 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 -> Doc Text) -> Text -> Doc Text
forall a b. (a -> b) -> a -> b
$
    (if Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_smart WriterOptions
opts
        then WriterOptions -> Text -> Text
unsmartify WriterOptions
opts
        else Text -> Text
forall a. a -> a
id) (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ WriterOptions -> Text -> Text
escapeText WriterOptions
opts Text
str
inlineToRST (Math MathType
t Text
str) = do
  (WriterState -> WriterState) -> StateT WriterState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState) -> StateT WriterState m ())
-> (WriterState -> WriterState) -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st{ stHasMath = 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
  WrapOption
wrapText <- (WriterState -> WrapOption) -> StateT WriterState m WrapOption
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((WriterState -> WrapOption) -> StateT WriterState m WrapOption)
-> (WriterState -> WrapOption) -> StateT WriterState m WrapOption
forall a b. (a -> b) -> a -> b
$ WriterOptions -> WrapOption
writerWrapText (WriterOptions -> WrapOption)
-> (WriterState -> WriterOptions) -> WriterState -> WrapOption
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterState -> WriterOptions
stOptions
  case WrapOption
wrapText of
        WrapOption
WrapPreserve -> Doc Text -> RST m (Doc Text)
forall 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
  Doc Text
label <- Attr -> [Inline] -> (Text, Text) -> Maybe Text -> RST m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Attr -> [Inline] -> (Text, Text) -> Maybe Text -> RST m (Doc Text)
registerImage Attr
attr [Inline]
alt (Text
imgsrc,Text
imgtit) (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
src)
  Doc Text -> RST m (Doc Text)
forall 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
label Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"|"
inlineToRST (Link Attr
_ [Inline]
txt (Text
src, Text
tit)) = do
  Bool
useReferenceLinks <- (WriterState -> Bool) -> StateT WriterState m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((WriterState -> Bool) -> StateT WriterState m Bool)
-> (WriterState -> Bool) -> StateT WriterState m Bool
forall a b. (a -> b) -> a -> b
$ WriterOptions -> Bool
writerReferenceLinks (WriterOptions -> Bool)
-> (WriterState -> WriterOptions) -> WriterState -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterState -> WriterOptions
stOptions
  Doc Text
linktext <- [Inline] -> RST m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> RST m (Doc Text)
writeInlines ([Inline] -> RST m (Doc Text)) -> [Inline] -> RST m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Many Inline -> [Inline]
forall a. Many a -> [a]
B.toList (Many Inline -> [Inline])
-> ([Inline] -> Many Inline) -> [Inline] -> [Inline]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Many Inline -> Many Inline
B.trimInlines (Many Inline -> Many Inline)
-> ([Inline] -> Many Inline) -> [Inline] -> Many Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> Many Inline
forall a. [a] -> Many a
B.fromList ([Inline] -> [Inline]) -> [Inline] -> [Inline]
forall a b. (a -> b) -> a -> b
$ [Inline]
txt
  if Bool
useReferenceLinks
    then do Refs
refs <- (WriterState -> Refs) -> StateT WriterState m Refs
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Refs
stLinks
            case [Inline] -> Refs -> Maybe (Text, Text)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup [Inline]
txt Refs
refs of
                 Just (Text
src',Text
tit') ->
                   if Text
src Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
src' Bool -> Bool -> Bool
&& Text
tit Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
tit'
                      then Doc Text -> RST m (Doc Text)
forall 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 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
">`__"
inlineToRST (Image Attr
attr [Inline]
alternate (Text
source, Text
tit)) = do
  Doc Text
label <- Attr -> [Inline] -> (Text, Text) -> Maybe Text -> RST m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Attr -> [Inline] -> (Text, Text) -> Maybe Text -> RST m (Doc Text)
registerImage Attr
attr [Inline]
alternate (Text
source,Text
tit) Maybe Text
forall a. Maybe a
Nothing
  Doc Text -> RST m (Doc Text)
forall 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
label Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"|"
inlineToRST (Note [Block]
contents) = do
  -- add to notes in state
  [[Block]]
notes <- (WriterState -> [[Block]]) -> StateT WriterState m [[Block]]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> [[Block]]
stNotes
  (WriterState -> WriterState) -> StateT WriterState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState) -> StateT WriterState m ())
-> (WriterState -> WriterState) -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st { stNotes = contents:notes }
  let ref :: String
ref = Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ [[Block]] -> Int
forall 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
  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
<> String -> Doc Text
forall a. HasChars a => String -> Doc a
text String
ref Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"]_"

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

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