content: {-# 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 { stNotes       :: [[Block]]
                , stLinks       :: Refs
                , stImages      :: [([Inline], (Attr, Text, Text, Maybe Text))]
                , stHasMath     :: Bool
                , stHasRawTeX   :: Bool
                , stOptions     :: WriterOptions
                , stTopLevel    :: Bool
                , stImageId     :: Int
                }
  
  type RST = StateT WriterState
  
  -- | Convert Pandoc to RST.
  writeRST :: PandocMonad m => WriterOptions -> Pandoc -> m Text
  writeRST opts document = do
    let st = WriterState { stNotes = [], stLinks = [],
                           stImages = [], stHasMath = False,
                           stHasRawTeX = False, stOptions = opts,
                           stTopLevel = True, stImageId = 1 }
    evalStateT (pandocToRST document) st
  
  -- | Return RST representation of document.
  pandocToRST :: PandocMonad m => Pandoc -> RST m Text
  pandocToRST (Pandoc meta blocks) = do
    opts <- gets stOptions
    let colwidth = if writerWrapText opts == WrapAuto
                      then Just $ writerColumns opts
                      else Nothing
    let subtit = lookupMetaInlines "subtitle" meta
    title <- titleToRST (docTitle meta) subtit
    metadata <- metaToContext opts
                  blockListToRST
                  (fmap chomp . inlineListToRST)
                  meta
    body <- blockListToRST' True $ case writerTemplate opts of
                                        Just _  -> normalizeHeadings 1 blocks
                                        Nothing -> blocks
    notes <- gets (reverse . stNotes) >>= notesToRST
    -- note that the notes may contain refs, so we do them first
    refs <- gets (reverse . stLinks) >>= refsToRST
    pics <- gets (reverse . stImages) >>= pictRefsToRST
    hasMath <- gets stHasMath
    rawTeX <- gets stHasRawTeX
    let main = vsep [body, notes, refs, pics]
    let context = defField "body" main
                $ defField "toc" (writerTableOfContents opts)
                $ defField "toc-depth" (tshow $ writerTOCDepth opts)
                $ defField "number-sections" (writerNumberSections opts)
                $ defField "math" hasMath
                $ defField "titleblock" (render Nothing title :: Text)
                $ defField "math" hasMath
                $ defField "rawtex" rawTeX metadata
    return $ render colwidth $
      case writerTemplate opts of
         Nothing  -> main
         Just tpl -> renderTemplate tpl context
    where
      normalizeHeadings lev (Header l a i:bs) =
        Header lev a i:normalizeHeadings (lev+1) cont ++ normalizeHeadings lev bs'
        where (cont,bs') = break (headerLtEq l) bs
              headerLtEq level (Header l' _ _) = l' <= level
              headerLtEq _ _                   = False
      normalizeHeadings lev (b:bs) = b:normalizeHeadings lev bs
      normalizeHeadings _   []     = []
  
  -- | Return RST representation of reference key table.
  refsToRST :: PandocMonad m => Refs -> RST m (Doc Text)
  refsToRST refs =
     vcat <$> mapM keyToRST refs
  
  -- | Return RST representation of a reference key.
  keyToRST :: PandocMonad m => ([Inline], (Text, Text)) -> RST m (Doc Text)
  keyToRST (label, (src, _)) = do
    label' <- inlineListToRST label
    let label'' = if (==':') `T.any` (render Nothing label' :: Text)
                     then char '`' <> label' <> char '`'
                     else label'
    return $ nowrap $ ".. _" <> label'' <> ": " <> literal src
  
  -- | Return RST representation of notes.
  notesToRST :: PandocMonad m => [[Block]] -> RST m (Doc Text)
  notesToRST notes =
     vsep <$> zipWithM noteToRST [1..] notes
  
  -- | Return RST representation of a note.
  noteToRST :: PandocMonad m => Int -> [Block] -> RST m (Doc Text)
  noteToRST num note = do
    contents <- blockListToRST note
    let marker = ".. [" <> text (show num) <> "]"
    return $ nowrap $ marker $$ nest 3 contents
  
  -- | Return RST representation of picture reference table.
  pictRefsToRST :: PandocMonad m
                => [([Inline], (Attr, Text, Text, Maybe Text))]
                -> RST m (Doc Text)
  pictRefsToRST refs =
     vcat <$> mapM pictToRST refs
  
  -- | Return RST representation of a picture substitution reference.
  pictToRST :: PandocMonad m
            => ([Inline], (Attr, Text, Text, Maybe Text))
            -> RST m (Doc Text)
  pictToRST (label, (attr, src, _, mbtarget)) = do
    label' <- inlineListToRST label
    dims   <- imageDimsToRST attr
    let (_, cls, _) = attr
        classes = case cls of
                     []               -> empty
                     ["align-top"]    -> ":align: top"
                     ["align-middle"] -> ":align: middle"
                     ["align-bottom"] -> ":align: bottom"
                     ["align-center"] -> empty
                     ["align-right"]  -> empty
                     ["align-left"]   -> empty
                     _                -> ":class: " <> literal (T.unwords cls)
    return $ nowrap
           $ ".. |" <> label' <> "| image:: " <> literal src $$ hang 3 empty (classes $$ dims)
           $$ case mbtarget of
                   Nothing -> empty
                   Just t  -> "   :target: " <> literal t
  
  -- | Escape special characters for RST.
  escapeText :: WriterOptions -> Text -> Text
  escapeText opts t =
    if T.any isSpecial t
       then T.pack . escapeString' True . T.unpack $ t
       else t -- optimization
   where
    isSmart = isEnabled Ext_smart opts
    isSpecial c = c == '\\' || c == '_' || c == '`' || c == '*' || c == '|'
                  || (isSmart && (c == '-' || c == '.' || c == '"' || c == '\''))
    canFollowInlineMarkup c = c == '-' || c == '.' || c == ',' || c == ':'
                      || c == ';' || c == '!' || c == '?' || c == '\''
                      || c == '"' || c == ')' || c == ']' || c == '}'
                      || c == '>' || isSpace c
                      || (not (isAscii c) &&
                          generalCategory c `elem`
                          [OpenPunctuation, InitialQuote, FinalQuote,
                           DashPunctuation, OtherPunctuation])
    canPrecedeInlineMarkup c = c == '-' || c == ':' || c == '/' || c == '\''
                       || c == '"' || c == '<' || c == '(' || c == '['
                       || c == '{' || isSpace c
                       || (not (isAscii c) &&
                            generalCategory c `elem`
                            [ClosePunctuation, InitialQuote, FinalQuote,
                            DashPunctuation, OtherPunctuation])
    escapeString' canStart cs =
      case cs of
        [] -> []
        d:ds
          | d == '\\'
          -> '\\' : d : escapeString' False ds
        '\'':ds
          | isSmart
          -> '\\' : '\'' : escapeString' True ds
        '"':ds
          | isSmart
          -> '\\' : '"' : escapeString' True ds
        '-':'-':ds
          | isSmart
          -> '\\' : '-' : escapeString' False ('-':ds)
        '.':'.':'.':ds
          | isSmart
          -> '\\' : '.' : escapeString' False ('.':'.':ds)
        [e]
          | e == '*' || e == '_' || e == '|' || e == '`'
          -> ['\\',e]
        d:ds
          | canPrecedeInlineMarkup d
          -> d : escapeString' True ds
        e:d:ds
          | e == '*' || e == '_' || e == '|' || e == '`'
          , (not canStart && canFollowInlineMarkup d)
            || (canStart && not (isSpace d))
          -> '\\' : e : escapeString' False (d:ds)
        '_':d:ds
          | not (isAlphaNum d)
          -> '\\' : '_' : escapeString' False (d:ds)
        d:ds -> d : escapeString' False ds
  
  titleToRST :: PandocMonad m => [Inline] -> [Inline] -> RST m (Doc Text)
  titleToRST [] _ = return empty
  titleToRST tit subtit = do
    title <- inlineListToRST tit
    subtitle <- inlineListToRST subtit
    return $ bordered title '=' $$ bordered subtitle '-'
  
  bordered :: Doc Text -> Char -> Doc Text
  bordered contents c =
    if len > 0
       then border $$ contents $$ border
       else empty
     where len = offset contents
           border = literal (T.replicate len $ T.singleton c)
  
  -- | Convert Pandoc block element to RST.
  blockToRST :: PandocMonad m
             => Block         -- ^ Block element
             -> RST m (Doc Text)
  blockToRST (Div ("",["title"],[]) _) = return empty
    -- this is generated by the rst reader and can safely be
    -- omitted when we're generating rst
  blockToRST (Div (ident,classes,_kvs) bs) = do
    contents <- blockListToRST bs
    let admonitions = ["attention","caution","danger","error","hint",
                       "important","note","tip","warning","admonition"]
    let admonition = case classes of
                          (cl:_)
                            | cl `elem` admonitions
                            -> blankline <> ".. " <> literal cl <> "::"
                          cls -> blankline <> ".. container::" <> space <>
                                     literal (T.unwords (filter (/= "container") cls))
    -- if contents start with block quote, we need to insert
    -- an empty comment to fix the indentation point (#10236)
    let contents' = case bs of
                      BlockQuote{}:_-> ".." $+$ contents
                      _ -> contents
    return $ blankline $$
             admonition $$
             (if T.null ident
                 then blankline
                 else "   :name: " <> literal ident $$ blankline) $$
             nest 3 contents' $$
             blankline
  blockToRST (Plain inlines) = inlineListToRST inlines
  blockToRST (Para inlines)
    | LineBreak `elem` inlines =
        linesToLineBlock $ splitBy (==LineBreak) inlines
    | otherwise = do
        contents <- inlineListToRST inlines
        return $ contents <> blankline
  blockToRST (LineBlock lns) =
    linesToLineBlock lns
  blockToRST (RawBlock f@(Format f') str)
    | f == "rst" = return $ literal str
    | f == "tex" = blockToRST (RawBlock (Format "latex") str)
    | otherwise  = return $ blankline <> ".. raw:: " <>
                      literal (T.toLower f') $+$
                      nest 3 (literal str) $$ blankline
  blockToRST HorizontalRule =
    return $ blankline $$ "--------------" $$ blankline
  blockToRST (Header level (name,classes,_) inlines) = do
    contents <- inlineListToRST inlines
    -- we calculate the id that would be used by auto_identifiers
    -- so we know whether to print an explicit identifier
    opts <- gets stOptions
    let autoId = uniqueIdent (writerExtensions opts) inlines mempty
    isTopLevel <- gets stTopLevel
    if isTopLevel
      then do
            let headerChar = if level > 5 then ' ' else "=-~^'" !! (level - 1)
            let border = literal $ T.replicate (offset contents) $ T.singleton headerChar
            let anchor | T.null name || name == autoId = empty
                       | otherwise = ".. _" <>
                                     (if T.any (==':') name ||
                                          T.take 1 name == "_"
                                         then "`" <> literal name <> "`"
                                         else literal name) <>
                                     ":" $$ blankline
            return $ nowrap $ anchor $$ contents $$ border $$ blankline
      else do
            let rub     = "rubric:: " <> contents
            let name' | T.null name    = empty
                      | otherwise      = ":name: " <> literal name
            let cls   | null classes   = empty
                      | otherwise      = ":class: " <> literal (T.unwords classes)
            return $ nowrap $ hang 3 ".. " (rub $$ name' $$ cls) $$ blankline
  blockToRST (CodeBlock (_,classes,kvs) str) = do
    opts <- gets stOptions
    let startnum = maybe "" (\x -> " " <> literal x) $ lookup "startFrom" kvs
    let numberlines = if "numberLines" `elem` classes
                         then "   :number-lines:" <> startnum
                         else empty
    if "haskell" `elem` classes && "literate" `elem` classes &&
                    isEnabled Ext_literate_haskell opts
       then return $ prefixed "> " (literal str) $$ blankline
       else return $
            (case [c | c <- classes,
                       c `notElem` ["sourceCode","literate","numberLines",
                                    "number-lines","example"]] of
               []       -> "::"
               (lang:_) -> (blankline <> ".. code:: " <> literal lang) $$ numberlines)
            $+$ nest 3 (literal str) $$ blankline
  blockToRST (BlockQuote blocks) = do
    contents <- blockListToRST blocks
    return $ nest 3 contents <> blankline
  blockToRST (Table _attrs blkCapt specs thead tbody tfoot) = do
    let (caption, aligns, widths, headers, rows) =
          toLegacyTable blkCapt specs thead tbody tfoot
    caption' <- inlineListToRST caption
    let blocksToDoc opts bs = do
           oldOpts <- gets stOptions
           modify $ \st -> st{ stOptions = opts }
           result <- blockListToRST bs
           modify $ \st -> st{ stOptions = oldOpts }
           return result
    opts <- gets stOptions
    let specs' = map (\(_,width) -> (AlignDefault, width)) specs
        renderGrid = gridTable opts blocksToDoc specs' thead tbody tfoot
        isSimple = all (== 0) widths && length widths > 1
        renderSimple = do
          tbl' <- simpleTable opts blocksToDoc thead tbody tfoot
          if offset tbl' > writerColumns opts
            then renderGrid
            else return tbl'
        isList = writerListTables opts
        renderList = tableToRSTList caption (map (const AlignDefault) aligns)
                      widths headers rows
        rendered
          | isList    = renderList
          | isSimple  = renderSimple
          | otherwise = renderGrid
    tbl <- rendered
    return $ blankline $$
             (if null caption || isList
                 then tbl
                 else (blankline <> ".. table:: " <> caption') $$ blankline $$ nest 3 tbl) $$
             blankline
  blockToRST (BulletList items) = do
    contents <- mapM bulletListItemToRST items
    -- ensure that sublists have preceding blank line
    return $ blankline $$
             (if isTightList items then vcat else vsep) contents $$
             blankline
  blockToRST (OrderedList (start, style', delim) items) = do
    let markers = if start == 1 && style' == DefaultStyle && delim == DefaultDelim
                     then replicate (length items) "#."
                     else take (length items) $ orderedListMarkers
                                                (start, style', delim)
    let maxMarkerLength = maybe 0 maximum $ NE.nonEmpty $ map T.length markers
    let markers' = map (\m -> let s = maxMarkerLength - T.length m
                              in  m <> T.replicate s " ") markers
    contents <- zipWithM orderedListItemToRST markers' items
    -- ensure that sublists have preceding blank line
    return $ blankline $$
             (if isTightList items then vcat else vsep) contents $$
             blankline
  blockToRST (DefinitionList items) = do
    contents <- mapM definitionListItemToRST items
    -- ensure that sublists have preceding blank line
    return $ blankline $$ vcat contents $$ blankline
  
  blockToRST (Figure (ident, classes, _kvs)
               (Caption _ longCapt) body) = do
    let figure attr txt (src, tit) = do
          description <- inlineListToRST txt
          capt <- blockListToRST longCapt
          dims <- imageDimsToRST attr
          let fig = "figure::" <+> literal src
              alt = if null txt
                       then if T.null tit
                                then empty
                                else ":alt:" <+> literal tit
                       else ":alt:" <+> description
              name = if T.null ident
                        then empty
                        else "name:" <+> literal ident
              (_,cls,_) = attr
              align = case cls of
                        []               -> empty
                        ["align-right"]  -> ":align: right"
                        ["align-left"]   -> ":align: left"
                        ["align-center"] -> ":align: center"
                        _ -> ":figclass: " <> literal (T.unwords cls)
          return $ hang 3 ".. " (fig $$ name $$ alt $$ align $$ dims $+$ capt)
                $$ blankline
    case body of
      [Para  [Image attr txt tgt]] -> figure attr txt tgt
      [Plain [Image attr txt tgt]] -> figure attr txt tgt
      _ -> do
        content <- blockListToRST body
        return $ blankline $$ (
          ".. container:: float" <> space <>
          literal (T.unwords (filter (/= "container") classes))) $$
          (if T.null ident
           then blankline
           else "   :name: " <> literal ident $$ blankline) $$
          nest 3 content $$
          blankline
  
  -- | Convert bullet list item (list of blocks) to RST.
  bulletListItemToRST :: PandocMonad m => [Block] -> RST m (Doc Text)
  bulletListItemToRST items = do
    contents <- blockListToRST items
    -- if a list item starts with block quote, we need to insert
    -- an empty comment to fix the indentation point (#10236)
    let contents' = case items of
                      BlockQuote{}:_-> ".." $+$ contents
                      _ -> contents
    return $ hang 2 "- " contents' $$
        if null items || (endsWithPlain items && not (endsWithList items))
           then cr
           else blankline
  
  -- | Convert ordered list item (a list of blocks) to RST.
  orderedListItemToRST :: PandocMonad m
                       => Text   -- ^ marker for list item
                       -> [Block]  -- ^ list item (list of blocks)
                       -> RST m (Doc Text)
  orderedListItemToRST marker items = do
    contents <- blockListToRST items
    let marker' = marker <> " "
    -- if a list item starts with block quote, we need to insert
    -- an empty comment to fix the indentation point (#10236)
    let contents' = case items of
                      BlockQuote{}:_-> ".." $+$ contents
                      _ -> contents
    return $ hang (T.length marker') (literal marker') contents' $$
        if null items || (endsWithPlain items && not (endsWithList items))
           then cr
           else blankline
  
  endsWithList :: [Block] -> Bool
  endsWithList bs = case lastMay bs of
                      Just (BulletList{}) -> True
                      Just (OrderedList{}) -> True
                      _ -> False
  
  -- | Convert definition list item (label, list of blocks) to RST.
  definitionListItemToRST :: PandocMonad m => ([Inline], [[Block]]) -> RST m (Doc Text)
  definitionListItemToRST (label, defs) = do
    label' <- inlineListToRST label
    contents <- liftM vcat $ mapM blockListToRST defs
    -- if definition list starts with block quote, we need to insert
    -- an empty comment to fix the indentation point (#10236)
    let contents' = case defs of
                      (BlockQuote{}:_):_ -> ".." $+$ contents
                      _ -> contents
    return $ nowrap label' $$ nest 3 (nestle contents') $$
        if isTightList defs
           then cr
           else blankline
  
  -- | Format a list of lines as line block.
  linesToLineBlock :: PandocMonad m => [[Inline]] -> RST m (Doc Text)
  linesToLineBlock inlineLines = do
    lns <- mapM inlineListToRST inlineLines
    return $
                        vcat (map (hang 2 (literal "| ")) lns) <> blankline
  
  -- | Convert list of Pandoc block elements to RST.
  blockListToRST' :: PandocMonad m
                  => Bool
                  -> [Block]       -- ^ List of block elements
                  -> RST m (Doc Text)
  blockListToRST' topLevel blocks = do
    -- insert comment between list and quoted blocks, see #4248 and #3675
    let fixBlocks (b1:b2@(BlockQuote _):bs)
          | toClose b1 = b1 : commentSep : b2 : fixBlocks bs
          where
            toClose Plain{}                  = False
            toClose Header{}                 = False
            toClose LineBlock{}              = False
            toClose HorizontalRule           = False
            toClose SimpleFigure{}           = True
            toClose Para{}                   = False
            toClose _                        = True
            commentSep  = RawBlock "rst" "..\n\n"
        fixBlocks (b:bs) = b : fixBlocks bs
        fixBlocks [] = []
    tl <- gets stTopLevel
    modify (\s->s{stTopLevel=topLevel})
    res <- vcat `fmap` mapM blockToRST (fixBlocks blocks)
    modify (\s->s{stTopLevel=tl})
    return res
  
  blockListToRST :: PandocMonad m
                 => [Block]       -- ^ List of block elements
                 -> RST m (Doc Text)
  blockListToRST = blockListToRST' 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 typ args options content = marker <> spaceArgs <> cr <> block
    where marker = ".. " <> typ <> "::"
          block = nest 3 (fieldList $$
                          blankline $$
                          content $$
                          blankline)
          spaceArgs = if isEmpty args then "" else " " <> args
          -- a field list could end up being an empty doc thus being
          -- omitted by $$
          fieldList = foldl ($$) "" $ map joinField options
          -- a field body can contain multiple lines
          joinField (name, body) = ":" <> name <> ": " <> body
  
  tableToRSTList :: PandocMonad m
               => [Inline]
               -> [Alignment]
               -> [Double]
               -> [[Block]]
               -> [[[Block]]]
               -> RST m (Doc Text)
  tableToRSTList caption _ propWidths headers rows = do
    captionRST <- inlineListToRST caption
    opts       <- gets stOptions
    content    <- listTableContent toWrite
    pure $ toRSTDirective "list-table" captionRST (directiveOptions opts) content
    where directiveOptions opts = widths (writerColumns opts) propWidths <>
                                  headerRows
          toWrite = if noHeaders then rows else headers:rows
          headerRows = [("header-rows", text $ show (1 :: Int)) | not noHeaders]
          widths tot pro = [("widths", showWidths tot pro) |
                            not (null propWidths || all (==0.0) propWidths)]
          noHeaders = all null headers
          -- >>> showWidths 70 [0.5, 0.5]
          -- "35 35"
          showWidths :: Int -> [Double] -> Doc Text
          showWidths tot = text . unwords . map (show . toColumns 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 t p = round (p * fromIntegral t)
          listTableContent :: PandocMonad m => [[[Block]]] -> RST m (Doc Text)
          listTableContent = fmap vcat .
            mapM (fmap (hang 2 (text "* ") . vcat) . mapM bulletListItemToRST)
  
  transformInlines :: [Inline] -> [Inline]
  transformInlines =  insertBS .
                      filter hasContents .
                      removeSpaceAfterDisplayMath .
                      concatMap (transformNested . flatten)
    where -- empty inlines are not valid RST syntax
          hasContents :: Inline -> Bool
          hasContents (Str "")              = False
          hasContents (Emph [])             = False
          hasContents (Underline [])        = False
          hasContents (Strong [])           = False
          hasContents (Strikeout [])        = False
          hasContents (Superscript [])      = False
          hasContents (Subscript [])        = False
          hasContents (SmallCaps [])        = False
          hasContents (Quoted _ [])         = False
          hasContents (Cite _ [])           = False
          hasContents (Span _ [])           = False
          hasContents (Link _ [] ("", ""))  = False
          hasContents (Image _ [] ("", "")) = False
          hasContents _                     = True
          -- remove spaces after displaymath, as they screw up indentation:
          removeSpaceAfterDisplayMath (Math DisplayMath x : zs) =
                Math DisplayMath x : dropWhile (==Space) zs
          removeSpaceAfterDisplayMath (x:xs) = x : removeSpaceAfterDisplayMath xs
          removeSpaceAfterDisplayMath [] = []
          insertBS :: [Inline] -> [Inline] -- insert '\ ' where needed
          insertBS (x:y:z:zs)
            | isComplex y && surroundComplex x z =
                x : y : insertBS (z : zs)
          insertBS (x:y:zs)
            | isComplex x && not (okAfterComplex y) =
                x : RawInline "rst" "\\ " : insertBS (y : zs)
            | isComplex y && not (okBeforeComplex x) =
                x : RawInline "rst" "\\ " : insertBS (y : zs)
            | otherwise =
                x : insertBS (y : zs)
          insertBS (x:ys) = x : insertBS ys
          insertBS [] = []
          transformNested :: [Inline] -> [Inline]
          transformNested = concatMap exportLeadingTrailingSpace
          exportLeadingTrailingSpace :: Inline -> [Inline]
          exportLeadingTrailingSpace il
            | isComplex il =
               let contents = dropInlineParent il
                   headSpace = headMay contents == Just Space
                   lastSpace = lastMay contents == Just Space
                in (if headSpace then (Space:) else id) .
                   (if lastSpace then (++ [Space]) else id) $
                   [setInlineChildren il (stripLeadingTrailingSpace contents)]
            | otherwise = [il]
  
          surroundComplex :: Inline -> Inline -> Bool
          surroundComplex (Str s) (Str s')
            | Just (_, c)  <- T.unsnoc s
            , Just (c', _) <- T.uncons s'
            = case (c, c') of
                ('\'','\'') -> True
                ('"','"')   -> True
                ('<','>')   -> True
                ('[',']')   -> True
                ('{','}')   -> True
                _           -> False
          surroundComplex _ _ = False
          okAfterComplex :: Inline -> Bool
          okAfterComplex Space = True
          okAfterComplex SoftBreak = True
          okAfterComplex LineBreak = True
          okAfterComplex (Str (T.uncons -> Just (c,_)))
            = isSpace c || T.any (== c) "-.,:;!?\\/'\")]}>–—"
          okAfterComplex _ = False
          okBeforeComplex :: Inline -> Bool
          okBeforeComplex Space = True
          okBeforeComplex SoftBreak = True
          okBeforeComplex LineBreak = True
          okBeforeComplex (Str (T.unsnoc -> Just (_,c)))
            = isSpace c || T.any (== c) "-:/'\"<([{–—"
          okBeforeComplex _ = False
          isComplex :: Inline -> Bool
          isComplex (Emph _)        = True
          isComplex (Underline _)   = True
          isComplex (Strong _)      = True
          isComplex (SmallCaps _)   = True
          isComplex (Strikeout _)   = True
          isComplex (Superscript _) = True
          isComplex (Subscript _)   = True
          isComplex Link{}          = True
          isComplex Image{}         = True
          isComplex (Code _ _)      = True
          isComplex (Math _ _)      = True
          isComplex (Cite _ (x:_))  = isComplex x
          isComplex (Span _ (x:_))  = isComplex x
          isComplex _               = 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 outer
    | null contents = [outer]
    | otherwise     = combineAll contents
    where contents = dropInlineParent outer
          combineAll = foldl' combine []
  
          combine :: [Inline] -> Inline -> [Inline]
          combine f i =
            case (outer, i) of
            -- quotes are not rendered using RST inlines, so we can keep
            -- them and they will be readable and parsable
            (Quoted _ _, _)          -> keep f i
            (_, Quoted _ _)          -> keep f i
            -- spans are not rendered using RST inlines, so we can keep them
            (Span (_,_,[]) _, _)   -> keep f i
            (_, Span (_,_,[]) _)   -> keep f i
            -- inlineToRST handles this case properly so it's safe to keep
            ( Link{}, Image{})       -> keep f i
            -- parent inlines would prevent links from being correctly
            -- parsed, in this case we prioritise the content over the
            -- style
            (_, Link{})              -> emerge f i
            -- always give priority to strong text over emphasis
            (Emph _, Strong _)       -> emerge f i
            -- drop all other nested styles
            (_, _)                   -> collapse f i
  
          emerge f i = f <> [i]
          keep f i = appendToLast f [i]
          collapse f i = appendToLast f $ dropInlineParent i
  
          appendToLast :: [Inline] -> [Inline] -> [Inline]
          appendToLast flattened toAppend =
            case NE.nonEmpty flattened of
              Nothing -> [setInlineChildren outer toAppend]
              Just xs ->
                if isOuter lastFlat
                   then NE.init xs <> [appendTo lastFlat toAppend]
                   else flattened <> [setInlineChildren outer toAppend]
                 where
                  lastFlat = NE.last xs
                  appendTo o i = mapNested (<> i) o
                  isOuter i = emptyParent i == emptyParent outer
                  emptyParent i = setInlineChildren i []
  
  mapNested :: ([Inline] -> [Inline]) -> Inline -> Inline
  mapNested f i = setInlineChildren i (f (dropInlineParent i))
  
  dropInlineParent :: Inline -> [Inline]
  dropInlineParent (Link _ i _)    = i
  dropInlineParent (Emph i)        = i
  dropInlineParent (Underline i)   = i
  dropInlineParent (Strong i)      = i
  dropInlineParent (Strikeout i)   = i
  dropInlineParent (Superscript i) = i
  dropInlineParent (Subscript i)   = i
  dropInlineParent (SmallCaps i)   = i
  dropInlineParent (Cite _ i)      = i
  dropInlineParent (Image _ i _)   = i
  dropInlineParent (Span _ i)      = i
  dropInlineParent (Quoted _ i)    = i
  dropInlineParent i               = [i] -- not a parent, like Str or Space
  
  setInlineChildren :: Inline -> [Inline] -> Inline
  setInlineChildren (Link a _ t) i    = Link a i t
  setInlineChildren (Emph _) i        = Emph i
  setInlineChildren (Underline _) i   = Underline i
  setInlineChildren (Strong _) i      = Strong i
  setInlineChildren (Strikeout _) i   = Strikeout i
  setInlineChildren (Superscript _) i = Superscript i
  setInlineChildren (Subscript _) i   = Subscript i
  setInlineChildren (SmallCaps _) i   = SmallCaps i
  setInlineChildren (Quoted q _) i    = Quoted q i
  setInlineChildren (Cite c _) i      = Cite c i
  setInlineChildren (Image a _ t) i   = Image a i t
  setInlineChildren (Span a _) i      = Span a i
  setInlineChildren leaf _            = leaf
  
  inlineListToRST :: PandocMonad m => [Inline] -> RST m (Doc Text)
  inlineListToRST = writeInlines . walk transformInlines
  
  -- | Convert list of Pandoc inline elements to RST.
  writeInlines :: PandocMonad m => [Inline] -> RST m (Doc Text)
  writeInlines lst =
     hcat <$> mapM inlineToRST lst
  
  -- | Convert Pandoc inline element to RST.
  inlineToRST :: PandocMonad m => Inline -> RST m (Doc Text)
  inlineToRST (Span ("",["mark"],[]) ils) = do
    contents <- writeInlines ils
    return $ ":mark:`" <> contents <> "`"
  inlineToRST (Span (_,_,kvs) ils) = do
    contents <- writeInlines ils
    return $
      case lookup "role" kvs of
            Just role -> ":" <> literal role <> ":`" <> contents <> "`"
            Nothing   -> contents
  inlineToRST (Emph lst) = do
    contents <- writeInlines lst
    return $ "*" <> contents <> "*"
  -- Underline is not supported, fall back to Emph
  inlineToRST (Underline lst) =
    inlineToRST (Emph lst)
  inlineToRST (Strong lst) = do
    contents <- writeInlines lst
    return $ "**" <> contents <> "**"
  inlineToRST (Strikeout lst) = do
    contents <- writeInlines lst
    return $ "[STRIKEOUT:" <> contents <> "]"
  inlineToRST (Superscript lst) = do
    contents <- writeInlines lst
    return $ ":sup:`" <> contents <> "`"
  inlineToRST (Subscript lst) = do
    contents <- writeInlines lst
    return $ ":sub:`" <> contents <> "`"
  inlineToRST (SmallCaps lst) = writeInlines lst
  inlineToRST (Quoted SingleQuote lst) = do
    contents <- writeInlines lst
    opts <- gets stOptions
    if isEnabled Ext_smart opts
       then return $ "'" <> contents <> "'"
       else return $ "‘" <> contents <> "’"
  inlineToRST (Quoted DoubleQuote lst) = do
    contents <- writeInlines lst
    opts <- gets stOptions
    if isEnabled Ext_smart opts
       then return $ "\"" <> contents <> "\""
       else return $ "“" <> contents <> "”"
  inlineToRST (Cite _  lst) =
    writeInlines lst
  inlineToRST (Code (_,["interpreted-text"],[("role",role)]) str) =
    return $ ":" <> literal role <> ":`" <> literal str <> "`"
  inlineToRST (Code _ str) = do
    opts <- gets stOptions
    -- we trim the string because the delimiters must adjoin a
    -- non-space character; see #3496
    -- we use :literal: when the code contains backticks, since
    -- :literal: allows backslash-escapes; see #3974
    return $
      if T.any (== '`') str
         then ":literal:`" <> literal (escapeText opts (trim str)) <> "`"
         else "``" <> literal (trim str) <> "``"
  inlineToRST (Str str) = do
    opts <- gets stOptions
    return $ literal $
      (if isEnabled Ext_smart opts
          then unsmartify opts
          else id) $ escapeText opts str
  inlineToRST (Math t str) = do
    modify $ \st -> st{ stHasMath = True }
    return $ if t == InlineMath
                then ":math:`" <> literal str <> "`"
                else if T.any (== '\n') str
                     then blankline $$ ".. math::" $$
                          blankline $$ nest 3 (literal str) $$ blankline
                     else blankline $$ (".. math:: " <> literal str) $$ blankline
  inlineToRST il@(RawInline f x)
    | f == "rst" = return $ literal x
    | f == "latex" || f == "tex" = do
        modify $ \st -> st{ stHasRawTeX = True }
        return $ ":raw-latex:`" <> literal x <> "`"
    | otherwise  = empty <$ report (InlineNotRendered il)
  inlineToRST LineBreak = return cr -- there's no line break in RST (see Para)
  inlineToRST Space = return space
  inlineToRST SoftBreak = do
    wrapText <- gets $ writerWrapText . stOptions
    case wrapText of
          WrapPreserve -> return cr
          WrapAuto     -> return space
          WrapNone     -> return space
  -- autolink
  inlineToRST (Link _ [Str str] (src, _))
    | isURI src &&
      if "mailto:" `T.isPrefixOf` src
         then src == escapeURI ("mailto:" <> str)
         else src == escapeURI str = do
    let srcSuffix = fromMaybe src (T.stripPrefix "mailto:" src)
    return $ literal srcSuffix
  inlineToRST (Link _ [Image attr alt (imgsrc,imgtit)] (src, _tit)) = do
    label <- registerImage attr alt (imgsrc,imgtit) (Just src)
    return $ "|" <> label <> "|"
  inlineToRST (Link _ txt (src, tit)) = do
    useReferenceLinks <- gets $ writerReferenceLinks . stOptions
    linktext <- writeInlines $ B.toList . B.trimInlines . B.fromList $ txt
    if useReferenceLinks
      then do refs <- gets stLinks
              case lookup txt refs of
                   Just (src',tit') ->
                     if src == src' && tit == tit'
                        then return $ "`" <> linktext <> "`_"
                        else
                          return $ "`" <> linktext <> " <" <> literal src <> ">`__"
                   Nothing -> do
                     modify $ \st -> st { stLinks = (txt,(src,tit)):refs }
                     return $ "`" <> linktext <> "`_"
      else return $ "`" <> linktext <> " <" <> literal src <> ">`__"
  inlineToRST (Image attr alternate (source, tit)) = do
    label <- registerImage attr alternate (source,tit) Nothing
    return $ "|" <> label <> "|"
  inlineToRST (Note contents) = do
    -- add to notes in state
    notes <- gets stNotes
    modify $ \st -> st { stNotes = contents:notes }
    let ref = show $ length notes + 1
    return $ " [" <> text ref <> "]_"
  
  registerImage :: PandocMonad m => Attr -> [Inline] -> Target -> Maybe Text -> RST m (Doc Text)
  registerImage attr alt (src,tit) mbtarget = do
    pics <- gets stImages
    imgId <- gets stImageId
    let getImageName = do
          modify $ \st -> st{ stImageId = imgId + 1 }
          return [Str ("image" <> tshow imgId)]
    txt <- case lookup alt pics of
                 Just (a,s,t,mbt) ->
                   if (a,s,t,mbt) == (attr,src,tit,mbtarget)
                      then return alt
                      else do
                          alt' <- getImageName
                          modify $ \st -> st { stImages =
                             (alt', (attr,src,tit, mbtarget)):stImages st }
                          return alt'
                 Nothing -> do
                   alt' <- if null alt || alt == [Str ""]
                              then getImageName
                              else return alt
                   modify $ \st -> st { stImages =
                          (alt', (attr,src,tit, mbtarget)):stImages st }
                   return alt'
    inlineListToRST txt
  
  imageDimsToRST :: PandocMonad m => Attr -> RST m (Doc Text)
  imageDimsToRST attr = do
    let (ident, _, _) = attr
        name = if T.null ident
                  then empty
                  else ":name: " <> literal ident
        showDim dir = let cols d = ":" <> text (show dir) <> ": " <> text (show d)
                      in  case dimension dir attr of
                            Just (Percent a) ->
                              case dir of
                                Height -> empty
                                Width  -> cols (Percent a)
                            Just dim -> cols dim
                            Nothing  -> empty
    return $ cr <> name $$ showDim Width $$ showDim Height
  
  simpleTable :: PandocMonad m
              => WriterOptions
              -> (WriterOptions -> [Block] -> m (Doc Text))
              -> TableHead
              -> [TableBody]
              -> TableFoot
              -> m (Doc Text)
  simpleTable opts blocksToDoc (TableHead _ headers) tbody (TableFoot _ footers) = do
    headerDocs <- if all isEmptyRow headers
                     then return []
                     else fixEmpties <$> mapM rowToDoc headers
    rowDocs <- fixEmpties <$> mapM rowToDoc ((concatMap tableBodyToRows tbody) ++ footers)
    let numChars = maybe 0 maximum . NE.nonEmpty . map (offset . fst)
    let colWidths = map numChars $ transpose (headerDocs ++ rowDocs)
    let hline = nowrap $ hsep (map (\n -> literal (T.replicate n "=")) colWidths)
    let hdr = if all isEmptyRow headers
                 then mempty
                 else hline $$ mapToRow colWidths headerDocs
    let bdy = mapToRow colWidths rowDocs
    return $ hdr $$ hline $$ bdy $$ hline
    where
      isEmptyRow (Row _ cells) = all isEmptyCell cells
  
      isEmptyCell (Cell _ _ _ _ blocks) = null blocks
  
      -- can't have empty cells in first column:
      fixEmpties (d:ds) = fixEmpties' d : ds
      fixEmpties [] = []
  
      fixEmpties' ((d, colSpan):ds) = if isEmpty d
                                       then (literal "\\ ", colSpan) : ds
                                       else (d, colSpan) : ds
      fixEmpties' [] = []
  
      rowToDoc (Row _ cells) = concat <$> mapM cellToDocs cells
  
      cellToDocs (Cell _ _ _ colSpan blocks) = applyColSpan colSpan <$> (blocksToDoc opts) blocks
  
      tableBodyToRows (TableBody _ _ headerRows bodyRows) = headerRows ++ bodyRows
  
      applyColSpan col@(ColSpan colSpan) doc
        | colSpan > 1 =
            -- Fill up columns for the col spans by adding empty docs without a ColSpan.
            let emptyDoc = (literal "", Nothing)
            in  (doc, Just col) : replicate (colSpan - 1) emptyDoc
        | otherwise = [(doc, Just col)]
  
      mapToRow colWidths = vcat . concatMap (toRow colWidths)
  
      toRow colWidths rowDocsWithColSpans =
        let (rowDocs, colSpans) = unzip rowDocsWithColSpans
            row = intersperseDivider $ zipWith lblock colWidths rowDocs
            colSpanRow = intersperseDivider $ writeColSpans colSpans colWidths
        in  if any (maybe False (> 1)) colSpans
             then [row, colSpanRow]
             else [row] -- Don't write out col spans if they are all just 1.
  
      intersperseDivider = mconcat . intersperse (lblock 1 " ")
  
      -- Write col span dashes to match the length of the col widths.
      writeColSpans [] _ = []
      writeColSpans _ [] = []
      writeColSpans (Nothing : remainingColSpans) colWidths = writeColSpans remainingColSpans colWidths
      writeColSpans (Just (ColSpan colSpan) : remainingColSpans) colWidths =
        let (colWidths', remainingColWidths) = splitAt colSpan colWidths
        in  writeColSpanDashes colWidths' : writeColSpans remainingColSpans remainingColWidths
  
      writeColSpanDashes colWidths =
        let colWidthsLength = length colWidths
            colWidthsSum = sum colWidths
            dashLength = if colWidthsLength > 1
              -- Offset by 1 for the white spaces between columns so that the col
              -- span dashes align with the end of the columns correctly.
              then colWidthsSum + colWidthsLength - 1
              else colWidthsSum
        in  literal $ T.replicate dashLength "-"
  