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

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

Conversion of 'Pandoc' documents to markdown-formatted plain text.

Markdown:  <https://daringfireball.net/projects/markdown/>
-}
module Text.Pandoc.Writers.Markdown (
  writeMarkdown,
  writeCommonMark,
  writePlain) where
import Control.Monad.Reader
import Control.Monad.State.Strict
import Data.Default
import Data.List (intersperse, sortOn, transpose)
import Data.List.NonEmpty (nonEmpty, NonEmpty(..))
import qualified Data.Map as M
import Data.Maybe (fromMaybe, mapMaybe, isNothing)
import qualified Data.Set as Set
import Data.Text (Text)
import qualified Data.Text as T
import Text.HTML.TagSoup (Tag (..), isTagText, parseTags)
import Text.Pandoc.Class.PandocMonad (PandocMonad, report)
import Text.Pandoc.Definition
import Text.Pandoc.Logging
import Text.Pandoc.Options
import Text.Pandoc.Parsing hiding (blankline, blanklines, char, space)
import Text.DocLayout
import Text.Pandoc.Shared
import Text.Pandoc.Writers.Shared
import Text.Pandoc.Templates (renderTemplate)
import Text.DocTemplates (Val(..), Context(..), FromContext(..))
import Text.Pandoc.Walk
import Text.Pandoc.Writers.HTML (writeHtml5String)
import Text.Pandoc.Writers.Markdown.Inline (inlineListToMarkdown, linkAttributes, attrsToMarkdown)
import Text.Pandoc.Writers.Markdown.Types (MarkdownVariant(..),
                                           WriterState(..),
                                           WriterEnv(..),
                                           Ref, Refs, MD, evalMD)

-- | Convert Pandoc to Markdown.
writeMarkdown :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writeMarkdown :: WriterOptions -> Pandoc -> m Text
writeMarkdown WriterOptions
opts Pandoc
document =
  MD m Text -> WriterEnv -> WriterState -> m Text
forall (m :: * -> *) a.
PandocMonad m =>
MD m a -> WriterEnv -> WriterState -> m a
evalMD (WriterOptions -> Pandoc -> MD m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> MD m Text
pandocToMarkdown WriterOptions
opts{
             writerWrapText :: WrapOption
writerWrapText = if Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_hard_line_breaks WriterOptions
opts
                              then WrapOption
WrapNone
                              else WriterOptions -> WrapOption
writerWrapText WriterOptions
opts }
             Pandoc
document) WriterEnv
forall a. Default a => a
def WriterState
forall a. Default a => a
def

-- | Convert Pandoc to plain text (like markdown, but without links,
-- pictures, or inline formatting).
writePlain :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writePlain :: WriterOptions -> Pandoc -> m Text
writePlain WriterOptions
opts Pandoc
document =
  MD m Text -> WriterEnv -> WriterState -> m Text
forall (m :: * -> *) a.
PandocMonad m =>
MD m a -> WriterEnv -> WriterState -> m a
evalMD (WriterOptions -> Pandoc -> MD m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> MD m Text
pandocToMarkdown WriterOptions
opts Pandoc
document) WriterEnv
forall a. Default a => a
def{ envVariant :: MarkdownVariant
envVariant = MarkdownVariant
PlainText } WriterState
forall a. Default a => a
def

-- | Convert Pandoc to Commonmark.
writeCommonMark :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writeCommonMark :: WriterOptions -> Pandoc -> m Text
writeCommonMark WriterOptions
opts Pandoc
document =
  MD m Text -> WriterEnv -> WriterState -> m Text
forall (m :: * -> *) a.
PandocMonad m =>
MD m a -> WriterEnv -> WriterState -> m a
evalMD (WriterOptions -> Pandoc -> MD m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> MD m Text
pandocToMarkdown WriterOptions
opts' Pandoc
document) WriterEnv
forall a. Default a => a
def{ envVariant :: MarkdownVariant
envVariant = MarkdownVariant
Commonmark } WriterState
forall a. Default a => a
def
 where
  opts' :: WriterOptions
opts' = WriterOptions
opts{ writerExtensions :: Extensions
writerExtensions =
                   -- These extensions can't be enabled or disabled
                   -- for commonmark because they're part of the core;
                   -- we set them here so that escapeText will behave
                   -- properly.
                   Extension -> Extensions -> Extensions
enableExtension Extension
Ext_all_symbols_escapable (Extensions -> Extensions) -> Extensions -> Extensions
forall a b. (a -> b) -> a -> b
$
                   Extension -> Extensions -> Extensions
enableExtension Extension
Ext_intraword_underscores (Extensions -> Extensions) -> Extensions -> Extensions
forall a b. (a -> b) -> a -> b
$
                     WriterOptions -> Extensions
writerExtensions WriterOptions
opts }

pandocTitleBlock :: Doc Text -> [Doc Text] -> Doc Text -> Doc Text
pandocTitleBlock :: Doc Text -> [Doc Text] -> Doc Text -> Doc Text
pandocTitleBlock Doc Text
tit [Doc Text]
auths Doc Text
dat =
  Int -> Doc Text -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a -> Doc a
hang Int
2 (String -> Doc Text
forall a. HasChars a => String -> Doc a
text String
"% ") Doc Text
tit 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
<>
  Int -> Doc Text -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a -> Doc a
hang Int
2 (String -> Doc Text
forall a. HasChars a => String -> Doc a
text String
"% ") ([Doc Text] -> Doc Text
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
forall a. IsString a => Doc a -> Doc a
nowrap [Doc Text]
auths) 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
<>
  Int -> Doc Text -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a -> Doc a
hang Int
2 (String -> Doc Text
forall a. HasChars a => String -> Doc a
text String
"% ") Doc Text
dat Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
cr

mmdTitleBlock :: Context Text -> Doc Text
mmdTitleBlock :: Context Text -> Doc Text
mmdTitleBlock (Context Map Text (Val Text)
hashmap) =
  [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
$ ((Text, Val Text) -> Doc Text) -> [(Text, Val Text)] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Val Text) -> Doc Text
forall a.
(HasChars a, ToText a, FromText a) =>
(Text, Val a) -> Doc a
go ([(Text, Val Text)] -> [Doc Text])
-> [(Text, Val Text)] -> [Doc Text]
forall a b. (a -> b) -> a -> b
$ ((Text, Val Text) -> Text)
-> [(Text, Val Text)] -> [(Text, Val Text)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Text -> Text
T.toCaseFold (Text -> Text)
-> ((Text, Val Text) -> Text) -> (Text, Val Text) -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, Val Text) -> Text
forall a b. (a, b) -> a
fst) ([(Text, Val Text)] -> [(Text, Val Text)])
-> [(Text, Val Text)] -> [(Text, Val Text)]
forall a b. (a -> b) -> a -> b
$ Map Text (Val Text) -> [(Text, Val Text)]
forall k a. Map k a -> [(k, a)]
M.toList Map Text (Val Text)
hashmap
  where go :: (Text, Val a) -> Doc a
go (Text
k,Val a
v) =
          case (String -> Doc a
forall a. HasChars a => String -> Doc a
text (Text -> String
T.unpack Text
k), Val a
v) of
               (Doc a
k', ListVal [Val a]
xs)
                 | [Val a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Val a]
xs        -> Doc a
forall a. Doc a
empty
                 | Bool
otherwise      -> Doc a
k' 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
<> Doc a
forall a. Doc a
space Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<>
                                      [Doc a] -> Doc a
forall a. [Doc a] -> Doc a
hcat (Doc a -> [Doc a] -> [Doc a]
forall a. a -> [a] -> [a]
intersperse Doc a
"; " ([Doc a] -> [Doc a]) -> [Doc a] -> [Doc a]
forall a b. (a -> b) -> a -> b
$
                                            (Val a -> Maybe (Doc a)) -> [Val a] -> [Doc a]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Val a -> Maybe (Doc a)
forall a b. FromContext a b => Val a -> Maybe b
fromVal [Val a]
xs)
               (Doc a
k', SimpleVal Doc a
x)
                      | Doc a -> Bool
forall a. Doc a -> Bool
isEmpty Doc a
x -> Doc a
forall a. Doc a
empty
                      | Bool
otherwise -> Doc a
k' 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
<> Doc a
forall a. Doc a
space Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<>
                                     Int -> Doc a -> Doc a
forall a. IsString a => Int -> Doc a -> Doc a
nest Int
2 (Doc a -> Doc a
forall a. HasChars a => Doc a -> Doc a
removeBlankLines (Doc a -> Doc a
forall a. Doc a -> Doc a
chomp Doc a
x))
               (Doc a, Val a)
_                  -> Doc a
forall a. Doc a
empty
        removeBlankLines :: Doc a -> Doc a
removeBlankLines BlankLines{} = Doc a
forall a. Doc a
cr Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> String -> Doc a
forall a. HasChars a => String -> Doc a
text String
"." Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a
forall a. Doc a
cr
        removeBlankLines (Concat Doc a
x Doc a
y) = Doc a -> Doc a
removeBlankLines Doc a
x Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<>
                                        Doc a -> Doc a
removeBlankLines Doc a
y
        removeBlankLines Doc a
x            = Doc a
x

plainTitleBlock :: Doc Text -> [Doc Text] -> Doc Text -> Doc Text
plainTitleBlock :: Doc Text -> [Doc Text] -> Doc Text -> Doc Text
plainTitleBlock Doc Text
tit [Doc Text]
auths Doc Text
dat =
  Doc Text
tit 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] -> Doc Text
forall a. [Doc a] -> Doc a
hcat (Doc Text -> [Doc Text] -> [Doc Text]
forall a. a -> [a] -> [a]
intersperse (String -> Doc Text
forall a. HasChars a => String -> Doc a
text String
"; ") [Doc Text]
auths) 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
dat Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
cr

yamlMetadataBlock :: Context Text -> Doc Text
yamlMetadataBlock :: Context Text -> Doc Text
yamlMetadataBlock Context Text
v = Doc Text
"---" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Context Text -> Doc Text
contextToYaml Context Text
v Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
"---"

contextToYaml :: Context Text -> Doc Text
contextToYaml :: Context Text -> Doc Text
contextToYaml (Context Map Text (Val Text)
o) =
  [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
$ ((Text, Val Text) -> Doc Text) -> [(Text, Val Text)] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Val Text) -> Doc Text
keyvalToYaml ([(Text, Val Text)] -> [Doc Text])
-> [(Text, Val Text)] -> [Doc Text]
forall a b. (a -> b) -> a -> b
$ ((Text, Val Text) -> Text)
-> [(Text, Val Text)] -> [(Text, Val Text)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Text -> Text
T.toCaseFold (Text -> Text)
-> ((Text, Val Text) -> Text) -> (Text, Val Text) -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, Val Text) -> Text
forall a b. (a, b) -> a
fst) ([(Text, Val Text)] -> [(Text, Val Text)])
-> [(Text, Val Text)] -> [(Text, Val Text)]
forall a b. (a -> b) -> a -> b
$ Map Text (Val Text) -> [(Text, Val Text)]
forall k a. Map k a -> [(k, a)]
M.toList Map Text (Val Text)
o
 where
  keyvalToYaml :: (Text, Val Text) -> Doc Text
keyvalToYaml (Text
k,Val Text
v) =
          case (String -> Doc Text
forall a. HasChars a => String -> Doc a
text (Text -> String
T.unpack Text
k), Val Text
v) of
               (Doc Text
k', ListVal [Val Text]
vs)
                 | [Val Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Val Text]
vs        -> Doc Text
forall a. Doc a
empty
                 | Bool
otherwise      -> (Doc Text
k' 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
$$ Val Text -> Doc Text
valToYaml Val Text
v
               (Doc Text
k', MapVal (Context Map Text (Val Text)
m))
                 | Map Text (Val Text) -> Bool
forall k a. Map k a -> Bool
M.null Map Text (Val Text)
m       -> Doc Text
k' Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
": {}"
                 | Bool
otherwise      -> (Doc Text
k' 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
$$ Int -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a
nest Int
2 (Val Text -> Doc Text
valToYaml Val Text
v)
               (Doc Text
_, SimpleVal Doc Text
x)
                     | Doc Text -> Bool
forall a. Doc a -> Bool
isEmpty Doc Text
x  -> Doc Text
forall a. Doc a
empty
               (Doc Text
_, Val Text
NullVal)       -> Doc Text
forall a. Doc a
empty
               (Doc Text
k', Val Text
_)            -> Doc Text
k' 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
<+> Int -> Doc Text -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a -> Doc a
hang Int
2 Doc Text
"" (Val Text -> Doc Text
valToYaml Val Text
v)

valToYaml :: Val Text -> Doc Text
valToYaml :: Val Text -> Doc Text
valToYaml (ListVal [Val Text]
xs) =
  [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
$ (Val Text -> Doc Text) -> [Val Text] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map (\Val Text
v -> Int -> Doc Text -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a -> Doc a
hang Int
2 Doc Text
"- " (Val Text -> Doc Text
valToYaml Val Text
v)) [Val Text]
xs
valToYaml (MapVal Context Text
c) = Context Text -> Doc Text
contextToYaml Context Text
c
valToYaml (BoolVal Bool
True) = Doc Text
"true"
valToYaml (BoolVal Bool
False) = Doc Text
"false"
valToYaml (SimpleVal Doc Text
x)
  | Doc Text -> Bool
forall a. Doc a -> Bool
isEmpty Doc Text
x = Doc Text
forall a. Doc a
empty
  | Bool
otherwise =
      if Doc Text -> Bool
forall a. Doc a -> Bool
hasNewlines Doc Text
x
         then Int -> Doc Text -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a -> Doc a
hang Int
0 (Doc Text
"|" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
cr) Doc Text
x
         else if Maybe Bool -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (Bool -> Text -> Maybe Bool) -> Bool -> Doc Text -> Maybe Bool
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Bool -> Text -> Maybe Bool
needsDoubleQuotes Bool
True Doc Text
x
           then Doc Text
"\"" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> (Text -> Text) -> Doc Text -> Doc Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
escapeInDoubleQuotes Doc Text
x Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"\""
           else Doc Text
x
    where
      needsDoubleQuotes :: Bool -> Text -> Maybe Bool
needsDoubleQuotes Bool
isFirst Text
t
        = if (Char -> Bool) -> Text -> Bool
T.any Char -> Bool
isBadAnywhere Text
t Bool -> Bool -> Bool
||
             (Bool
isFirst Bool -> Bool -> Bool
&& (Char -> Bool) -> Text -> Bool
T.any Char -> Bool
isYamlPunct (Int -> Text -> Text
T.take Int
1 Text
t))
              then Maybe Bool
forall a. Maybe a
Nothing
              else Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False
      isBadAnywhere :: Char -> Bool
isBadAnywhere Char
'#' = Bool
True
      isBadAnywhere Char
':' = Bool
True
      isBadAnywhere Char
_   = Bool
False
      hasNewlines :: Doc a -> Bool
hasNewlines Doc a
NewLine = Bool
True
      hasNewlines BlankLines{} = Bool
True
      hasNewlines Doc a
CarriageReturn = Bool
True
      hasNewlines (Concat Doc a
w Doc a
z) = Doc a -> Bool
hasNewlines Doc a
w Bool -> Bool -> Bool
|| Doc a -> Bool
hasNewlines Doc a
z
      hasNewlines Doc a
_ = Bool
False
      isYamlPunct :: Char -> Bool
isYamlPunct = (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'-',Char
'?',Char
':',Char
',',Char
'[',Char
']',Char
'{',Char
'}',
                             Char
'#',Char
'&',Char
'*',Char
'!',Char
'|',Char
'>',Char
'\'',Char
'"', Char
'%',Char
'@',Char
'`'])
      escapeInDoubleQuotes :: Text -> Text
escapeInDoubleQuotes = Text -> Text -> Text -> Text
T.replace Text
"\"" Text
"\\\"" (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text -> Text
T.replace Text
"\\" Text
"\\\\"
valToYaml Val Text
_ = Doc Text
forall a. Doc a
empty

-- | Return markdown representation of document.
pandocToMarkdown :: PandocMonad m => WriterOptions -> Pandoc -> MD m Text
pandocToMarkdown :: WriterOptions -> Pandoc -> MD m Text
pandocToMarkdown WriterOptions
opts (Pandoc Meta
meta [Block]
blocks) = do
  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
  MarkdownVariant
variant <- (WriterEnv -> MarkdownVariant)
-> ReaderT WriterEnv (StateT WriterState m) MarkdownVariant
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> MarkdownVariant
envVariant
  Context Text
metadata <- ([Block] -> ReaderT WriterEnv (StateT WriterState m) (Doc Text))
-> ([Inline]
    -> ReaderT WriterEnv (StateT WriterState m) (Doc Text))
-> Meta
-> ReaderT WriterEnv (StateT WriterState m) (Context Text)
forall (m :: * -> *) a.
(Monad m, TemplateTarget a) =>
([Block] -> m (Doc a))
-> ([Inline] -> m (Doc a)) -> Meta -> m (Context a)
metaToContext'
               (WriterOptions
-> [Block] -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> MD m (Doc Text)
blockListToMarkdown WriterOptions
opts)
               (WriterOptions
-> [Inline] -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> MD m (Doc Text)
inlineListToMarkdown WriterOptions
opts)
               Meta
meta
  let title' :: Doc Text
title' = Doc Text -> Maybe (Doc Text) -> Doc Text
forall a. a -> Maybe a -> a
fromMaybe Doc Text
forall a. Doc a
empty (Maybe (Doc Text) -> Doc Text) -> Maybe (Doc Text) -> Doc Text
forall a b. (a -> b) -> a -> b
$ Text -> Context Text -> Maybe (Doc Text)
forall a b. FromContext a b => Text -> Context a -> Maybe b
getField Text
"title" Context Text
metadata
  let authors' :: [Doc Text]
authors' = [Doc Text] -> Maybe [Doc Text] -> [Doc Text]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [Doc Text] -> [Doc Text]) -> Maybe [Doc Text] -> [Doc Text]
forall a b. (a -> b) -> a -> b
$ Text -> Context Text -> Maybe [Doc Text]
forall a b. FromContext a b => Text -> Context a -> Maybe b
getField Text
"author" Context Text
metadata
  let date' :: Doc Text
date' = Doc Text -> Maybe (Doc Text) -> Doc Text
forall a. a -> Maybe a -> a
fromMaybe Doc Text
forall a. Doc a
empty (Maybe (Doc Text) -> Doc Text) -> Maybe (Doc Text) -> Doc Text
forall a b. (a -> b) -> a -> b
$ Text -> Context Text -> Maybe (Doc Text)
forall a b. FromContext a b => Text -> Context a -> Maybe b
getField Text
"date" Context Text
metadata
  let titleblock :: Doc Text
titleblock = case WriterOptions -> Maybe (Template Text)
writerTemplate WriterOptions
opts of
                        Just Template Text
_ | MarkdownVariant
variant MarkdownVariant -> MarkdownVariant -> Bool
forall a. Eq a => a -> a -> Bool
== MarkdownVariant
PlainText ->
                                 Doc Text -> [Doc Text] -> Doc Text -> Doc Text
plainTitleBlock Doc Text
title' [Doc Text]
authors' Doc Text
date'
                               | Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_yaml_metadata_block WriterOptions
opts ->
                                   Context Text -> Doc Text
yamlMetadataBlock Context Text
metadata
                               | Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_pandoc_title_block WriterOptions
opts ->
                                   Doc Text -> [Doc Text] -> Doc Text -> Doc Text
pandocTitleBlock Doc Text
title' [Doc Text]
authors' Doc Text
date'
                               | Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_mmd_title_block WriterOptions
opts ->
                                   Context Text -> Doc Text
mmdTitleBlock Context Text
metadata
                               | Bool
otherwise -> Doc Text
forall a. Doc a
empty
                        Maybe (Template Text)
Nothing -> Doc Text
forall a. Doc a
empty
  Doc Text
toc <- if WriterOptions -> Bool
writerTableOfContents WriterOptions
opts
         then WriterOptions
-> Block -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> MD m (Doc Text)
blockToMarkdown WriterOptions
opts ( WriterOptions -> [Block] -> Block
toTableOfContents WriterOptions
opts [Block]
blocks )
         else Doc Text -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Monoid a => a
mempty
  -- Strip off final 'references' header if markdown citations enabled
  let blocks' :: [Block]
blocks' = if Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_citations WriterOptions
opts
                   then case [Block] -> [Block]
forall a. [a] -> [a]
reverse [Block]
blocks of
                             (Div (Text
"refs",[Text]
_,[(Text, Text)]
_) [Block]
_):[Block]
xs -> [Block] -> [Block]
forall a. [a] -> [a]
reverse [Block]
xs
                             [Block]
_                       -> [Block]
blocks
                   else [Block]
blocks
  Doc Text
body <- WriterOptions
-> [Block] -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> MD m (Doc Text)
blockListToMarkdown WriterOptions
opts [Block]
blocks'
  Doc Text
notesAndRefs' <- WriterOptions
-> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> MD m (Doc Text)
notesAndRefs WriterOptions
opts
  let main :: Doc Text
main = Doc Text
body Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
notesAndRefs'
  let context :: Context Text
context  = -- for backwards compatibility we populate toc
                 -- with the contents of the toc, rather than a
                 -- boolean:
                 Text -> Doc Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"toc" Doc Text
toc
               (Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"table-of-contents" Doc Text
toc
               (Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$ 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
$ (if Meta -> Bool
isNullMeta Meta
meta
                     then Context Text -> Context Text
forall a. a -> a
id
                     else Text -> Doc Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"titleblock" Doc Text
titleblock)
               (Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$ WriterOptions -> Context Text -> Context Text
forall a.
TemplateTarget a =>
WriterOptions -> Context a -> Context a
addVariablesToContext WriterOptions
opts Context Text
metadata
  Text -> MD m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> MD m Text) -> Text -> MD 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

-- | Return markdown representation of reference key table.
refsToMarkdown :: PandocMonad m => WriterOptions -> Refs -> MD m (Doc Text)
refsToMarkdown :: WriterOptions -> Refs -> MD m (Doc Text)
refsToMarkdown WriterOptions
opts Refs
refs = [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat ([Doc Text] -> Doc Text)
-> ReaderT WriterEnv (StateT WriterState m) [Doc Text]
-> MD m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Ref -> MD m (Doc Text))
-> Refs -> ReaderT WriterEnv (StateT WriterState m) [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (WriterOptions -> Ref -> MD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Ref -> MD m (Doc Text)
keyToMarkdown WriterOptions
opts) Refs
refs

-- | Return markdown representation of a reference key.
keyToMarkdown :: PandocMonad m
              => WriterOptions
              -> Ref
              -> MD m (Doc Text)
keyToMarkdown :: WriterOptions -> Ref -> MD m (Doc Text)
keyToMarkdown WriterOptions
opts (Text
label', (Text
src, Text
tit), (Text, [Text], [(Text, Text)])
attr) = do
  let tit' :: Doc Text
tit' = if Text -> Bool
T.null Text
tit
                then Doc Text
forall a. Doc a
empty
                else Doc Text
forall a. Doc a
space 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
tit Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"\""
  Doc Text -> MD m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> MD m (Doc Text)) -> Doc Text -> MD 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
2 (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
2
            (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
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
<> Doc Text
forall a. Doc a
space) (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
tit')
            Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
<+> WriterOptions -> (Text, [Text], [(Text, Text)]) -> Doc Text
linkAttributes WriterOptions
opts (Text, [Text], [(Text, Text)])
attr

-- | Return markdown representation of notes.
notesToMarkdown :: PandocMonad m => WriterOptions -> [[Block]] -> MD m (Doc Text)
notesToMarkdown :: WriterOptions -> [[Block]] -> MD m (Doc Text)
notesToMarkdown WriterOptions
opts [[Block]]
notes = do
  Int
n <- (WriterState -> Int)
-> ReaderT WriterEnv (StateT WriterState m) Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Int
stNoteNum
  [Doc Text]
notes' <- (Int -> [Block] -> MD m (Doc Text))
-> [Int]
-> [[Block]]
-> ReaderT WriterEnv (StateT WriterState m) [Doc Text]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM (WriterOptions -> Int -> [Block] -> MD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Int -> [Block] -> MD m (Doc Text)
noteToMarkdown WriterOptions
opts) [Int
n..] [[Block]]
notes
  (WriterState -> WriterState)
-> ReaderT WriterEnv (StateT WriterState m) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState)
 -> ReaderT WriterEnv (StateT WriterState m) ())
-> (WriterState -> WriterState)
-> ReaderT WriterEnv (StateT WriterState m) ()
forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st { stNoteNum :: Int
stNoteNum = WriterState -> Int
stNoteNum WriterState
st Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [[Block]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Block]]
notes }
  Doc Text -> MD m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> MD m (Doc Text)) -> Doc Text -> MD m (Doc Text)
forall a b. (a -> b) -> a -> b
$ [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vsep [Doc Text]
notes'

-- | Return markdown representation of a note.
noteToMarkdown :: PandocMonad m => WriterOptions -> Int -> [Block] -> MD m (Doc Text)
noteToMarkdown :: WriterOptions -> Int -> [Block] -> MD m (Doc Text)
noteToMarkdown WriterOptions
opts Int
num [Block]
blocks = do
  Doc Text
contents  <- WriterOptions -> [Block] -> MD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> MD m (Doc Text)
blockListToMarkdown WriterOptions
opts [Block]
blocks
  let num' :: Doc Text
num' = Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ WriterOptions -> Text
writerIdentifierPrefix WriterOptions
opts Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
num
  let marker :: Doc Text
marker = if Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_footnotes WriterOptions
opts
                  then Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
"[^" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
num' 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
"]:"
                  else Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
"[" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
num' 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
"]"
  let markerSize :: Int
markerSize = Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Doc Text -> Int
forall a. (IsString a, HasChars a) => Doc a -> Int
offset Doc Text
num'
  let spacer :: Doc Text
spacer = case WriterOptions -> Int
writerTabStop WriterOptions
opts Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
markerSize of
                     Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0  -> 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 Int
n Text
" "
                     Int
_ -> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
" "
  Doc Text -> MD m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> MD m (Doc Text)) -> Doc Text -> MD m (Doc Text)
forall a b. (a -> b) -> a -> b
$ if Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_footnotes WriterOptions
opts
              then Int -> Doc Text -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a -> Doc a
hang (WriterOptions -> Int
writerTabStop WriterOptions
opts) (Doc Text
marker Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
spacer) Doc Text
contents
              else Doc Text
marker Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
spacer Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents

-- | (Code) blocks with a single class and no attributes can just use it
-- standalone, no need to bother with curly braces.
classOrAttrsToMarkdown :: Attr -> Doc Text
classOrAttrsToMarkdown :: (Text, [Text], [(Text, Text)]) -> Doc Text
classOrAttrsToMarkdown (Text
"",[Text
cls],[]) = Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
cls
classOrAttrsToMarkdown (Text, [Text], [(Text, Text)])
attrs = (Text, [Text], [(Text, Text)]) -> Doc Text
attrsToMarkdown (Text, [Text], [(Text, Text)])
attrs

-- | Ordered list start parser for use in Para below.
olMarker :: Parser Text ParserState ()
olMarker :: Parser Text ParserState ()
olMarker = do (Int
start, ListNumberStyle
style', ListNumberDelim
delim) <- ParserT
  Text ParserState Identity (Int, ListNumberStyle, ListNumberDelim)
forall s (m :: * -> *).
(Stream s m Char, UpdateSourcePos s Char) =>
ParserT s ParserState m (Int, ListNumberStyle, ListNumberDelim)
anyOrderedListMarker
              if ListNumberDelim
delim ListNumberDelim -> ListNumberDelim -> Bool
forall a. Eq a => a -> a -> Bool
== ListNumberDelim
Period Bool -> Bool -> Bool
&&
                          (ListNumberStyle
style' ListNumberStyle -> ListNumberStyle -> Bool
forall a. Eq a => a -> a -> Bool
== ListNumberStyle
UpperAlpha Bool -> Bool -> Bool
|| (ListNumberStyle
style' ListNumberStyle -> ListNumberStyle -> Bool
forall a. Eq a => a -> a -> Bool
== ListNumberStyle
UpperRoman Bool -> Bool -> Bool
&&
                          Int
start Int -> [Int] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int
1, Int
5, Int
10, Int
50, Int
100, Int
500, Int
1000]))
                          then Parser Text ParserState ()
forall (m :: * -> *) a. MonadPlus m => m a
mzero -- it needs 2 spaces anyway
                          else Parser Text ParserState ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof

-- | True if string begins with an ordered list marker
beginsWithOrderedListMarker :: Text -> Bool
beginsWithOrderedListMarker :: Text -> Bool
beginsWithOrderedListMarker Text
str =
  case Parser Text ParserState ()
-> ParserState -> String -> Text -> Either ParseError ()
forall s t u a.
Stream s Identity t =>
Parsec s u a -> u -> String -> s -> Either ParseError a
runParser Parser Text ParserState ()
olMarker ParserState
defaultParserState String
"para start" (Int -> Text -> Text
T.take Int
10 Text
str) of
         Left  ParseError
_ -> Bool
False
         Right ()
_ -> Bool
True

notesAndRefs :: PandocMonad m => WriterOptions -> MD m (Doc Text)
notesAndRefs :: WriterOptions -> MD m (Doc Text)
notesAndRefs WriterOptions
opts = do
  Doc Text
notes' <- (WriterState -> [[Block]])
-> ReaderT WriterEnv (StateT WriterState m) [[Block]]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> [[Block]]
stNotes ReaderT WriterEnv (StateT WriterState m) [[Block]]
-> ([[Block]] -> MD m (Doc Text)) -> MD m (Doc Text)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= WriterOptions -> [[Block]] -> MD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [[Block]] -> MD m (Doc Text)
notesToMarkdown WriterOptions
opts ([[Block]] -> MD m (Doc Text))
-> ([[Block]] -> [[Block]]) -> [[Block]] -> MD m (Doc Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Block]] -> [[Block]]
forall a. [a] -> [a]
reverse
  (WriterState -> WriterState)
-> ReaderT WriterEnv (StateT WriterState m) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState)
 -> ReaderT WriterEnv (StateT WriterState m) ())
-> (WriterState -> WriterState)
-> ReaderT WriterEnv (StateT WriterState m) ()
forall a b. (a -> b) -> a -> b
$ \WriterState
s -> WriterState
s { stNotes :: [[Block]]
stNotes = [] }
  Doc Text
refs' <- (WriterState -> Refs)
-> ReaderT WriterEnv (StateT WriterState m) Refs
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Refs
stRefs ReaderT WriterEnv (StateT WriterState m) Refs
-> (Refs -> MD m (Doc Text)) -> MD m (Doc Text)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= WriterOptions -> Refs -> MD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Refs -> MD m (Doc Text)
refsToMarkdown WriterOptions
opts (Refs -> MD m (Doc Text))
-> (Refs -> Refs) -> Refs -> MD m (Doc Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Refs -> Refs
forall a. [a] -> [a]
reverse
  (WriterState -> WriterState)
-> ReaderT WriterEnv (StateT WriterState m) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState)
 -> ReaderT WriterEnv (StateT WriterState m) ())
-> (WriterState -> WriterState)
-> ReaderT WriterEnv (StateT WriterState m) ()
forall a b. (a -> b) -> a -> b
$ \WriterState
s -> WriterState
s { stPrevRefs :: Refs
stPrevRefs = WriterState -> Refs
stPrevRefs WriterState
s Refs -> Refs -> Refs
forall a. [a] -> [a] -> [a]
++ WriterState -> Refs
stRefs WriterState
s
                   , stRefs :: Refs
stRefs = []}

  let endSpacing :: Doc a
endSpacing =
        if | WriterOptions -> ReferenceLocation
writerReferenceLocation WriterOptions
opts ReferenceLocation -> ReferenceLocation -> Bool
forall a. Eq a => a -> a -> Bool
== ReferenceLocation
EndOfDocument -> Doc a
forall a. Doc a
empty
           | Doc Text -> Bool
forall a. Doc a -> Bool
isEmpty Doc Text
notes' Bool -> Bool -> Bool
&& Doc Text -> Bool
forall a. Doc a -> Bool
isEmpty Doc Text
refs' -> Doc a
forall a. Doc a
empty
           | Bool
otherwise -> Doc a
forall a. Doc a
blankline

  Doc Text -> MD m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> MD m (Doc Text)) -> Doc Text -> MD m (Doc Text)
forall a b. (a -> b) -> a -> b
$
    (if Doc Text -> Bool
forall a. Doc a -> Bool
isEmpty Doc Text
notes' then Doc Text
forall a. Doc a
empty else Doc Text
forall a. Doc a
blankline Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
notes') Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>
    (if Doc Text -> Bool
forall a. Doc a -> Bool
isEmpty Doc Text
refs' then Doc Text
forall a. Doc a
empty else Doc Text
forall a. Doc a
blankline Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
refs') Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>
    Doc Text
forall a. Doc a
endSpacing

-- | Convert Pandoc block element to markdown.
blockToMarkdown :: PandocMonad m
                => WriterOptions -- ^ Options
                -> Block         -- ^ Block element
                -> MD m (Doc Text)
blockToMarkdown :: WriterOptions -> Block -> MD m (Doc Text)
blockToMarkdown WriterOptions
opts Block
blk =
  (WriterEnv -> WriterEnv) -> MD m (Doc Text) -> MD m (Doc Text)
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
env -> WriterEnv
env {envBlockLevel :: Int
envBlockLevel = WriterEnv -> Int
envBlockLevel WriterEnv
env Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1}) (MD m (Doc Text) -> MD m (Doc Text))
-> MD m (Doc Text) -> MD m (Doc Text)
forall a b. (a -> b) -> a -> b
$
  do Doc Text
doc <- WriterOptions -> Block -> MD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> MD m (Doc Text)
blockToMarkdown' WriterOptions
opts Block
blk
     Int
blkLevel <- (WriterEnv -> Int) -> ReaderT WriterEnv (StateT WriterState m) Int
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Int
envBlockLevel
     if WriterOptions -> ReferenceLocation
writerReferenceLocation WriterOptions
opts ReferenceLocation -> ReferenceLocation -> Bool
forall a. Eq a => a -> a -> Bool
== ReferenceLocation
EndOfBlock Bool -> Bool -> Bool
&& Int
blkLevel Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
       then WriterOptions -> MD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> MD m (Doc Text)
notesAndRefs WriterOptions
opts MD m (Doc Text) -> (Doc Text -> MD m (Doc Text)) -> MD m (Doc Text)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\Doc Text
d -> Doc Text -> MD m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> MD m (Doc Text)) -> Doc Text -> MD m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
doc Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
d)
       else Doc Text -> MD m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
doc

blockToMarkdown' :: PandocMonad m
                 => WriterOptions -- ^ Options
                 -> Block         -- ^ Block element
                 -> MD m (Doc Text)
blockToMarkdown' :: WriterOptions -> Block -> MD m (Doc Text)
blockToMarkdown' WriterOptions
_ Block
Null = Doc Text -> MD m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
blockToMarkdown' WriterOptions
opts (Div (Text, [Text], [(Text, Text)])
attrs [Block]
ils) = do
  Doc Text
contents <- WriterOptions -> [Block] -> MD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> MD m (Doc Text)
blockListToMarkdown WriterOptions
opts [Block]
ils
  MarkdownVariant
variant <- (WriterEnv -> MarkdownVariant)
-> ReaderT WriterEnv (StateT WriterState m) MarkdownVariant
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> MarkdownVariant
envVariant
  Doc Text -> MD m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> MD m (Doc Text)) -> Doc Text -> MD m (Doc Text)
forall a b. (a -> b) -> a -> b
$
    case () of
         ()
_ | Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_fenced_divs WriterOptions
opts Bool -> Bool -> Bool
&&
             (Text, [Text], [(Text, Text)])
attrs (Text, [Text], [(Text, Text)])
-> (Text, [Text], [(Text, Text)]) -> Bool
forall a. Eq a => a -> a -> Bool
/= (Text, [Text], [(Text, Text)])
nullAttr ->
                let attrsToMd :: (Text, [Text], [(Text, Text)]) -> Doc Text
attrsToMd = if MarkdownVariant
variant MarkdownVariant -> MarkdownVariant -> Bool
forall a. Eq a => a -> a -> Bool
== MarkdownVariant
Commonmark
                                then (Text, [Text], [(Text, Text)]) -> Doc Text
attrsToMarkdown
                                else (Text, [Text], [(Text, Text)]) -> Doc Text
classOrAttrsToMarkdown
                in Doc Text -> Doc Text
forall a. IsString a => Doc a -> Doc a
nowrap (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
":::" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
<+> (Text, [Text], [(Text, Text)]) -> Doc Text
attrsToMd (Text, [Text], [(Text, Text)])
attrs) 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
contents 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
":::" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
blankline
           | Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_native_divs WriterOptions
opts Bool -> Bool -> Bool
||
             (Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_raw_html WriterOptions
opts Bool -> Bool -> Bool
&&
              (MarkdownVariant
variant MarkdownVariant -> MarkdownVariant -> Bool
forall a. Eq a => a -> a -> Bool
== MarkdownVariant
Commonmark Bool -> Bool -> Bool
||
               Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_markdown_in_html_blocks WriterOptions
opts)) ->
                Text -> (Text, [Text], [(Text, Text)]) -> Doc Text
forall a.
HasChars a =>
Text -> (Text, [Text], [(Text, Text)]) -> Doc a
tagWithAttrs Text
"div" (Text, [Text], [(Text, Text)])
attrs Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
blankline 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
forall a. Doc a
blankline Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"</div>" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
blankline
           | Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_raw_html WriterOptions
opts Bool -> Bool -> Bool
&&
             Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_markdown_attribute WriterOptions
opts ->
                Text -> (Text, [Text], [(Text, Text)]) -> Doc Text
forall a.
HasChars a =>
Text -> (Text, [Text], [(Text, Text)]) -> Doc a
tagWithAttrs Text
"div" (Text, [Text], [(Text, Text)])
attrs' Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
blankline 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
forall a. Doc a
blankline Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"</div>" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
blankline
           | Bool
otherwise -> Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
blankline
       where (Text
id',[Text]
classes',[(Text, Text)]
kvs') = (Text, [Text], [(Text, Text)])
attrs
             attrs' :: (Text, [Text], [(Text, Text)])
attrs' = (Text
id',[Text]
classes',(Text
"markdown",Text
"1")(Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
:[(Text, Text)]
kvs')
blockToMarkdown' WriterOptions
opts (Plain [Inline]
inlines) = do
  -- escape if para starts with ordered list marker
  MarkdownVariant
variant <- (WriterEnv -> MarkdownVariant)
-> ReaderT WriterEnv (StateT WriterState m) MarkdownVariant
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> MarkdownVariant
envVariant
  let escapeMarker :: Text -> Text
escapeMarker = (Char -> Text) -> Text -> Text
T.concatMap ((Char -> Text) -> Text -> Text) -> (Char -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ \Char
x -> if Char
x Char -> Text -> Bool
`elemText` Text
".()"
                                         then String -> Text
T.pack [Char
'\\', Char
x]
                                         else Char -> Text
T.singleton Char
x
  let startsWithSpace :: [Inline] -> Bool
startsWithSpace (Inline
Space:[Inline]
_)     = Bool
True
      startsWithSpace (Inline
SoftBreak:[Inline]
_) = Bool
True
      startsWithSpace [Inline]
_             = Bool
False
  let inlines' :: [Inline]
inlines' =
        if MarkdownVariant
variant MarkdownVariant -> MarkdownVariant -> Bool
forall a. Eq a => a -> a -> Bool
== MarkdownVariant
PlainText
           then [Inline]
inlines
           else case [Inline]
inlines of
                  (Str Text
t:[Inline]
ys)
                    | [Inline] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
ys Bool -> Bool -> Bool
|| [Inline] -> Bool
startsWithSpace [Inline]
ys
                    , Text -> Bool
beginsWithOrderedListMarker Text
t
                    -> Format -> Text -> Inline
RawInline (Text -> Format
Format Text
"markdown") (Text -> Text
escapeMarker Text
t)Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
:[Inline]
ys
                  (Str Text
t:[Inline]
_)
                    | Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"+" Bool -> Bool -> Bool
|| Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"-" Bool -> Bool -> Bool
||
                      (Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"%" Bool -> Bool -> Bool
&& Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_pandoc_title_block WriterOptions
opts Bool -> Bool -> Bool
&&
                                   Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_all_symbols_escapable WriterOptions
opts)
                    -> Format -> Text -> Inline
RawInline (Text -> Format
Format Text
"markdown") Text
"\\" Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
inlines
                  [Inline]
_ -> [Inline]
inlines
  Doc Text
contents <- WriterOptions -> [Inline] -> MD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> MD m (Doc Text)
inlineListToMarkdown WriterOptions
opts [Inline]
inlines'
  Doc Text -> MD m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> MD m (Doc Text)) -> Doc Text -> MD 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
cr
-- title beginning with fig: indicates figure
blockToMarkdown' WriterOptions
opts (Para [Image (Text, [Text], [(Text, Text)])
attr [Inline]
alt (Text
src,tgt :: Text
tgt@(Text -> Text -> Maybe Text
T.stripPrefix Text
"fig:" -> Just Text
tit))])
  | Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_raw_html WriterOptions
opts Bool -> Bool -> Bool
&&
    Bool -> Bool
not (Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_link_attributes WriterOptions
opts Bool -> Bool -> Bool
|| Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_attributes WriterOptions
opts) Bool -> Bool -> Bool
&&
    (Text, [Text], [(Text, Text)])
attr (Text, [Text], [(Text, Text)])
-> (Text, [Text], [(Text, Text)]) -> Bool
forall a. Eq a => a -> a -> Bool
/= (Text, [Text], [(Text, Text)])
nullAttr = -- use raw HTML
    (Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
blankline) (Doc Text -> Doc Text) -> (Text -> Doc Text) -> Text -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> (Text -> Text) -> Text -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.strip (Text -> Doc Text)
-> ReaderT WriterEnv (StateT WriterState m) Text -> MD m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
      WriterOptions
-> Pandoc -> ReaderT WriterEnv (StateT WriterState m) Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeHtml5String WriterOptions
opts{ writerTemplate :: Maybe (Template Text)
writerTemplate = Maybe (Template Text)
forall a. Maybe a
Nothing }
        (Meta -> [Block] -> Pandoc
Pandoc Meta
nullMeta [[Inline] -> Block
Para [(Text, [Text], [(Text, Text)])
-> [Inline] -> (Text, Text) -> Inline
Image (Text, [Text], [(Text, Text)])
attr [Inline]
alt (Text
src,Text
tgt)]])
  | Bool
otherwise = WriterOptions -> Block -> MD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> MD m (Doc Text)
blockToMarkdown WriterOptions
opts ([Inline] -> Block
Para [(Text, [Text], [(Text, Text)])
-> [Inline] -> (Text, Text) -> Inline
Image (Text, [Text], [(Text, Text)])
attr [Inline]
alt (Text
src,Text
tit)])
blockToMarkdown' WriterOptions
opts (Para [Inline]
inlines) =
  (Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
blankline) (Doc Text -> Doc Text) -> MD m (Doc Text) -> MD m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` WriterOptions -> Block -> MD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> MD m (Doc Text)
blockToMarkdown WriterOptions
opts ([Inline] -> Block
Plain [Inline]
inlines)
blockToMarkdown' WriterOptions
opts (LineBlock [[Inline]]
lns) =
  if Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_line_blocks WriterOptions
opts
  then do
    [Doc Text]
mdLines <- ([Inline] -> MD m (Doc Text))
-> [[Inline]]
-> ReaderT WriterEnv (StateT WriterState m) [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (WriterOptions -> [Inline] -> MD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> MD m (Doc Text)
inlineListToMarkdown WriterOptions
opts) [[Inline]]
lns
    Doc Text -> MD m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> MD m (Doc Text)) -> Doc Text -> MD 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]
mdLines) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
blankline
  else WriterOptions -> Block -> MD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> MD m (Doc Text)
blockToMarkdown WriterOptions
opts (Block -> MD m (Doc Text)) -> Block -> MD m (Doc Text)
forall a b. (a -> b) -> a -> b
$ [[Inline]] -> Block
linesToPara [[Inline]]
lns
blockToMarkdown' WriterOptions
opts b :: Block
b@(RawBlock Format
f Text
str) = do
  MarkdownVariant
variant <- (WriterEnv -> MarkdownVariant)
-> ReaderT WriterEnv (StateT WriterState m) MarkdownVariant
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> MarkdownVariant
envVariant
  let Format Text
fmt = Format
f
  let rawAttribBlock :: MD m (Doc Text)
rawAttribBlock = Doc Text -> MD m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> MD m (Doc Text)) -> Doc Text -> MD m (Doc Text)
forall a b. (a -> b) -> a -> b
$
         (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal 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
fmt 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
$$
         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
$$
         (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal 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
"\n")
  let renderEmpty :: MD m (Doc Text)
renderEmpty = Doc Text
forall a. Monoid a => a
mempty Doc Text
-> ReaderT WriterEnv (StateT WriterState m) () -> MD m (Doc Text)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ LogMessage -> ReaderT WriterEnv (StateT WriterState m) ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (Block -> LogMessage
BlockNotRendered Block
b)
  case MarkdownVariant
variant of
    MarkdownVariant
PlainText -> MD m (Doc Text)
renderEmpty
    MarkdownVariant
Commonmark
      | Format
f Format -> [Format] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Format
"gfm", Format
"commonmark", Format
"commonmark_x", Format
"markdown"]
         -> Doc Text -> MD m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> MD m (Doc Text)) -> Doc Text -> MD m (Doc Text)
forall a b. (a -> b) -> a -> b
$ 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
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
"\n"
    MarkdownVariant
Markdown
      | Format
f Format -> [Format] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Format
"markdown", Format
"markdown_github", Format
"markdown_phpextra",
                  Format
"markdown_mmd", Format
"markdown_strict"]
         -> Doc Text -> MD m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> MD m (Doc Text)) -> Doc Text -> MD m (Doc Text)
forall a b. (a -> b) -> a -> b
$ 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
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
"\n"
    MarkdownVariant
_ | Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_raw_attribute WriterOptions
opts -> MD m (Doc Text)
rawAttribBlock
      | Format
f Format -> [Format] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Format
"html", Format
"html5", Format
"html4"]
      , Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_markdown_attribute WriterOptions
opts
         -> Doc Text -> MD m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> MD m (Doc Text)) -> Doc Text -> MD m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Text
addMarkdownAttribute Text
str) 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
"\n"
      | Format
f Format -> [Format] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Format
"html", Format
"html5", Format
"html4"]
      , Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_raw_html WriterOptions
opts
         -> Doc Text -> MD m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> MD m (Doc Text)) -> Doc Text -> MD m (Doc Text)
forall a b. (a -> b) -> a -> b
$ 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
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
"\n"
      | Format
f Format -> [Format] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Format
"latex", Format
"tex"]
      , Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_raw_tex WriterOptions
opts
         -> Doc Text -> MD m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> MD m (Doc Text)) -> Doc Text -> MD m (Doc Text)
forall a b. (a -> b) -> a -> b
$ 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
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
"\n"
    MarkdownVariant
_ -> MD m (Doc Text)
renderEmpty
blockToMarkdown' WriterOptions
opts Block
HorizontalRule =
  Doc Text -> MD m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> MD m (Doc Text)) -> Doc Text -> MD 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
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Int -> Text -> Text
T.replicate (WriterOptions -> Int
writerColumns WriterOptions
opts) Text
"-") Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
blankline
blockToMarkdown' WriterOptions
opts (Header Int
level (Text, [Text], [(Text, Text)])
attr [Inline]
inlines) = do

  -- first, if we're putting references at the end of a section, we
  -- put them here.
  Int
blkLevel <- (WriterEnv -> Int) -> ReaderT WriterEnv (StateT WriterState m) Int
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Int
envBlockLevel
  Doc Text
refs <- if WriterOptions -> ReferenceLocation
writerReferenceLocation WriterOptions
opts ReferenceLocation -> ReferenceLocation -> Bool
forall a. Eq a => a -> a -> Bool
== ReferenceLocation
EndOfSection Bool -> Bool -> Bool
&& Int
blkLevel Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
          then WriterOptions -> MD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> MD m (Doc Text)
notesAndRefs WriterOptions
opts
          else Doc Text -> MD m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty

  MarkdownVariant
variant <- (WriterEnv -> MarkdownVariant)
-> ReaderT WriterEnv (StateT WriterState m) MarkdownVariant
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> MarkdownVariant
envVariant
  -- we calculate the id that would be used by auto_identifiers
  -- so we know whether to print an explicit identifier
  Set Text
ids <- (WriterState -> Set Text)
-> ReaderT WriterEnv (StateT WriterState m) (Set Text)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Set Text
stIds
  let autoId :: Text
autoId = Extensions -> [Inline] -> Set Text -> Text
uniqueIdent (WriterOptions -> Extensions
writerExtensions WriterOptions
opts) [Inline]
inlines Set Text
ids
  (WriterState -> WriterState)
-> ReaderT WriterEnv (StateT WriterState m) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState)
 -> ReaderT WriterEnv (StateT WriterState m) ())
-> (WriterState -> WriterState)
-> ReaderT WriterEnv (StateT WriterState m) ()
forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st{ stIds :: Set Text
stIds = Text -> Set Text -> Set Text
forall a. Ord a => a -> Set a -> Set a
Set.insert Text
autoId Set Text
ids }
  let attr' :: Doc Text
attr' = case (Text, [Text], [(Text, Text)])
attr of
                   (Text
"",[],[]) -> Doc Text
forall a. Doc a
empty
                   (Text
id',[],[]) | Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_auto_identifiers WriterOptions
opts
                                 Bool -> Bool -> Bool
&& Text
id' Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
autoId -> Doc Text
forall a. Doc a
empty
                   (Text
id',[Text]
_,[(Text, Text)]
_)   | Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_mmd_header_identifiers WriterOptions
opts ->
                                    Doc Text
forall a. Doc a
space Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
brackets (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
id')
                   (Text, [Text], [(Text, Text)])
_ | Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_header_attributes WriterOptions
opts Bool -> Bool -> Bool
||
                       Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_attributes WriterOptions
opts ->
                                    Doc Text
forall a. Doc a
space Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> (Text, [Text], [(Text, Text)]) -> Doc Text
attrsToMarkdown (Text, [Text], [(Text, Text)])
attr
                     | Bool
otherwise -> Doc Text
forall a. Doc a
empty
  Doc Text
contents <- WriterOptions -> [Inline] -> MD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> MD m (Doc Text)
inlineListToMarkdown WriterOptions
opts ([Inline] -> MD m (Doc Text)) -> [Inline] -> MD m (Doc Text)
forall a b. (a -> b) -> a -> b
$
                 -- ensure no newlines; see #3736
                 (Inline -> Inline) -> [Inline] -> [Inline]
forall a b. Walkable a b => (a -> a) -> b -> b
walk Inline -> Inline
lineBreakToSpace ([Inline] -> [Inline]) -> [Inline] -> [Inline]
forall a b. (a -> b) -> a -> b
$
                   if Int
level Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> Bool -> Bool
&& MarkdownVariant
variant MarkdownVariant -> MarkdownVariant -> Bool
forall a. Eq a => a -> a -> Bool
== MarkdownVariant
PlainText Bool -> Bool -> Bool
&&
                      Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_gutenberg WriterOptions
opts
                      then [Inline] -> [Inline]
forall a. Walkable Inline a => a -> a
capitalize [Inline]
inlines
                      else [Inline]
inlines

  let setext :: Bool
setext = WriterOptions -> Bool
writerSetextHeaders WriterOptions
opts
  Bool
-> ReaderT WriterEnv (StateT WriterState m) ()
-> ReaderT WriterEnv (StateT WriterState m) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
setext Bool -> Bool -> Bool
&& Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_literate_haskell WriterOptions
opts) (ReaderT WriterEnv (StateT WriterState m) ()
 -> ReaderT WriterEnv (StateT WriterState m) ())
-> ReaderT WriterEnv (StateT WriterState m) ()
-> ReaderT WriterEnv (StateT WriterState m) ()
forall a b. (a -> b) -> a -> b
$
    LogMessage -> ReaderT WriterEnv (StateT WriterState m) ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> ReaderT WriterEnv (StateT WriterState m) ())
-> LogMessage -> ReaderT WriterEnv (StateT WriterState m) ()
forall a b. (a -> b) -> a -> b
$ Int -> Text -> LogMessage
ATXHeadingInLHS Int
level (Maybe Int -> Doc Text -> Text
forall a. HasChars a => Maybe Int -> Doc a -> a
render Maybe Int
forall a. Maybe a
Nothing Doc Text
contents)

  let hdr :: Doc Text
hdr = 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
$ case Int
level of
            Int
1 | MarkdownVariant
variant MarkdownVariant -> MarkdownVariant -> Bool
forall a. Eq a => a -> a -> Bool
== MarkdownVariant
PlainText ->
                if Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_gutenberg WriterOptions
opts
                   then Int -> Doc Text
forall a. Int -> Doc a
blanklines Int
3 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
<> Int -> Doc Text
forall a. Int -> Doc a
blanklines Int
2
                   else Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
blankline
              | Bool
setext ->
                  Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
attr' 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
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Int -> Text -> Text
T.replicate (Doc Text -> Int
forall a. (IsString a, HasChars a) => Doc a -> Int
offset Doc Text
contents) Text
"=") Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>
                  Doc Text
forall a. Doc a
blankline
            Int
2 | MarkdownVariant
variant MarkdownVariant -> MarkdownVariant -> Bool
forall a. Eq a => a -> a -> Bool
== MarkdownVariant
PlainText ->
                if Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_gutenberg WriterOptions
opts
                   then Int -> Doc Text
forall a. Int -> Doc a
blanklines Int
2 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
forall a. Doc a
blankline
                   else Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
blankline
              | Bool
setext ->
                  Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
attr' 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
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Int -> Text -> Text
T.replicate (Doc Text -> Int
forall a. (IsString a, HasChars a) => Doc a -> Int
offset Doc Text
contents) Text
"-") Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>
                  Doc Text
forall a. Doc a
blankline
            -- ghc interprets '#' characters in column 1 as linenum specifiers.
            Int
_ | MarkdownVariant
variant MarkdownVariant -> MarkdownVariant -> Bool
forall a. Eq a => a -> a -> Bool
== MarkdownVariant
PlainText Bool -> Bool -> Bool
|| Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_literate_haskell WriterOptions
opts ->
                Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
blankline
            Int
_ -> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Int -> Text -> Text
T.replicate Int
level Text
"#") 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
<> Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
attr' Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
blankline

  Doc Text -> MD m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> MD m (Doc Text)) -> Doc Text -> MD m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
refs Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
hdr
blockToMarkdown' WriterOptions
opts (CodeBlock (Text
_,[Text]
classes,[(Text, Text)]
_) Text
str)
  | Text
"haskell" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes Bool -> Bool -> Bool
&& Text
"literate" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes Bool -> Bool -> Bool
&&
    Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_literate_haskell WriterOptions
opts =
  Doc Text -> MD m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> MD m (Doc Text)) -> Doc Text -> MD 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. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
blankline
blockToMarkdown' WriterOptions
opts (CodeBlock (Text, [Text], [(Text, Text)])
attribs Text
str) = do
  MarkdownVariant
variant <- (WriterEnv -> MarkdownVariant)
-> ReaderT WriterEnv (StateT WriterState m) MarkdownVariant
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> MarkdownVariant
envVariant
  Doc Text -> MD m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> MD m (Doc Text)) -> Doc Text -> MD m (Doc Text)
forall a b. (a -> b) -> a -> b
$
   case (Text, [Text], [(Text, Text)])
attribs (Text, [Text], [(Text, Text)])
-> (Text, [Text], [(Text, Text)]) -> Bool
forall a. Eq a => a -> a -> Bool
== (Text, [Text], [(Text, Text)])
nullAttr of
     Bool
False | MarkdownVariant
variant MarkdownVariant -> MarkdownVariant -> Bool
forall a. Eq a => a -> a -> Bool
== MarkdownVariant
Commonmark Bool -> Bool -> Bool
||
             Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_backtick_code_blocks WriterOptions
opts ->
          Doc Text
backticks Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
attrs 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
<> 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
forall a. Doc a
cr Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
backticks Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
blankline
           | Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_fenced_code_blocks WriterOptions
opts ->
          Doc Text
tildes Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
attrs 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
<> 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
forall a. Doc a
cr Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
tildes Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
blankline
     Bool
_ -> Int -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a
nest (WriterOptions -> Int
writerTabStop WriterOptions
opts) (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
forall a. Doc a
blankline
   where
     endlineLen :: Char -> Int
endlineLen Char
c = Int -> (NonEmpty Int -> Int) -> Maybe (NonEmpty Int) -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
3 ((Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int -> Int) -> (NonEmpty Int -> Int) -> NonEmpty Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Int -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum) (Maybe (NonEmpty Int) -> Int) -> Maybe (NonEmpty Int) -> Int
forall a b. (a -> b) -> a -> b
$ [Int] -> Maybe (NonEmpty Int)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty ([Int] -> Maybe (NonEmpty Int)) -> [Int] -> Maybe (NonEmpty Int)
forall a b. (a -> b) -> a -> b
$
                        [Text -> Int
T.length Text
ln
                         | Text
ln <- (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
trim (Text -> [Text]
T.lines Text
str)
                         , String -> Text
T.pack [Char
c,Char
c,Char
c] Text -> Text -> Bool
`T.isPrefixOf` Text
ln
                         , (Char -> Bool) -> Text -> Bool
T.all (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c) Text
ln]
     endline :: Char -> Doc Text
endline Char
c = 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 (Char -> Int
endlineLen Char
c) (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Char -> Text
T.singleton Char
c
     backticks :: Doc Text
backticks = Char -> Doc Text
endline Char
'`'
     tildes :: Doc Text
tildes = Char -> Doc Text
endline Char
'~'
     attrs :: Doc Text
attrs  = if Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_fenced_code_attributes WriterOptions
opts Bool -> Bool -> Bool
||
                 Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_attributes WriterOptions
opts
                 then 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
<> (Text, [Text], [(Text, Text)]) -> Doc Text
classOrAttrsToMarkdown (Text, [Text], [(Text, Text)])
attribs
                 else case (Text, [Text], [(Text, Text)])
attribs of
                            (Text
_,Text
cls:[Text]
_,[(Text, Text)]
_) -> 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
cls
                            (Text, [Text], [(Text, Text)])
_             -> Doc Text
forall a. Doc a
empty
blockToMarkdown' WriterOptions
opts (BlockQuote [Block]
blocks) = do
  MarkdownVariant
variant <- (WriterEnv -> MarkdownVariant)
-> ReaderT WriterEnv (StateT WriterState m) MarkdownVariant
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> MarkdownVariant
envVariant
  -- if we're writing literate haskell, put a space before the bird tracks
  -- so they won't be interpreted as lhs...
  let leader :: String
leader
        | Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_literate_haskell WriterOptions
opts = String
" > "
        | MarkdownVariant
variant MarkdownVariant -> MarkdownVariant -> Bool
forall a. Eq a => a -> a -> Bool
== MarkdownVariant
PlainText = String
"  "
        | Bool
otherwise            = String
"> "
  Doc Text
contents <- WriterOptions -> [Block] -> MD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> MD m (Doc Text)
blockListToMarkdown WriterOptions
opts [Block]
blocks
  Doc Text -> MD m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> MD m (Doc Text)) -> Doc Text -> MD 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
leader Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
blankline
blockToMarkdown' WriterOptions
opts t :: Block
t@(Table (Text, [Text], [(Text, Text)])
_ 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
  let numcols :: Int
numcols = NonEmpty Int -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Alignment] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Alignment]
aligns Int -> [Int] -> NonEmpty Int
forall a. a -> [a] -> NonEmpty a
:| [Double] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Double]
widths Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:
                           ([[Block]] -> Int) -> [[[Block]]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map [[Block]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([[Block]]
headers[[Block]] -> [[[Block]]] -> [[[Block]]]
forall a. a -> [a] -> [a]
:[[[Block]]]
rows))
  Doc Text
caption' <- WriterOptions -> [Inline] -> MD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> MD m (Doc Text)
inlineListToMarkdown WriterOptions
opts [Inline]
caption
  let caption'' :: Doc Text
caption''
        | [Inline] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
caption = Doc Text
forall a. Doc a
blankline
        | Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_table_captions WriterOptions
opts
        = 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. 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
        | Bool
otherwise = Doc Text
forall a. Doc a
blankline Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc 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
  let hasSimpleCells :: Bool
hasSimpleCells = [[[Block]]] -> Bool
onlySimpleTableCells ([[[Block]]] -> Bool) -> [[[Block]]] -> Bool
forall a b. (a -> b) -> a -> b
$ [[Block]]
headers [[Block]] -> [[[Block]]] -> [[[Block]]]
forall a. a -> [a] -> [a]
: [[[Block]]]
rows
  let isSimple :: Bool
isSimple = Bool
hasSimpleCells 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) [Double]
widths
  let isPlainBlock :: Block -> Bool
isPlainBlock (Plain [Inline]
_) = Bool
True
      isPlainBlock Block
_         = Bool
False
  let hasBlocks :: Bool
hasBlocks = Bool -> Bool
not ((Block -> Bool) -> [Block] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Block -> Bool
isPlainBlock ([Block] -> Bool) -> [Block] -> Bool
forall a b. (a -> b) -> a -> b
$ [[Block]] -> [Block]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Block]] -> [Block])
-> ([[[Block]]] -> [[Block]]) -> [[[Block]]] -> [Block]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[[Block]]] -> [[Block]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[[Block]]] -> [Block]) -> [[[Block]]] -> [Block]
forall a b. (a -> b) -> a -> b
$ [[Block]]
headers[[Block]] -> [[[Block]]] -> [[[Block]]]
forall a. a -> [a] -> [a]
:[[[Block]]]
rows)
  let padRow :: [Doc a] -> [Doc a]
padRow [Doc a]
r = case Int
numcols Int -> Int -> Int
forall a. Num a => a -> a -> a
- [Doc a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Doc a]
r of
                       Int
x | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 -> [Doc a]
r [Doc a] -> [Doc a] -> [Doc a]
forall a. [a] -> [a] -> [a]
++ Int -> Doc a -> [Doc a]
forall a. Int -> a -> [a]
replicate Int
x Doc a
forall a. Doc a
empty
                         | Bool
otherwise -> [Doc a]
r
  let aligns' :: [Alignment]
aligns' = case Int
numcols Int -> Int -> Int
forall a. Num a => a -> a -> a
- [Alignment] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Alignment]
aligns of
                     Int
x | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 -> [Alignment]
aligns [Alignment] -> [Alignment] -> [Alignment]
forall a. [a] -> [a] -> [a]
++ Int -> Alignment -> [Alignment]
forall a. Int -> a -> [a]
replicate Int
x Alignment
AlignDefault
                       | Bool
otherwise -> [Alignment]
aligns
  let widths' :: [Double]
widths' = case Int
numcols Int -> Int -> Int
forall a. Num a => a -> a -> a
- [Double] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Double]
widths of
                     Int
x | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 -> [Double]
widths [Double] -> [Double] -> [Double]
forall a. [a] -> [a] -> [a]
++ Int -> Double -> [Double]
forall a. Int -> a -> [a]
replicate Int
x Double
0.0
                       | Bool
otherwise -> [Double]
widths
  (Doc Text -> Doc Text
nst,Doc Text
tbl) <-
     case Bool
True of
          Bool
_ | Bool
isSimple Bool -> Bool -> Bool
&&
              Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_simple_tables WriterOptions
opts -> do
                [Doc Text]
rawHeaders <- [Doc Text] -> [Doc Text]
forall a. [Doc a] -> [Doc a]
padRow ([Doc Text] -> [Doc Text])
-> ReaderT WriterEnv (StateT WriterState m) [Doc Text]
-> ReaderT WriterEnv (StateT WriterState m) [Doc Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Block] -> MD m (Doc Text))
-> [[Block]] -> ReaderT WriterEnv (StateT WriterState m) [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (WriterOptions -> [Block] -> MD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> MD m (Doc Text)
blockListToMarkdown WriterOptions
opts) [[Block]]
headers
                [[Doc Text]]
rawRows <- ([[Block]] -> ReaderT WriterEnv (StateT WriterState m) [Doc Text])
-> [[[Block]]]
-> ReaderT WriterEnv (StateT WriterState m) [[Doc Text]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (([Doc Text] -> [Doc Text])
-> ReaderT WriterEnv (StateT WriterState m) [Doc Text]
-> ReaderT WriterEnv (StateT WriterState m) [Doc Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Doc Text] -> [Doc Text]
forall a. [Doc a] -> [Doc a]
padRow (ReaderT WriterEnv (StateT WriterState m) [Doc Text]
 -> ReaderT WriterEnv (StateT WriterState m) [Doc Text])
-> ([[Block]]
    -> ReaderT WriterEnv (StateT WriterState m) [Doc Text])
-> [[Block]]
-> ReaderT WriterEnv (StateT WriterState m) [Doc Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Block] -> MD m (Doc Text))
-> [[Block]] -> ReaderT WriterEnv (StateT WriterState m) [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (WriterOptions -> [Block] -> MD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> MD m (Doc Text)
blockListToMarkdown WriterOptions
opts))
                           [[[Block]]]
rows
                (Int -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a
nest Int
2,) (Doc Text -> (Doc Text -> Doc Text, Doc Text))
-> MD m (Doc Text)
-> ReaderT
     WriterEnv (StateT WriterState m) (Doc Text -> Doc Text, Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions
-> Bool
-> Bool
-> [Alignment]
-> [Double]
-> [Doc Text]
-> [[Doc Text]]
-> MD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions
-> Bool
-> Bool
-> [Alignment]
-> [Double]
-> [Doc Text]
-> [[Doc Text]]
-> MD m (Doc Text)
pandocTable WriterOptions
opts Bool
False (([Block] -> Bool) -> [[Block]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all [Block] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Block]]
headers)
                                [Alignment]
aligns' [Double]
widths' [Doc Text]
rawHeaders [[Doc Text]]
rawRows
            | Bool
isSimple Bool -> Bool -> Bool
&&
              Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_pipe_tables WriterOptions
opts -> do
                [Doc Text]
rawHeaders <- [Doc Text] -> [Doc Text]
forall a. [Doc a] -> [Doc a]
padRow ([Doc Text] -> [Doc Text])
-> ReaderT WriterEnv (StateT WriterState m) [Doc Text]
-> ReaderT WriterEnv (StateT WriterState m) [Doc Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Block] -> MD m (Doc Text))
-> [[Block]] -> ReaderT WriterEnv (StateT WriterState m) [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (WriterOptions -> [Block] -> MD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> MD m (Doc Text)
blockListToMarkdown WriterOptions
opts) [[Block]]
headers
                [[Doc Text]]
rawRows <- ([[Block]] -> ReaderT WriterEnv (StateT WriterState m) [Doc Text])
-> [[[Block]]]
-> ReaderT WriterEnv (StateT WriterState m) [[Doc Text]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (([Doc Text] -> [Doc Text])
-> ReaderT WriterEnv (StateT WriterState m) [Doc Text]
-> ReaderT WriterEnv (StateT WriterState m) [Doc Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Doc Text] -> [Doc Text]
forall a. [Doc a] -> [Doc a]
padRow (ReaderT WriterEnv (StateT WriterState m) [Doc Text]
 -> ReaderT WriterEnv (StateT WriterState m) [Doc Text])
-> ([[Block]]
    -> ReaderT WriterEnv (StateT WriterState m) [Doc Text])
-> [[Block]]
-> ReaderT WriterEnv (StateT WriterState m) [Doc Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Block] -> MD m (Doc Text))
-> [[Block]] -> ReaderT WriterEnv (StateT WriterState m) [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (WriterOptions -> [Block] -> MD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> MD m (Doc Text)
blockListToMarkdown WriterOptions
opts))
                           [[[Block]]]
rows
                (Doc Text -> Doc Text
forall a. a -> a
id,) (Doc Text -> (Doc Text -> Doc Text, Doc Text))
-> MD m (Doc Text)
-> ReaderT
     WriterEnv (StateT WriterState m) (Doc Text -> Doc Text, Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool
-> [Alignment] -> [Doc Text] -> [[Doc Text]] -> MD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Bool
-> [Alignment] -> [Doc Text] -> [[Doc Text]] -> MD m (Doc Text)
pipeTable (([Block] -> Bool) -> [[Block]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all [Block] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Block]]
headers) [Alignment]
aligns' [Doc Text]
rawHeaders [[Doc Text]]
rawRows
            | Bool -> Bool
not Bool
hasBlocks Bool -> Bool -> Bool
&&
              Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_multiline_tables WriterOptions
opts -> do
                [Doc Text]
rawHeaders <- [Doc Text] -> [Doc Text]
forall a. [Doc a] -> [Doc a]
padRow ([Doc Text] -> [Doc Text])
-> ReaderT WriterEnv (StateT WriterState m) [Doc Text]
-> ReaderT WriterEnv (StateT WriterState m) [Doc Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Block] -> MD m (Doc Text))
-> [[Block]] -> ReaderT WriterEnv (StateT WriterState m) [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (WriterOptions -> [Block] -> MD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> MD m (Doc Text)
blockListToMarkdown WriterOptions
opts) [[Block]]
headers
                [[Doc Text]]
rawRows <- ([[Block]] -> ReaderT WriterEnv (StateT WriterState m) [Doc Text])
-> [[[Block]]]
-> ReaderT WriterEnv (StateT WriterState m) [[Doc Text]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (([Doc Text] -> [Doc Text])
-> ReaderT WriterEnv (StateT WriterState m) [Doc Text]
-> ReaderT WriterEnv (StateT WriterState m) [Doc Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Doc Text] -> [Doc Text]
forall a. [Doc a] -> [Doc a]
padRow (ReaderT WriterEnv (StateT WriterState m) [Doc Text]
 -> ReaderT WriterEnv (StateT WriterState m) [Doc Text])
-> ([[Block]]
    -> ReaderT WriterEnv (StateT WriterState m) [Doc Text])
-> [[Block]]
-> ReaderT WriterEnv (StateT WriterState m) [Doc Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Block] -> MD m (Doc Text))
-> [[Block]] -> ReaderT WriterEnv (StateT WriterState m) [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (WriterOptions -> [Block] -> MD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> MD m (Doc Text)
blockListToMarkdown WriterOptions
opts))
                           [[[Block]]]
rows
                (Int -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a
nest Int
2,) (Doc Text -> (Doc Text -> Doc Text, Doc Text))
-> MD m (Doc Text)
-> ReaderT
     WriterEnv (StateT WriterState m) (Doc Text -> Doc Text, Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions
-> Bool
-> Bool
-> [Alignment]
-> [Double]
-> [Doc Text]
-> [[Doc Text]]
-> MD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions
-> Bool
-> Bool
-> [Alignment]
-> [Double]
-> [Doc Text]
-> [[Doc Text]]
-> MD m (Doc Text)
pandocTable WriterOptions
opts Bool
True (([Block] -> Bool) -> [[Block]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all [Block] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Block]]
headers)
                                [Alignment]
aligns' [Double]
widths' [Doc Text]
rawHeaders [[Doc Text]]
rawRows
            | Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_grid_tables WriterOptions
opts Bool -> Bool -> Bool
&&
               WriterOptions -> Int
writerColumns WriterOptions
opts Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
numcols -> (Doc Text -> Doc Text
forall a. a -> a
id,) (Doc Text -> (Doc Text -> Doc Text, Doc Text))
-> MD m (Doc Text)
-> ReaderT
     WriterEnv (StateT WriterState m) (Doc Text -> Doc Text, Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                WriterOptions
-> (WriterOptions -> [Block] -> MD m (Doc Text))
-> Bool
-> [Alignment]
-> [Double]
-> [[Block]]
-> [[[Block]]]
-> MD 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] -> MD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> MD m (Doc Text)
blockListToMarkdown
                  (([Block] -> Bool) -> [[Block]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all [Block] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Block]]
headers) [Alignment]
aligns' [Double]
widths' [[Block]]
headers [[[Block]]]
rows
            | Bool
hasSimpleCells Bool -> Bool -> Bool
&&
              Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_pipe_tables WriterOptions
opts -> do
                [Doc Text]
rawHeaders <- [Doc Text] -> [Doc Text]
forall a. [Doc a] -> [Doc a]
padRow ([Doc Text] -> [Doc Text])
-> ReaderT WriterEnv (StateT WriterState m) [Doc Text]
-> ReaderT WriterEnv (StateT WriterState m) [Doc Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Block] -> MD m (Doc Text))
-> [[Block]] -> ReaderT WriterEnv (StateT WriterState m) [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (WriterOptions -> [Block] -> MD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> MD m (Doc Text)
blockListToMarkdown WriterOptions
opts) [[Block]]
headers
                [[Doc Text]]
rawRows <- ([[Block]] -> ReaderT WriterEnv (StateT WriterState m) [Doc Text])
-> [[[Block]]]
-> ReaderT WriterEnv (StateT WriterState m) [[Doc Text]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (([Doc Text] -> [Doc Text])
-> ReaderT WriterEnv (StateT WriterState m) [Doc Text]
-> ReaderT WriterEnv (StateT WriterState m) [Doc Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Doc Text] -> [Doc Text]
forall a. [Doc a] -> [Doc a]
padRow (ReaderT WriterEnv (StateT WriterState m) [Doc Text]
 -> ReaderT WriterEnv (StateT WriterState m) [Doc Text])
-> ([[Block]]
    -> ReaderT WriterEnv (StateT WriterState m) [Doc Text])
-> [[Block]]
-> ReaderT WriterEnv (StateT WriterState m) [Doc Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Block] -> MD m (Doc Text))
-> [[Block]] -> ReaderT WriterEnv (StateT WriterState m) [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (WriterOptions -> [Block] -> MD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> MD m (Doc Text)
blockListToMarkdown WriterOptions
opts))
                           [[[Block]]]
rows
                (Doc Text -> Doc Text
forall a. a -> a
id,) (Doc Text -> (Doc Text -> Doc Text, Doc Text))
-> MD m (Doc Text)
-> ReaderT
     WriterEnv (StateT WriterState m) (Doc Text -> Doc Text, Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool
-> [Alignment] -> [Doc Text] -> [[Doc Text]] -> MD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Bool
-> [Alignment] -> [Doc Text] -> [[Doc Text]] -> MD m (Doc Text)
pipeTable (([Block] -> Bool) -> [[Block]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all [Block] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Block]]
headers) [Alignment]
aligns' [Doc Text]
rawHeaders [[Doc Text]]
rawRows
            | Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_raw_html WriterOptions
opts -> (Doc Text -> (Doc Text -> Doc Text, Doc Text))
-> MD m (Doc Text)
-> ReaderT
     WriterEnv (StateT WriterState m) (Doc Text -> Doc Text, Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Doc Text -> Doc Text
forall a. a -> a
id,) (MD m (Doc Text)
 -> ReaderT
      WriterEnv (StateT WriterState m) (Doc Text -> Doc Text, Doc Text))
-> MD m (Doc Text)
-> ReaderT
     WriterEnv (StateT WriterState m) (Doc Text -> Doc Text, Doc Text)
forall a b. (a -> b) -> a -> b
$
                   Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text)
-> ReaderT WriterEnv (StateT WriterState m) Text -> MD m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                   WriterOptions
-> Pandoc -> ReaderT WriterEnv (StateT WriterState m) Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeHtml5String WriterOptions
opts{ writerTemplate :: Maybe (Template Text)
writerTemplate = Maybe (Template Text)
forall a. Maybe a
Nothing } (Meta -> [Block] -> Pandoc
Pandoc Meta
nullMeta [Block
t])
            | Bool
otherwise -> (Doc Text -> Doc Text, Doc Text)
-> ReaderT
     WriterEnv (StateT WriterState m) (Doc Text -> Doc Text, Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> Doc Text
forall a. a -> a
id, Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
"[TABLE]")
  Doc Text -> MD m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> MD m (Doc Text)) -> Doc Text -> MD m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text -> Doc Text
nst (Doc Text
tbl Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc 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
blockToMarkdown' WriterOptions
opts (BulletList [[Block]]
items) = do
  [Doc Text]
contents <- ReaderT WriterEnv (StateT WriterState m) [Doc Text]
-> ReaderT WriterEnv (StateT WriterState m) [Doc Text]
forall (m :: * -> *) a. Monad m => MD m a -> MD m a
inList (ReaderT WriterEnv (StateT WriterState m) [Doc Text]
 -> ReaderT WriterEnv (StateT WriterState m) [Doc Text])
-> ReaderT WriterEnv (StateT WriterState m) [Doc Text]
-> ReaderT WriterEnv (StateT WriterState m) [Doc Text]
forall a b. (a -> b) -> a -> b
$ ([Block] -> MD m (Doc Text))
-> [[Block]] -> ReaderT WriterEnv (StateT WriterState m) [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (WriterOptions -> [Block] -> MD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> MD m (Doc Text)
bulletListItemToMarkdown WriterOptions
opts) [[Block]]
items
  Doc Text -> MD m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> MD m (Doc Text)) -> Doc Text -> MD m (Doc Text)
forall a b. (a -> b) -> a -> b
$ (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. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
blankline
blockToMarkdown' WriterOptions
opts (OrderedList (Int
start,ListNumberStyle
sty,ListNumberDelim
delim) [[Block]]
items) = do
  MarkdownVariant
variant <- (WriterEnv -> MarkdownVariant)
-> ReaderT WriterEnv (StateT WriterState m) MarkdownVariant
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> MarkdownVariant
envVariant
  let start' :: Int
start' = if MarkdownVariant
variant MarkdownVariant -> MarkdownVariant -> Bool
forall a. Eq a => a -> a -> Bool
== MarkdownVariant
Commonmark Bool -> Bool -> Bool
|| Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_startnum WriterOptions
opts
                  then Int
start
                  else Int
1
  let sty' :: ListNumberStyle
sty'   = if Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_fancy_lists WriterOptions
opts then ListNumberStyle
sty else ListNumberStyle
DefaultStyle
  let delim' :: ListNumberDelim
delim' = if Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_fancy_lists WriterOptions
opts then ListNumberDelim
delim else ListNumberDelim
DefaultDelim
  let attribs :: (Int, ListNumberStyle, ListNumberDelim)
attribs = (Int
start', ListNumberStyle
sty', ListNumberDelim
delim')
  let markers :: [Text]
markers  = (Int, ListNumberStyle, ListNumberDelim) -> [Text]
orderedListMarkers (Int, ListNumberStyle, ListNumberDelim)
attribs
  let markers' :: [Text]
markers' = (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (\Text
m -> if Text -> Int
T.length Text
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
3
                               then Text
m Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.replicate (Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Text -> Int
T.length Text
m) Text
" "
                               else Text
m) [Text]
markers
  [Doc Text]
contents <- ReaderT WriterEnv (StateT WriterState m) [Doc Text]
-> ReaderT WriterEnv (StateT WriterState m) [Doc Text]
forall (m :: * -> *) a. Monad m => MD m a -> MD m a
inList (ReaderT WriterEnv (StateT WriterState m) [Doc Text]
 -> ReaderT WriterEnv (StateT WriterState m) [Doc Text])
-> ReaderT WriterEnv (StateT WriterState m) [Doc Text]
-> ReaderT WriterEnv (StateT WriterState m) [Doc Text]
forall a b. (a -> b) -> a -> b
$
              (Text -> [Block] -> MD m (Doc Text))
-> [Text]
-> [[Block]]
-> ReaderT WriterEnv (StateT WriterState m) [Doc Text]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM (WriterOptions -> Text -> [Block] -> MD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Text -> [Block] -> MD m (Doc Text)
orderedListItemToMarkdown WriterOptions
opts) [Text]
markers' [[Block]]
items
  Doc Text -> MD m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> MD m (Doc Text)) -> Doc Text -> MD m (Doc Text)
forall a b. (a -> b) -> a -> b
$ (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. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
blankline
blockToMarkdown' WriterOptions
opts (DefinitionList [([Inline], [[Block]])]
items) = do
  [Doc Text]
contents <- ReaderT WriterEnv (StateT WriterState m) [Doc Text]
-> ReaderT WriterEnv (StateT WriterState m) [Doc Text]
forall (m :: * -> *) a. Monad m => MD m a -> MD m a
inList (ReaderT WriterEnv (StateT WriterState m) [Doc Text]
 -> ReaderT WriterEnv (StateT WriterState m) [Doc Text])
-> ReaderT WriterEnv (StateT WriterState m) [Doc Text]
-> ReaderT WriterEnv (StateT WriterState m) [Doc Text]
forall a b. (a -> b) -> a -> b
$ (([Inline], [[Block]]) -> MD m (Doc Text))
-> [([Inline], [[Block]])]
-> ReaderT WriterEnv (StateT WriterState m) [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (WriterOptions -> ([Inline], [[Block]]) -> MD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> ([Inline], [[Block]]) -> MD m (Doc Text)
definitionListItemToMarkdown WriterOptions
opts) [([Inline], [[Block]])]
items
  Doc Text -> MD m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> MD m (Doc Text)) -> Doc Text -> MD m (Doc Text)
forall a b. (a -> b) -> a -> b
$ [Doc Text] -> Doc Text
forall a. Monoid a => [a] -> a
mconcat [Doc Text]
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
blankline

inList :: Monad m => MD m a -> MD m a
inList :: MD m a -> MD m a
inList MD m a
p = (WriterEnv -> WriterEnv) -> MD m a -> MD m a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
env -> WriterEnv
env {envInList :: Bool
envInList = Bool
True}) MD m a
p

addMarkdownAttribute :: Text -> Text
addMarkdownAttribute :: Text -> Text
addMarkdownAttribute Text
s =
  case (Tag Text -> Bool) -> [Tag Text] -> ([Tag Text], [Tag Text])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Tag Text -> Bool
forall str. Tag str -> Bool
isTagText ([Tag Text] -> ([Tag Text], [Tag Text]))
-> [Tag Text] -> ([Tag Text], [Tag Text])
forall a b. (a -> b) -> a -> b
$ [Tag Text] -> [Tag Text]
forall a. [a] -> [a]
reverse ([Tag Text] -> [Tag Text]) -> [Tag Text] -> [Tag Text]
forall a b. (a -> b) -> a -> b
$ Text -> [Tag Text]
forall str. StringLike str => str -> [Tag str]
parseTags Text
s of
       ([Tag Text]
xs, TagOpen Text
t [(Text, Text)]
attrs:[Tag Text]
rest) ->
            [Tag Text] -> Text
renderTags' ([Tag Text] -> Text) -> [Tag Text] -> Text
forall a b. (a -> b) -> a -> b
$ [Tag Text] -> [Tag Text]
forall a. [a] -> [a]
reverse [Tag Text]
rest [Tag Text] -> [Tag Text] -> [Tag Text]
forall a. [a] -> [a] -> [a]
++ (Text -> [(Text, Text)] -> Tag Text
forall str. str -> [Attribute str] -> Tag str
TagOpen Text
t [(Text, Text)]
attrs' Tag Text -> [Tag Text] -> [Tag Text]
forall a. a -> [a] -> [a]
: [Tag Text] -> [Tag Text]
forall a. [a] -> [a]
reverse [Tag Text]
xs)
              where attrs' :: [(Text, Text)]
attrs' = (Text
"markdown",Text
"1")(Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
:[(Text
x,Text
y) | (Text
x,Text
y) <- [(Text, Text)]
attrs,
                                 Text
x Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"markdown"]
       ([Tag Text], [Tag Text])
_ -> Text
s

pipeTable :: PandocMonad m
          => Bool -> [Alignment] -> [Doc Text] -> [[Doc Text]]
          -> MD m (Doc Text)
pipeTable :: Bool
-> [Alignment] -> [Doc Text] -> [[Doc Text]] -> MD m (Doc Text)
pipeTable Bool
headless [Alignment]
aligns [Doc Text]
rawHeaders [[Doc Text]]
rawRows = do
  let sp :: Doc Text
sp = Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
" "
  let blockFor :: Alignment -> Int -> Doc Text -> Doc Text
blockFor Alignment
AlignLeft   Int
x Doc Text
y = Int -> Doc Text -> Doc Text
forall a. HasChars a => Int -> Doc a -> Doc a
lblock (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) (Doc Text
sp Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
y) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Int -> Doc Text -> Doc Text
forall a. HasChars a => Int -> Doc a -> Doc a
lblock Int
0 Doc Text
forall a. Doc a
empty
      blockFor Alignment
AlignCenter Int
x Doc Text
y = Int -> Doc Text -> Doc Text
forall a. HasChars a => Int -> Doc a -> Doc a
cblock (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) (Doc Text
sp Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
y Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
sp) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Int -> Doc Text -> Doc Text
forall a. HasChars a => Int -> Doc a -> Doc a
lblock Int
0 Doc Text
forall a. Doc a
empty
      blockFor Alignment
AlignRight  Int
x Doc Text
y = Int -> Doc Text -> Doc Text
forall a. HasChars a => Int -> Doc a -> Doc a
rblock (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) (Doc Text
y Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
sp) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Int -> Doc Text -> Doc Text
forall a. HasChars a => Int -> Doc a -> Doc a
lblock Int
0 Doc Text
forall a. Doc a
empty
      blockFor Alignment
_           Int
x Doc Text
y = Int -> Doc Text -> Doc Text
forall a. HasChars a => Int -> Doc a -> Doc a
lblock (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) (Doc Text
sp Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
y) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Int -> Doc Text -> Doc Text
forall a. HasChars a => Int -> Doc a -> Doc a
lblock Int
0 Doc Text
forall a. Doc a
empty
  let widths :: [Int]
widths = ([Doc Text] -> Int) -> [[Doc Text]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
3 (Int -> Int) -> ([Doc Text] -> Int) -> [Doc Text] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> (NonEmpty Int -> Int) -> Maybe (NonEmpty Int) -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
3 NonEmpty Int -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (Maybe (NonEmpty Int) -> Int)
-> ([Doc Text] -> Maybe (NonEmpty Int)) -> [Doc Text] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> Maybe (NonEmpty Int)
forall a. [a] -> Maybe (NonEmpty a)
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) ([[Doc Text]] -> [Int]) -> [[Doc Text]] -> [Int]
forall a b. (a -> b) -> a -> b
$
                     [[Doc Text]] -> [[Doc Text]]
forall a. [[a]] -> [[a]]
transpose ([Doc Text]
rawHeaders [Doc Text] -> [[Doc Text]] -> [[Doc Text]]
forall a. a -> [a] -> [a]
: [[Doc Text]]
rawRows)
  let torow :: [Doc Text] -> Doc Text
torow [Doc Text]
cs = 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
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
"|" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>
                    [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
hcat (Doc Text -> [Doc Text] -> [Doc Text]
forall a. a -> [a] -> [a]
intersperse (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
"|") ([Doc Text] -> [Doc Text]) -> [Doc Text] -> [Doc Text]
forall a b. (a -> b) -> a -> b
$
                          (Alignment -> Int -> Doc Text -> Doc Text)
-> [Alignment] -> [Int] -> [Doc Text] -> [Doc Text]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 Alignment -> Int -> Doc Text -> Doc Text
blockFor [Alignment]
aligns [Int]
widths ((Doc Text -> Doc Text) -> [Doc Text] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map Doc Text -> Doc Text
forall a. Doc a -> Doc a
chomp [Doc Text]
cs))
                    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
"|"
  let toborder :: Alignment -> Int -> Doc Text
toborder Alignment
a Int
w = Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ case Alignment
a of
                          Alignment
AlignLeft    -> Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.replicate (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Text
"-"
                          Alignment
AlignCenter  -> Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.replicate Int
w Text
"-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":"
                          Alignment
AlignRight   -> Int -> Text -> Text
T.replicate (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Text
"-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":"
                          Alignment
AlignDefault -> Int -> Text -> Text
T.replicate (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) Text
"-"
  -- note:  pipe tables can't completely lack a
  -- header; for a headerless table, we need a header of empty cells.
  -- see jgm/pandoc#1996.
  let header :: Doc Text
header = if Bool
headless
                  then [Doc Text] -> Doc Text
torow (Int -> Doc Text -> [Doc Text]
forall a. Int -> a -> [a]
replicate ([Alignment] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Alignment]
aligns) Doc Text
forall a. Doc a
empty)
                  else [Doc Text] -> Doc Text
torow [Doc Text]
rawHeaders
  let border :: Doc Text
border = 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
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
"|" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
hcat (Doc Text -> [Doc Text] -> [Doc Text]
forall a. a -> [a] -> [a]
intersperse (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
"|") ([Doc Text] -> [Doc Text]) -> [Doc Text] -> [Doc Text]
forall a b. (a -> b) -> a -> b
$
                        (Alignment -> Int -> Doc Text)
-> [Alignment] -> [Int] -> [Doc Text]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Alignment -> Int -> Doc Text
toborder [Alignment]
aligns [Int]
widths) 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
"|"
  let body :: Doc Text
body   = [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]]
rawRows
  Doc Text -> MD m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> MD m (Doc Text)) -> Doc Text -> MD m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
header 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
body

pandocTable :: PandocMonad m
            => WriterOptions -> Bool -> Bool -> [Alignment] -> [Double]
            -> [Doc Text] -> [[Doc Text]] -> MD m (Doc Text)
pandocTable :: WriterOptions
-> Bool
-> Bool
-> [Alignment]
-> [Double]
-> [Doc Text]
-> [[Doc Text]]
-> MD m (Doc Text)
pandocTable WriterOptions
opts Bool
multiline Bool
headless [Alignment]
aligns [Double]
widths [Doc Text]
rawHeaders [[Doc Text]]
rawRows = do
  let isSimple :: Bool
isSimple = (Double -> Bool) -> [Double] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
==Double
0) [Double]
widths
  let alignHeader :: Alignment -> Int -> Doc a -> Doc a
alignHeader Alignment
alignment = case Alignment
alignment of
                                Alignment
AlignLeft    -> Int -> Doc a -> Doc a
forall a. HasChars a => Int -> Doc a -> Doc a
lblock
                                Alignment
AlignCenter  -> Int -> Doc a -> Doc a
forall a. HasChars a => Int -> Doc a -> Doc a
cblock
                                Alignment
AlignRight   -> Int -> Doc a -> Doc a
forall a. HasChars a => Int -> Doc a -> Doc a
rblock
                                Alignment
AlignDefault -> Int -> Doc a -> Doc a
forall a. HasChars a => Int -> Doc a -> Doc a
lblock
  -- Number of characters per column necessary to output every cell
  -- without requiring a line break.
  -- The @+2@ is needed for specifying the alignment.
  let numChars :: [Doc Text] -> Int
numChars    = (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) (Int -> Int) -> ([Doc Text] -> Int) -> [Doc Text] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> (NonEmpty Int -> Int) -> Maybe (NonEmpty Int) -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 NonEmpty Int -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (Maybe (NonEmpty Int) -> Int)
-> ([Doc Text] -> Maybe (NonEmpty Int)) -> [Doc Text] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> Maybe (NonEmpty Int)
forall a. [a] -> Maybe (NonEmpty a)
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
  -- Number of characters per column necessary to output every cell
  -- without requiring a line break *inside a word*.
  -- The @+2@ is needed for specifying the alignment.
  let minNumChars :: [Doc Text] -> Int
minNumChars = (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) (Int -> Int) -> ([Doc Text] -> Int) -> [Doc Text] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> (NonEmpty Int -> Int) -> Maybe (NonEmpty Int) -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 NonEmpty Int -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (Maybe (NonEmpty Int) -> Int)
-> ([Doc Text] -> Maybe (NonEmpty Int)) -> [Doc Text] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> Maybe (NonEmpty Int)
forall a. [a] -> Maybe (NonEmpty a)
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. HasChars a => Doc a -> Int
minOffset
  let columns :: [[Doc Text]]
columns = [[Doc Text]] -> [[Doc Text]]
forall a. [[a]] -> [[a]]
transpose ([Doc Text]
rawHeaders [Doc Text] -> [[Doc Text]] -> [[Doc Text]]
forall a. a -> [a] -> [a]
: [[Doc Text]]
rawRows)
  -- minimal column width without wrapping a single word
  let relWidth :: a -> [Doc Text] -> Int
relWidth a
w [Doc Text]
col =
         Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (a -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor (a -> Int) -> a -> Int
forall a b. (a -> b) -> a -> b
$ Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (WriterOptions -> Int
writerColumns WriterOptions
opts Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) a -> a -> a
forall a. Num a => a -> a -> a
* a
w)
             (if WriterOptions -> WrapOption
writerWrapText WriterOptions
opts WrapOption -> WrapOption -> Bool
forall a. Eq a => a -> a -> Bool
== WrapOption
WrapAuto
                 then [Doc Text] -> Int
minNumChars [Doc Text]
col
                 else [Doc Text] -> Int
numChars [Doc Text]
col)
  let widthsInChars :: [Int]
widthsInChars
        | Bool
isSimple  = ([Doc Text] -> Int) -> [[Doc Text]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map [Doc Text] -> Int
numChars [[Doc Text]]
columns
        | Bool
otherwise = (Double -> [Doc Text] -> Int) -> [Double] -> [[Doc Text]] -> [Int]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Double -> [Doc Text] -> Int
forall a. RealFrac a => a -> [Doc Text] -> Int
relWidth [Double]
widths [[Doc Text]]
columns
  let makeRow :: [Doc Text] -> Doc Text
makeRow = [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
hcat ([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 (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
" ")) ([Doc Text] -> [Doc Text])
-> ([Doc Text] -> [Doc Text]) -> [Doc Text] -> [Doc Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                   (Alignment -> Int -> Doc Text -> Doc Text)
-> [Alignment] -> [Int] -> [Doc Text] -> [Doc Text]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 Alignment -> Int -> Doc Text -> Doc Text
forall a. HasChars a => Alignment -> Int -> Doc a -> Doc a
alignHeader [Alignment]
aligns [Int]
widthsInChars
  let rows' :: [Doc Text]
rows' = ([Doc Text] -> Doc Text) -> [[Doc Text]] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map [Doc Text] -> Doc Text
makeRow [[Doc Text]]
rawRows
  let head' :: Doc Text
head' = [Doc Text] -> Doc Text
makeRow [Doc Text]
rawHeaders
  let underline :: Doc Text
underline = [Doc Text] -> Doc Text
forall a. Monoid a => [a] -> a
mconcat ([Doc Text] -> Doc Text) -> [Doc Text] -> Doc Text
forall a b. (a -> b) -> a -> b
$ Doc Text -> [Doc Text] -> [Doc Text]
forall a. a -> [a] -> [a]
intersperse (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
" ") ([Doc Text] -> [Doc Text]) -> [Doc Text] -> [Doc Text]
forall a b. (a -> b) -> a -> b
$
                  (Int -> Doc Text) -> [Int] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
width -> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Int -> Text -> Text
T.replicate Int
width Text
"-")) [Int]
widthsInChars
  let border :: Doc Text
border
        | Bool
multiline = Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Int -> Text -> Text
T.replicate ([Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int]
widthsInChars Int -> Int -> Int
forall a. Num a => a -> a -> a
+
                        [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
widthsInChars Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Text
"-")
        | Bool
headless  = Doc Text
underline
        | Bool
otherwise = Doc Text
forall a. Doc a
empty
  let head'' :: Doc Text
head'' = if Bool
headless
                  then Doc Text
forall a. Doc a
empty
                  else Doc Text
border 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
head'
  let body :: Doc Text
body = if Bool
multiline
                then [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vsep [Doc Text]
rows' Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
                     if [Doc Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Doc Text]
rows' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2
                        then Doc Text
forall a. Doc a
blankline -- #4578
                        else Doc Text
forall a. Doc a
empty
                else [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat [Doc Text]
rows'
  let bottom :: Doc Text
bottom = if Bool
headless
                  then Doc Text
underline
                  else Doc Text
border
  Doc Text -> MD m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> MD m (Doc Text)) -> Doc Text -> MD m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
head'' Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
underline Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
body Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
bottom

itemEndsWithTightList :: [Block] -> Bool
itemEndsWithTightList :: [Block] -> Bool
itemEndsWithTightList [Block]
bs =
  case [Block]
bs of
        [Plain [Inline]
_, BulletList [[Block]]
xs]    -> [[Block]] -> Bool
isTightList [[Block]]
xs
        [Plain [Inline]
_, OrderedList (Int, ListNumberStyle, ListNumberDelim)
_ [[Block]]
xs] -> [[Block]] -> Bool
isTightList [[Block]]
xs
        [Block]
_                           -> Bool
False

-- | Convert bullet list item (list of blocks) to markdown.
bulletListItemToMarkdown :: PandocMonad m => WriterOptions -> [Block] -> MD m (Doc Text)
bulletListItemToMarkdown :: WriterOptions -> [Block] -> MD m (Doc Text)
bulletListItemToMarkdown WriterOptions
opts [Block]
bs = do
  let exts :: Extensions
exts = WriterOptions -> Extensions
writerExtensions WriterOptions
opts
  Doc Text
contents <- WriterOptions -> [Block] -> MD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> MD m (Doc Text)
blockListToMarkdown WriterOptions
opts ([Block] -> MD m (Doc Text)) -> [Block] -> MD m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Extensions -> [Block] -> [Block]
taskListItemToAscii Extensions
exts [Block]
bs
  let sps :: Text
sps = Int -> Text -> Text
T.replicate (WriterOptions -> Int
writerTabStop WriterOptions
opts Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2) Text
" "
  let start :: Doc Text
start = Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Text
"- " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
sps
  -- remove trailing blank line if item ends with a tight list
  let contents' :: Doc Text
contents' = if [Block] -> Bool
itemEndsWithTightList [Block]
bs
                     then Doc Text -> Doc Text
forall a. Doc a -> Doc a
chomp Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
cr
                     else Doc Text
contents
  Doc Text -> MD m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> MD m (Doc Text)) -> Doc Text -> MD 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 (WriterOptions -> Int
writerTabStop WriterOptions
opts) Doc Text
start Doc Text
contents'

-- | Convert ordered list item (a list of blocks) to markdown.
orderedListItemToMarkdown :: PandocMonad m
                          => WriterOptions -- ^ options
                          -> Text        -- ^ list item marker
                          -> [Block]       -- ^ list item (list of blocks)
                          -> MD m (Doc Text)
orderedListItemToMarkdown :: WriterOptions -> Text -> [Block] -> MD m (Doc Text)
orderedListItemToMarkdown WriterOptions
opts Text
marker [Block]
bs = do
  let exts :: Extensions
exts = WriterOptions -> Extensions
writerExtensions WriterOptions
opts
  Doc Text
contents <- WriterOptions -> [Block] -> MD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> MD m (Doc Text)
blockListToMarkdown WriterOptions
opts ([Block] -> MD m (Doc Text)) -> [Block] -> MD m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Extensions -> [Block] -> [Block]
taskListItemToAscii Extensions
exts [Block]
bs
  let sps :: Doc Text
sps = case WriterOptions -> Int
writerTabStop WriterOptions
opts Int -> Int -> Int
forall a. Num a => a -> a -> a
- Text -> Int
T.length Text
marker of
                   Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 -> 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 Int
n Text
" "
                   Int
_ -> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
" "
  let ind :: Int
ind = if Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_four_space_rule WriterOptions
opts
               then WriterOptions -> Int
writerTabStop WriterOptions
opts
               else Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (WriterOptions -> Int
writerTabStop WriterOptions
opts) (Text -> Int
T.length Text
marker Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
  let start :: Doc Text
start = Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
marker Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
sps
  -- remove trailing blank line if item ends with a tight list
  let contents' :: Doc Text
contents' = if [Block] -> Bool
itemEndsWithTightList [Block]
bs
                     then Doc Text -> Doc Text
forall a. Doc a -> Doc a
chomp Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
cr
                     else Doc Text
contents
  Doc Text -> MD m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> MD m (Doc Text)) -> Doc Text -> MD 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
ind Doc Text
start Doc Text
contents'

-- | Convert definition list item (label, list of blocks) to markdown.
definitionListItemToMarkdown :: PandocMonad m
                             => WriterOptions
                             -> ([Inline],[[Block]])
                             -> MD m (Doc Text)
definitionListItemToMarkdown :: WriterOptions -> ([Inline], [[Block]]) -> MD m (Doc Text)
definitionListItemToMarkdown WriterOptions
opts ([Inline]
label, [[Block]]
defs) = do
  Doc Text
labelText <- WriterOptions -> Block -> MD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> MD m (Doc Text)
blockToMarkdown WriterOptions
opts ([Inline] -> Block
Plain [Inline]
label)
  [[Doc Text]]
defs' <- ([Block] -> ReaderT WriterEnv (StateT WriterState m) [Doc Text])
-> [[Block]]
-> ReaderT WriterEnv (StateT WriterState m) [[Doc Text]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((Block -> MD m (Doc Text))
-> [Block] -> ReaderT WriterEnv (StateT WriterState m) [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (WriterOptions -> Block -> MD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> MD m (Doc Text)
blockToMarkdown WriterOptions
opts)) [[Block]]
defs
  if Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_definition_lists WriterOptions
opts
     then do
       let tabStop :: Int
tabStop = WriterOptions -> Int
writerTabStop WriterOptions
opts
       MarkdownVariant
variant <- (WriterEnv -> MarkdownVariant)
-> ReaderT WriterEnv (StateT WriterState m) MarkdownVariant
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> MarkdownVariant
envVariant
       let leader :: Doc Text
leader  = if MarkdownVariant
variant MarkdownVariant -> MarkdownVariant -> Bool
forall a. Eq a => a -> a -> Bool
== MarkdownVariant
PlainText then Doc Text
"   " else Doc Text
":  "
       let sps :: Doc Text
sps = case WriterOptions -> Int
writerTabStop WriterOptions
opts Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
3 of
                      Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0   -> 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 Int
n Text
" "
                      Int
_ -> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
" "
       let isTight :: Bool
isTight = case [[Block]]
defs of
                        ((Plain [Inline]
_ : [Block]
_): [[Block]]
_) -> Bool
True
                        [[Block]]
_                  -> Bool
False
       if Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_compact_definition_lists WriterOptions
opts
          then do
            let contents :: Doc Text
contents = [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]
d -> Int -> Doc Text -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a -> Doc a
hang Int
tabStop (Doc Text
leader Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
sps)
                                (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
vcat [Doc Text]
d Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
cr) [[Doc Text]]
defs'
            Doc Text -> MD m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> MD m (Doc Text)) -> Doc Text -> MD 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
labelText 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
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
cr
          else do
            let contents :: Doc Text
contents = (if Bool
isTight 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] -> 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]
d -> Int -> Doc Text -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a -> Doc a
hang Int
tabStop (Doc Text
leader Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
sps) (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
vcat [Doc Text]
d)
                            [[Doc Text]]
defs'
            Doc Text -> MD m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> MD m (Doc Text)) -> Doc Text -> MD 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 -> Doc Text
forall a. IsString a => Doc a -> Doc a
nowrap Doc Text
labelText Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
                     (if Bool
isTight then Doc Text
forall a. Doc a
empty else Doc Text
forall a. Doc a
blankline) 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
forall a. Doc a
blankline
     else
       Doc Text -> MD m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> MD m (Doc Text)) -> Doc Text -> MD 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
forall a. Doc a -> Doc a
chomp Doc Text
labelText 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
"  " 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] -> Doc Text
forall a. [Doc a] -> Doc a
vsep (([Doc Text] -> Doc Text) -> [[Doc Text]] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vsep [[Doc Text]]
defs') 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 markdown.
blockListToMarkdown :: PandocMonad m
                    => WriterOptions -- ^ Options
                    -> [Block]       -- ^ List of block elements
                    -> MD m (Doc Text)
blockListToMarkdown :: WriterOptions -> [Block] -> MD m (Doc Text)
blockListToMarkdown WriterOptions
opts [Block]
blocks = do
  Bool
inlist <- (WriterEnv -> Bool)
-> ReaderT WriterEnv (StateT WriterState m) Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Bool
envInList
  MarkdownVariant
variant <- (WriterEnv -> MarkdownVariant)
-> ReaderT WriterEnv (StateT WriterState m) MarkdownVariant
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> MarkdownVariant
envVariant
  -- a) insert comment between list and indented code block, or the
  -- code block will be treated as a list continuation paragraph
  -- b) change Plain to Para unless it's followed by a RawBlock
  -- or has a list as its parent (#3487)
  let fixBlocks :: [Block] -> [Block]
fixBlocks (Block
b : CodeBlock (Text, [Text], [(Text, Text)])
attr Text
x : [Block]
rest)
       | (Bool -> Bool
not (MarkdownVariant
variant MarkdownVariant -> MarkdownVariant -> Bool
forall a. Eq a => a -> a -> Bool
== MarkdownVariant
Commonmark Bool -> Bool -> Bool
||
               Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_backtick_code_blocks WriterOptions
opts Bool -> Bool -> Bool
||
                 Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_fenced_code_blocks WriterOptions
opts) Bool -> Bool -> Bool
||
              (Text, [Text], [(Text, Text)])
attr (Text, [Text], [(Text, Text)])
-> (Text, [Text], [(Text, Text)]) -> Bool
forall a. Eq a => a -> a -> Bool
== (Text, [Text], [(Text, Text)])
nullAttr)
            Bool -> Bool -> Bool
&& Block -> Bool
isListBlock Block
b
              = Block
b Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: Block
commentSep Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: (Text, [Text], [(Text, Text)]) -> Text -> Block
CodeBlock (Text, [Text], [(Text, Text)])
attr Text
x Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block] -> [Block]
fixBlocks [Block]
rest
      fixBlocks (b1 :: Block
b1@(BulletList [[Block]]
_) : b2 :: Block
b2@(BulletList [[Block]]
_) : [Block]
bs) =
           Block
b1 Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: Block
commentSep Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block] -> [Block]
fixBlocks (Block
b2Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
:[Block]
bs)
      fixBlocks (b1 :: Block
b1@(OrderedList (Int, ListNumberStyle, ListNumberDelim)
_ [[Block]]
_) : b2 :: Block
b2@(OrderedList (Int, ListNumberStyle, ListNumberDelim)
_ [[Block]]
_) : [Block]
bs) =
           Block
b1 Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: Block
commentSep Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block] -> [Block]
fixBlocks (Block
b2Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
:[Block]
bs)
      fixBlocks (b1 :: Block
b1@(DefinitionList [([Inline], [[Block]])]
_) : b2 :: Block
b2@(DefinitionList [([Inline], [[Block]])]
_) : [Block]
bs) =
           Block
b1 Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: Block
commentSep Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block] -> [Block]
fixBlocks (Block
b2Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
:[Block]
bs)
      fixBlocks (Plain [Inline]
ils : bs :: [Block]
bs@(RawBlock{}:[Block]
_)) =
           [Inline] -> Block
Plain [Inline]
ils Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block] -> [Block]
fixBlocks [Block]
bs
      fixBlocks (Plain [Inline]
ils : bs :: [Block]
bs@(Div{}:[Block]
_))
          | Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_fenced_divs WriterOptions
opts =
           [Inline] -> Block
Para [Inline]
ils Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block] -> [Block]
fixBlocks [Block]
bs
      fixBlocks (Plain [Inline]
ils : [Block]
bs) | Bool
inlist =
           [Inline] -> Block
Plain [Inline]
ils Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block] -> [Block]
fixBlocks [Block]
bs
      fixBlocks (Plain [Inline]
ils : [Block]
bs) =
           [Inline] -> Block
Para [Inline]
ils Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block] -> [Block]
fixBlocks [Block]
bs
      fixBlocks (r :: Block
r@(RawBlock Format
f Text
raw) : Block
b : [Block]
bs)
        | Bool -> Bool
not (Text -> Bool
T.null Text
raw)
        , Text -> Char
T.last Text
raw Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n' =
        case Block
b of
             Plain{}    -> Block
r Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block] -> [Block]
fixBlocks (Block
bBlock -> [Block] -> [Block]
forall a. a -> [a] -> [a]
:[Block]
bs)
             RawBlock{} -> Block
r Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block] -> [Block]
fixBlocks (Block
bBlock -> [Block] -> [Block]
forall a. a -> [a] -> [a]
:[Block]
bs)
             Block
_          -> Format -> Text -> Block
RawBlock Format
f (Text
raw Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n") Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block] -> [Block]
fixBlocks (Block
bBlock -> [Block] -> [Block]
forall a. a -> [a] -> [a]
:[Block]
bs) -- #4629
      fixBlocks (Block
x : [Block]
xs)             = Block
x Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block] -> [Block]
fixBlocks [Block]
xs
      fixBlocks []                   = []
      isListBlock :: Block -> Bool
isListBlock (BulletList [[Block]]
_)     = Bool
True
      isListBlock (OrderedList (Int, ListNumberStyle, ListNumberDelim)
_ [[Block]]
_)  = Bool
True
      isListBlock (DefinitionList [([Inline], [[Block]])]
_) = Bool
True
      isListBlock Block
_                  = Bool
False
      commentSep :: Block
commentSep
        | MarkdownVariant
variant MarkdownVariant -> MarkdownVariant -> Bool
forall a. Eq a => a -> a -> Bool
== MarkdownVariant
PlainText        = Block
Null
        | Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_raw_html WriterOptions
opts = Format -> Text -> Block
RawBlock Format
"html" Text
"<!-- -->\n"
        | Bool
otherwise                   = Format -> Text -> Block
RawBlock Format
"markdown" Text
"&nbsp;\n"
  [Doc Text] -> Doc Text
forall a. Monoid a => [a] -> a
mconcat ([Doc Text] -> Doc Text)
-> ReaderT WriterEnv (StateT WriterState m) [Doc Text]
-> MD m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Block -> MD m (Doc Text))
-> [Block] -> ReaderT WriterEnv (StateT WriterState m) [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (WriterOptions -> Block -> MD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> MD m (Doc Text)
blockToMarkdown WriterOptions
opts) ([Block] -> [Block]
fixBlocks [Block]
blocks)

lineBreakToSpace :: Inline -> Inline
lineBreakToSpace :: Inline -> Inline
lineBreakToSpace Inline
LineBreak = Inline
Space
lineBreakToSpace Inline
SoftBreak = Inline
Space
lineBreakToSpace Inline
x         = Inline
x