{-# LANGUAGE NoImplicitPrelude   #-}
{-# LANGUAGE MultiWayIf          #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections       #-}
{-# LANGUAGE ViewPatterns        #-}
{- |
   Module      : Text.Pandoc.Writers.Markdown
   Copyright   : Copyright (C) 2006-2019 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:  <http://daringfireball.net/projects/markdown/>
-}
module Text.Pandoc.Writers.Markdown (writeMarkdown, writePlain) where
import Prelude
import Control.Monad.Reader
import Control.Monad.State.Strict
import Data.Char (isAlphaNum)
import Data.Default
import Data.List (find, intersperse, sortBy, transpose)
import qualified Data.Map as M
import Data.Maybe (fromMaybe, catMaybes)
import Data.Ord (comparing)
import qualified Data.Set as Set
import Data.Text (Text)
import qualified Data.Text as T
import Network.HTTP (urlEncode)
import Text.HTML.TagSoup (Tag (..), isTagText, parseTags)
import Text.Pandoc.Class (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.Math (texMathToInlines)
import Text.Pandoc.XML (toHtml5Entities)

type Notes = [[Block]]
type Ref   = (Text, Target, Attr)
type Refs  = [Ref]

type MD m = ReaderT WriterEnv (StateT WriterState m)

evalMD :: PandocMonad m => MD m a -> WriterEnv -> WriterState -> m a
evalMD :: MD m a -> WriterEnv -> WriterState -> m a
evalMD md :: MD m a
md env :: WriterEnv
env st :: WriterState
st = StateT WriterState m a -> WriterState -> m a
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (MD m a -> WriterEnv -> StateT WriterState m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT MD m a
md WriterEnv
env) WriterState
st

data WriterEnv = WriterEnv { WriterEnv -> Bool
envInList          :: Bool
                           , WriterEnv -> Bool
envPlain           :: Bool
                           , WriterEnv -> Bool
envRefShortcutable :: Bool
                           , WriterEnv -> Int
envBlockLevel      :: Int
                           , WriterEnv -> Bool
envEscapeSpaces    :: Bool
                           }

instance Default WriterEnv
  where def :: WriterEnv
def = WriterEnv :: Bool -> Bool -> Bool -> Int -> Bool -> WriterEnv
WriterEnv { envInList :: Bool
envInList         = Bool
False
                        , envPlain :: Bool
envPlain          = Bool
False
                        , envRefShortcutable :: Bool
envRefShortcutable = Bool
True
                        , envBlockLevel :: Int
envBlockLevel      = 0
                        , envEscapeSpaces :: Bool
envEscapeSpaces    = Bool
False
                        }

data WriterState = WriterState { WriterState -> Notes
stNotes   :: Notes
                               , WriterState -> Refs
stPrevRefs :: Refs
                               , WriterState -> Refs
stRefs    :: Refs
                               , WriterState -> Map Key (Map (Target, Attr) Int)
stKeys    :: M.Map Key
                                                (M.Map (Target, Attr) Int)
                               , WriterState -> Int
stLastIdx  :: Int
                               , WriterState -> Set Text
stIds     :: Set.Set Text
                               , WriterState -> Int
stNoteNum :: Int
                               }

instance Default WriterState
  where def :: WriterState
def = WriterState :: Notes
-> Refs
-> Refs
-> Map Key (Map (Target, Attr) Int)
-> Int
-> Set Text
-> Int
-> WriterState
WriterState{ stNotes :: Notes
stNotes = []
                         , stPrevRefs :: Refs
stPrevRefs = []
                         , stRefs :: Refs
stRefs = []
                         , stKeys :: Map Key (Map (Target, Attr) Int)
stKeys = Map Key (Map (Target, Attr) Int)
forall k a. Map k a
M.empty
                         , stLastIdx :: Int
stLastIdx = 0
                         , stIds :: Set Text
stIds = Set Text
forall a. Set a
Set.empty
                         , stNoteNum :: Int
stNoteNum = 1
                         }

-- | Convert Pandoc to Markdown.
writeMarkdown :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writeMarkdown :: WriterOptions -> Pandoc -> m Text
writeMarkdown opts :: WriterOptions
opts document :: 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 opts :: WriterOptions
opts document :: 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{ envPlain :: Bool
envPlain = Bool
True } WriterState
forall a. Default a => a
def

pandocTitleBlock :: Doc Text -> [Doc Text] -> Doc Text -> Doc Text
pandocTitleBlock :: Doc Text -> [Doc Text] -> Doc Text -> Doc Text
pandocTitleBlock tit :: Doc Text
tit auths :: [Doc Text]
auths dat :: Doc Text
dat =
  Int -> Doc Text -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a -> Doc a
hang 2 (String -> Doc Text
forall a. HasChars a => String -> Doc a
text "% ") 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 2 (String -> Doc Text
forall a. HasChars a => String -> Doc a
text "% ") ([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 2 (String -> Doc Text
forall a. HasChars a => String -> Doc a
text "% ") 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 hashmap :: 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, Val Text) -> Ordering)
-> [(Text, Val Text)] -> [(Text, Val Text)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((Text, Val Text) -> Text)
-> (Text, Val Text) -> (Text, Val Text) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (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 (k :: Text
k,v :: 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
               (k' :: Doc a
k', ListVal xs :: [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
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]
forall a b. (a -> b) -> a -> b
$
                                          [Maybe (Doc a)] -> [Doc a]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (Doc a)] -> [Doc a]) -> [Maybe (Doc a)] -> [Doc a]
forall a b. (a -> b) -> a -> b
$ (Val a -> Maybe (Doc a)) -> [Val a] -> [Maybe (Doc a)]
forall a b. (a -> b) -> [a] -> [b]
map Val a -> Maybe (Doc a)
forall a b. FromContext a b => Val a -> Maybe b
fromVal [Val a]
xs)
               (k' :: Doc a
k', SimpleVal x :: 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
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 2 (Doc a -> Doc a
forall a. Doc a -> Doc a
chomp (Doc a -> Doc a
forall a. HasChars a => Doc a -> Doc a
removeBlankLines Doc a
x))
               _                  -> 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 "." Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a
forall a. Doc a
cr
        removeBlankLines (Concat x :: Doc a
x y :: 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 x :: 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 tit :: Doc Text
tit auths :: [Doc Text]
auths dat :: 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 "; ") [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 v :: Context Text
v = "---" 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
$$ "---"

contextToYaml :: Context Text -> Doc Text
contextToYaml :: Context Text -> Doc Text
contextToYaml (Context o :: 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, Val Text) -> Ordering)
-> [(Text, Val Text)] -> [(Text, Val Text)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((Text, Val Text) -> Text)
-> (Text, Val Text) -> (Text, Val Text) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (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 (k :: Text
k,v :: 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
               (k' :: Doc Text
k', ListVal vs :: [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
forall a. Doc a -> Doc a -> Doc a
$$ Val Text -> Doc Text
valToYaml Val Text
v
               (k' :: Doc Text
k', MapVal (Context m :: 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
<> ": {}"
                 | Bool
otherwise      -> (Doc Text
k' Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> ":") 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 2 (Val Text -> Doc Text
valToYaml Val Text
v)
               (_, SimpleVal x :: Doc Text
x)
                     | Doc Text -> Bool
forall a. Doc a -> Bool
isEmpty Doc Text
x  -> Doc Text
forall a. Doc a
empty
               (_, NullVal)       -> Doc Text
forall a. Doc a
empty
               (k' :: Doc Text
k', _)            -> Doc Text
k' Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> ":" 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 2 "" (Val Text -> Doc Text
valToYaml Val Text
v)

valToYaml :: Val Text -> Doc Text
valToYaml :: Val Text -> Doc Text
valToYaml (ListVal xs :: [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 (\v :: Val Text
v -> Int -> Doc Text -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a -> Doc a
hang 2 "- " (Val Text -> Doc Text
valToYaml Val Text
v)) [Val Text]
xs
valToYaml (MapVal c :: Context Text
c) = Context Text -> Doc Text
contextToYaml Context Text
c
valToYaml (SimpleVal x :: 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 0 ("|" 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 (Text -> Bool) -> Doc Text -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Text -> Bool
hasPunct Doc Text
x
           then "'" 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
escapeSingleQuotes Doc Text
x Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> "'"
           else Doc Text
x
    where
      hasNewlines :: Doc a -> Bool
hasNewlines NewLine = Bool
True
      hasNewlines BlankLines{} = Bool
True
      hasNewlines CarriageReturn = Bool
True
      hasNewlines (Concat w :: Doc a
w z :: Doc a
z) = Doc a -> Bool
hasNewlines Doc a
w Bool -> Bool -> Bool
|| Doc a -> Bool
hasNewlines Doc a
z
      hasNewlines _ = Bool
False
      hasPunct :: Text -> Bool
hasPunct = (Char -> Bool) -> Text -> Bool
T.any Char -> Bool
isYamlPunct
      isYamlPunct :: Char -> Bool
isYamlPunct = (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ['-','?',':',',','[',']','{','}',
                             '#','&','*','!','|','>','\'','"',
                             '%','@','`',',','[',']','{','}'])
      escapeSingleQuotes :: Text -> Text
escapeSingleQuotes = Text -> Text -> Text -> Text
T.replace "'" "''"
valToYaml _ = 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 opts :: WriterOptions
opts (Pandoc meta :: Meta
meta blocks :: [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
  Bool
isPlain <- (WriterEnv -> Bool)
-> ReaderT WriterEnv (StateT WriterState m) Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Bool
envPlain
  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 -> (Doc Text -> Doc Text) -> Maybe (Doc Text) -> Doc Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc Text
forall a. Doc a
empty Doc Text -> Doc Text
forall a. a -> a
id (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 "title" Context Text
metadata
  let authors' :: [Doc Text]
authors' = [Doc Text]
-> ([Doc Text] -> [Doc Text]) -> Maybe [Doc Text] -> [Doc Text]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] [Doc Text] -> [Doc Text]
forall a. a -> a
id (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 "author" Context Text
metadata
  let date' :: Doc Text
date' = Doc Text -> (Doc Text -> Doc Text) -> Maybe (Doc Text) -> Doc Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc Text
forall a. Doc a
empty Doc Text -> Doc Text
forall a. a -> a
id (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 "date" Context Text
metadata
  let titleblock :: Doc Text
titleblock = case WriterOptions -> Maybe (Template Text)
writerTemplate WriterOptions
opts of
                        Just _ | Bool
isPlain ->
                                 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
                        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 ("refs",_,_) _):xs :: [Block]
xs -> [Block] -> [Block]
forall a. [a] -> [a]
reverse [Block]
xs
                             _                       -> [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 "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 "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 "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 "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
       Nothing  -> Doc Text
main
       Just tpl :: 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 opts :: WriterOptions
opts refs :: Refs
refs = (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 ReaderT WriterEnv (StateT WriterState 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 -> MD m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> MD m (Doc Text))
-> ([Doc Text] -> Doc Text) -> [Doc Text] -> MD m (Doc Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat

-- | Return markdown representation of a reference key.
keyToMarkdown :: PandocMonad m
              => WriterOptions
              -> Ref
              -> MD m (Doc Text)
keyToMarkdown :: WriterOptions -> Ref -> MD m (Doc Text)
keyToMarkdown opts :: WriterOptions
opts (label' :: Text
label', (src :: Text
src, tit :: Text
tit), attr :: Attr
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
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 -> 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 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 2
            ("[" 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
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 -> Attr -> Doc Text
linkAttributes WriterOptions
opts Attr
attr

-- | Return markdown representation of notes.
notesToMarkdown :: PandocMonad m => WriterOptions -> [[Block]] -> MD m (Doc Text)
notesToMarkdown :: WriterOptions -> Notes -> MD m (Doc Text)
notesToMarkdown opts :: WriterOptions
opts notes :: Notes
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 (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\(num :: Int
num, note :: [Block]
note) -> WriterOptions -> Int -> [Block] -> MD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Int -> [Block] -> MD m (Doc Text)
noteToMarkdown WriterOptions
opts Int
num [Block]
note) ([Int] -> Notes -> [(Int, [Block])]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
n..] Notes
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
$ \st :: WriterState
st -> WriterState
st { stNoteNum :: Int
stNoteNum = WriterState -> Int
stNoteNum WriterState
st Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Notes -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Notes
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 opts :: WriterOptions
opts num :: Int
num blocks :: [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 "[^" 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 "]:"
                  else Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal "[" 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 "]"
  let markerSize :: Int
markerSize = 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
                     n :: Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 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 -> Doc Text
forall a. HasChars a => a -> Doc a
literal " "
  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

-- | Escape special characters for Markdown.
escapeText :: WriterOptions -> Text -> Text
escapeText :: WriterOptions -> Text -> Text
escapeText opts :: WriterOptions
opts =
  (if WriterOptions -> Bool
writerPreferAscii WriterOptions
opts
      then Text -> Text
toHtml5Entities
      else Text -> Text
forall a. a -> a
id) (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> (Text -> String) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
go (String -> String) -> (Text -> String) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack
  where
  go :: String -> String
go [] = []
  go (c :: Char
c:cs :: String
cs) =
    case Char
c of
       '<' | Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_all_symbols_escapable WriterOptions
opts ->
              '\\' Char -> String -> String
forall a. a -> [a] -> [a]
: '<' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
go String
cs
           | Bool
otherwise -> "&lt;" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
go String
cs
       '>' | Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_all_symbols_escapable WriterOptions
opts ->
              '\\' Char -> String -> String
forall a. a -> [a] -> [a]
: '>' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
go String
cs
           | Bool
otherwise -> "&gt;" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
go String
cs
       '@' | Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_citations WriterOptions
opts ->
               case String
cs of
                    (d :: Char
d:_)
                      | Char -> Bool
isAlphaNum Char
d Bool -> Bool -> Bool
|| Char
d Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '_'
                         -> '\\'Char -> String -> String
forall a. a -> [a] -> [a]
:'@'Char -> String -> String
forall a. a -> [a] -> [a]
:String -> String
go String
cs
                    _ -> '@'Char -> String -> String
forall a. a -> [a] -> [a]
:String -> String
go String
cs
       _ | Char
c Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ['\\','`','*','_','[',']','#'] ->
              '\\'Char -> String -> String
forall a. a -> [a] -> [a]
:Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:String -> String
go String
cs
       '|' | Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_pipe_tables WriterOptions
opts -> '\\'Char -> String -> String
forall a. a -> [a] -> [a]
:'|'Char -> String -> String
forall a. a -> [a] -> [a]
:String -> String
go String
cs
       '^' | Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_superscript WriterOptions
opts -> '\\'Char -> String -> String
forall a. a -> [a] -> [a]
:'^'Char -> String -> String
forall a. a -> [a] -> [a]
:String -> String
go String
cs
       '~' | Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_subscript WriterOptions
opts Bool -> Bool -> Bool
||
             Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_strikeout WriterOptions
opts -> '\\'Char -> String -> String
forall a. a -> [a] -> [a]
:'~'Char -> String -> String
forall a. a -> [a] -> [a]
:String -> String
go String
cs
       '$' | Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_tex_math_dollars WriterOptions
opts -> '\\'Char -> String -> String
forall a. a -> [a] -> [a]
:'$'Char -> String -> String
forall a. a -> [a] -> [a]
:String -> String
go String
cs
       '\'' | Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_smart WriterOptions
opts -> '\\'Char -> String -> String
forall a. a -> [a] -> [a]
:'\''Char -> String -> String
forall a. a -> [a] -> [a]
:String -> String
go String
cs
       '"' | Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_smart WriterOptions
opts -> '\\'Char -> String -> String
forall a. a -> [a] -> [a]
:'"'Char -> String -> String
forall a. a -> [a] -> [a]
:String -> String
go String
cs
       '-' | Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_smart WriterOptions
opts ->
              case String
cs of
                   '-':_ -> '\\'Char -> String -> String
forall a. a -> [a] -> [a]
:'-'Char -> String -> String
forall a. a -> [a] -> [a]
:String -> String
go String
cs
                   _     -> '-'Char -> String -> String
forall a. a -> [a] -> [a]
:String -> String
go String
cs
       '.' | Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_smart WriterOptions
opts ->
              case String
cs of
                   '.':'.':rest :: String
rest -> '\\'Char -> String -> String
forall a. a -> [a] -> [a]
:'.'Char -> String -> String
forall a. a -> [a] -> [a]
:'.'Char -> String -> String
forall a. a -> [a] -> [a]
:'.'Char -> String -> String
forall a. a -> [a] -> [a]
:String -> String
go String
rest
                   _            -> '.'Char -> String -> String
forall a. a -> [a] -> [a]
:String -> String
go String
cs
       _   -> Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
go String
cs

attrsToMarkdown :: Attr -> Doc Text
attrsToMarkdown :: Attr -> Doc Text
attrsToMarkdown attribs :: Attr
attribs = Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
braces (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
hsep [Doc Text
attribId, Doc Text
attribClasses, Doc Text
attribKeys]
        where attribId :: Doc Text
attribId = case Attr
attribs of
                                ("",_,_) -> Doc Text
forall a. Doc a
empty
                                (i :: Text
i,_,_)  -> "#" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
escAttr Text
i
              attribClasses :: Doc Text
attribClasses = case Attr
attribs of
                                (_,[],_) -> Doc Text
forall a. Doc a
empty
                                (_,cs :: [Text]
cs,_) -> [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
hsep ([Doc Text] -> Doc Text) -> [Doc Text] -> Doc Text
forall a b. (a -> b) -> a -> b
$
                                            (Text -> Doc Text) -> [Text] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Doc Text
escAttr (Text -> Doc Text) -> (Text -> Text) -> Text -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ("."Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>))
                                            [Text]
cs
              attribKeys :: Doc Text
attribKeys = case Attr
attribs of
                                (_,_,[]) -> Doc Text
forall a. Doc a
empty
                                (_,_,ks :: [Target]
ks) -> [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
hsep ([Doc Text] -> Doc Text) -> [Doc Text] -> Doc Text
forall a b. (a -> b) -> a -> b
$
                                            (Target -> Doc Text) -> [Target] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map (\(k :: Text
k,v :: Text
v) -> Text -> Doc Text
escAttr Text
k
                                              Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> "=\"" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>
                                              Text -> Doc Text
escAttr Text
v Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> "\"") [Target]
ks
              escAttr :: Text -> Doc Text
escAttr          = [Doc Text] -> Doc Text
forall a. Monoid a => [a] -> a
mconcat ([Doc Text] -> Doc Text)
-> (Text -> [Doc Text]) -> Text -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Doc Text) -> String -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Doc Text
escAttrChar (String -> [Doc Text]) -> (Text -> String) -> Text -> [Doc Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack
              escAttrChar :: Char -> Doc Text
escAttrChar '"'  = Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal "\\\""
              escAttrChar '\\' = Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal "\\\\"
              escAttrChar c :: 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
$ Char -> Text
T.singleton Char
c

linkAttributes :: WriterOptions -> Attr -> Doc Text
linkAttributes :: WriterOptions -> Attr -> Doc Text
linkAttributes opts :: WriterOptions
opts attr :: Attr
attr =
  if Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_link_attributes WriterOptions
opts Bool -> Bool -> Bool
&& Attr
attr Attr -> Attr -> Bool
forall a. Eq a => a -> a -> Bool
/= Attr
nullAttr
     then Attr -> Doc Text
attrsToMarkdown Attr
attr
     else Doc Text
forall a. Doc a
empty

-- | Ordered list start parser for use in Para below.
olMarker :: Parser Text ParserState ()
olMarker :: Parser Text ParserState ()
olMarker = do (start :: Int
start, style' :: ListNumberStyle
style', delim :: ListNumberDelim
delim) <- ParserT
  Text ParserState Identity (Int, ListNumberStyle, ListNumberDelim)
forall s (m :: * -> *).
Stream s m 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` [1, 5, 10, 50, 100, 500, 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 str :: 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 "para start" (Int -> Text -> Text
T.take 10 Text
str) of
         Left  _ -> Bool
False
         Right _ -> Bool
True

notesAndRefs :: PandocMonad m => WriterOptions -> MD m (Doc Text)
notesAndRefs :: WriterOptions -> MD m (Doc Text)
notesAndRefs opts :: WriterOptions
opts = do
  Doc Text
notes' <- Notes -> Notes
forall a. [a] -> [a]
reverse (Notes -> Notes)
-> ReaderT WriterEnv (StateT WriterState m) Notes
-> ReaderT WriterEnv (StateT WriterState m) Notes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (WriterState -> Notes)
-> ReaderT WriterEnv (StateT WriterState m) Notes
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Notes
stNotes ReaderT WriterEnv (StateT WriterState m) Notes
-> (Notes -> MD m (Doc Text)) -> MD m (Doc Text)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= WriterOptions -> Notes -> MD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Notes -> MD m (Doc Text)
notesToMarkdown WriterOptions
opts
  (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
$ \s :: WriterState
s -> WriterState
s { stNotes :: Notes
stNotes = [] }
  Doc Text
refs' <- Refs -> Refs
forall a. [a] -> [a]
reverse (Refs -> Refs)
-> ReaderT WriterEnv (StateT WriterState m) Refs
-> ReaderT WriterEnv (StateT WriterState m) Refs
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (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
  (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
$ \s :: 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 opts :: WriterOptions
opts blk :: 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 (\env :: WriterEnv
env -> WriterEnv
env {envBlockLevel :: Int
envBlockLevel = WriterEnv -> Int
envBlockLevel WriterEnv
env Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 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
== 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
>>= (\d :: 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' _ Null = Doc Text -> MD m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
blockToMarkdown' opts :: WriterOptions
opts (Div attrs :: Attr
attrs ils :: [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
  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
&&
             Attr
attrs Attr -> Attr -> Bool
forall a. Eq a => a -> a -> Bool
/= Attr
nullAttr ->
                Doc Text -> Doc Text
forall a. IsString a => Doc a -> Doc a
nowrap (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal ":::" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
<+> Attr -> Doc Text
attrsToMarkdown Attr
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 ":::" 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
&&
              Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_markdown_in_html_blocks WriterOptions
opts) ->
                Text -> Attr -> Doc Text
forall a. HasChars a => Text -> Attr -> Doc a
tagWithAttrs "div" Attr
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
<> "</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 -> Attr -> Doc Text
forall a. HasChars a => Text -> Attr -> Doc a
tagWithAttrs "div" Attr
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
<> "</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 (id' :: Text
id',classes' :: [Text]
classes',kvs' :: [Target]
kvs') = Attr
attrs
             attrs' :: Attr
attrs' = (Text
id',[Text]
classes',("markdown","1")Target -> [Target] -> [Target]
forall a. a -> [a] -> [a]
:[Target]
kvs')
blockToMarkdown' opts :: WriterOptions
opts (Plain inlines :: [Inline]
inlines) = do
  -- escape if para starts with ordered list marker
  Bool
isPlain <- (WriterEnv -> Bool)
-> ReaderT WriterEnv (StateT WriterState m) Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Bool
envPlain
  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
$ \x :: Char
x -> if Char
x Char -> Text -> Bool
`elemText` ".()"
                                         then String -> Text
T.pack ['\\', Char
x]
                                         else Char -> Text
T.singleton Char
x
  let startsWithSpace :: [Inline] -> Bool
startsWithSpace (Space:_)     = Bool
True
      startsWithSpace (SoftBreak:_) = Bool
True
      startsWithSpace _             = Bool
False
  let inlines' :: [Inline]
inlines' =
        if Bool
isPlain
           then [Inline]
inlines
           else case [Inline]
inlines of
                  (Str t :: Text
t:ys :: [Inline]
ys)
                    | Bool -> Bool
not Bool
isPlain
                    , ([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 "markdown") (Text -> Text
escapeMarker Text
t)Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
:[Inline]
ys
                  (Str t :: Text
t:_)
                    | Bool -> Bool
not Bool
isPlain
                    , Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== "+" Bool -> Bool -> Bool
|| Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== "-" Bool -> Bool -> Bool
||
                      (Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== "%" 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 "markdown") "\\" Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
inlines
                  _ -> [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' opts :: WriterOptions
opts (Para [Image attr :: Attr
attr alt :: [Inline]
alt (src :: Text
src,tgt :: Text
tgt@(Text -> Text -> Maybe Text
T.stripPrefix "fig:" -> Just tit :: 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
&&
    Attr
attr Attr -> Attr -> Bool
forall a. Eq a => a -> a -> Bool
/= Attr
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 [Attr -> [Inline] -> Target -> Inline
Image Attr
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 [Attr -> [Inline] -> Target -> Inline
Image Attr
attr [Inline]
alt (Text
src,Text
tit)])
blockToMarkdown' opts :: WriterOptions
opts (Para inlines :: [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' opts :: WriterOptions
opts (LineBlock lns :: [[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
$ (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 2 (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal "| ")) [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' opts :: WriterOptions
opts b :: Block
b@(RawBlock f :: Format
f str :: Text
str) = do
  Bool
plain <- (WriterEnv -> Bool)
-> ReaderT WriterEnv (StateT WriterState m) Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Bool
envPlain
  let Format fmt :: 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 "```{=" 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
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 "```" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal "\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 () of
    _ | Bool
plain -> MD m (Doc Text)
renderEmpty
      | 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` ["markdown", "markdown_github", "markdown_phpextra",
                  "markdown_mmd", "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 "\n"
      | Format
f Format -> [Format] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ["html", "html5", "html4"] ->
            case () of
              _ | 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 "\n"
                | 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 "\n"
                | Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_raw_attribute WriterOptions
opts -> MD m (Doc Text)
rawAttribBlock
                | Bool
otherwise -> MD m (Doc Text)
renderEmpty
      | Format
f Format -> [Format] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ["latex", "tex"] ->
            case () of
              _ | 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 "\n"
                | Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_raw_attribute WriterOptions
opts -> MD m (Doc Text)
rawAttribBlock
                | Bool
otherwise -> MD m (Doc Text)
renderEmpty
      | Bool
otherwise -> MD m (Doc Text)
renderEmpty
blockToMarkdown' opts :: WriterOptions
opts HorizontalRule = do
  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) "-") Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
blankline
blockToMarkdown' opts :: WriterOptions
opts (Header level :: Int
level attr :: Attr
attr inlines :: [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
== 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

  Bool
plain <- (WriterEnv -> Bool)
-> ReaderT WriterEnv (StateT WriterState m) Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Bool
envPlain
  -- 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
$ \st :: 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 Attr
attr of
                   ("",[],[]) -> Doc Text
forall a. Doc a
empty
                   (id' :: 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
                   (id' :: Text
id',_,_)   | 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')
                   _ | Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_header_attributes WriterOptions
opts ->
                                    Doc Text
forall a. Doc a
space Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Attr -> Doc Text
attrsToMarkdown Attr
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
== 1 Bool -> Bool -> Bool
&& Bool
plain 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
      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
            1 | Bool
plain ->
                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 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 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) "=") Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>
                  Doc Text
forall a. Doc a
blankline
            2 | Bool
plain ->
                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 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) "-") 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.
            _ | Bool
plain 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
            _ -> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Int -> Text -> Text
T.replicate Int
level "#") 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' opts :: WriterOptions
opts (CodeBlock (_,classes :: [Text]
classes,_) str :: Text
str)
  | "haskell" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes Bool -> Bool -> Bool
&& "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 "> " (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' opts :: WriterOptions
opts (CodeBlock attribs :: Attr
attribs str :: Text
str) = 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 Attr
attribs Attr -> Attr -> Bool
forall a. Eq a => a -> a -> Bool
== Attr
nullAttr of
     False | 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
     _ -> 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 endline :: Char -> Doc Text
endline c :: 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
$ case [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] of
                               [] -> Int -> Text -> Text
T.replicate 3 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Char -> Text
T.singleton Char
c
                               xs :: [Int]
xs -> Int -> Text -> Text
T.replicate ([Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Int]
xs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1) (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 '`'
         tildes :: Doc Text
tildes = Char -> Doc Text
endline '~'
         attrs :: Doc Text
attrs  = if Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_fenced_code_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
forall a. Semigroup a => a -> a -> a
<> Attr -> Doc Text
attrsToMarkdown Attr
attribs
                     else case Attr
attribs of
                                (_,(cls :: Text
cls:_),_) -> " " 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
                                _             -> Doc Text
forall a. Doc a
empty
blockToMarkdown' opts :: WriterOptions
opts (BlockQuote blocks :: [Block]
blocks) = do
  Bool
plain <- (WriterEnv -> Bool)
-> ReaderT WriterEnv (StateT WriterState m) Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Bool
envPlain
  -- 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 = if Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_literate_haskell WriterOptions
opts
                  then " > "
                  else if Bool
plain then "  " else "> "
  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' opts :: WriterOptions
opts t :: Block
t@(Table caption :: [Inline]
caption aligns :: [Alignment]
aligns widths :: [Double]
widths headers :: Notes
headers rows :: [Notes]
rows) =  do
  let numcols :: Int
numcols = [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] -> [Int]
forall a. a -> [a] -> [a]
: [Double] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Double]
widths Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:
                           (Notes -> Int) -> [Notes] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Notes -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Notes
headersNotes -> [Notes] -> [Notes]
forall a. a -> [a] -> [a]
:[Notes]
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'' = if [Inline] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
caption Bool -> Bool -> Bool
|| Bool -> Bool
not (Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_table_captions WriterOptions
opts)
                     then Doc Text
forall a. Doc a
blankline
                     else Doc Text
forall a. Doc a
blankline Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ (": " Doc Text -> 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
  let hasSimpleCells :: Bool
hasSimpleCells = [Notes] -> Bool
onlySimpleTableCells ([Notes] -> Bool) -> [Notes] -> Bool
forall a b. (a -> b) -> a -> b
$ Notes
headersNotes -> [Notes] -> [Notes]
forall a. a -> [a] -> [a]
:[Notes]
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
==0) [Double]
widths
  let isPlainBlock :: Block -> Bool
isPlainBlock (Plain _) = Bool
True
      isPlainBlock _         = 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
$ Notes -> [Block]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Notes -> [Block]) -> ([Notes] -> Notes) -> [Notes] -> [Block]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Notes] -> Notes
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([Notes] -> [Block]) -> [Notes] -> [Block]
forall a b. (a -> b) -> a -> b
$ Notes
headersNotes -> [Notes] -> [Notes]
forall a. a -> [a] -> [a]
:[Notes]
rows)
  let padRow :: [Doc a] -> [Doc a]
padRow r :: [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
                       x :: Int
x | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 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
                     x :: Int
x | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 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
                     x :: Int
x | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 -> [Double]
widths [Double] -> [Double] -> [Double]
forall a. [a] -> [a] -> [a]
++ Int -> Double -> [Double]
forall a. Int -> a -> [a]
replicate Int
x 0.0
                       | Bool
otherwise -> [Double]
widths
  (nst :: Doc Text -> Doc Text
nst,tbl :: Doc Text
tbl) <-
     case Bool
True of
          _ | 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))
-> Notes -> 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) Notes
headers
                [[Doc Text]]
rawRows <- (Notes -> ReaderT WriterEnv (StateT WriterState m) [Doc Text])
-> [Notes] -> 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])
-> (Notes -> ReaderT WriterEnv (StateT WriterState m) [Doc Text])
-> Notes
-> ReaderT WriterEnv (StateT WriterState m) [Doc Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Block] -> MD m (Doc Text))
-> Notes -> 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))
                           [Notes]
rows
                (Int -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a
nest 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) -> Notes -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all [Block] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Notes
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))
-> Notes -> 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) Notes
headers
                [[Doc Text]]
rawRows <- (Notes -> ReaderT WriterEnv (StateT WriterState m) [Doc Text])
-> [Notes] -> 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])
-> (Notes -> ReaderT WriterEnv (StateT WriterState m) [Doc Text])
-> Notes
-> ReaderT WriterEnv (StateT WriterState m) [Doc Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Block] -> MD m (Doc Text))
-> Notes -> 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))
                           [Notes]
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) -> Notes -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all [Block] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Notes
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))
-> Notes -> 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) Notes
headers
                [[Doc Text]]
rawRows <- (Notes -> ReaderT WriterEnv (StateT WriterState m) [Doc Text])
-> [Notes] -> 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])
-> (Notes -> ReaderT WriterEnv (StateT WriterState m) [Doc Text])
-> Notes
-> ReaderT WriterEnv (StateT WriterState m) [Doc Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Block] -> MD m (Doc Text))
-> Notes -> 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))
                           [Notes]
rows
                (Int -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a
nest 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) -> Notes -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all [Block] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Notes
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
>= 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]
-> Notes
-> [Notes]
-> MD m (Doc Text)
forall (m :: * -> *) a.
(Monad m, HasChars a) =>
WriterOptions
-> (WriterOptions -> [Block] -> m (Doc a))
-> Bool
-> [Alignment]
-> [Double]
-> Notes
-> [Notes]
-> 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) -> Notes -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all [Block] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Notes
headers) [Alignment]
aligns' [Double]
widths' Notes
headers [Notes]
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))
-> Notes -> 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) Notes
headers
                [[Doc Text]]
rawRows <- (Notes -> ReaderT WriterEnv (StateT WriterState m) [Doc Text])
-> [Notes] -> 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])
-> (Notes -> ReaderT WriterEnv (StateT WriterState m) [Doc Text])
-> Notes
-> ReaderT WriterEnv (StateT WriterState m) [Doc Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Block] -> MD m (Doc Text))
-> Notes -> 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))
                           [Notes]
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) -> Notes -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all [Block] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Notes
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 } (Pandoc -> ReaderT WriterEnv (StateT WriterState m) Text)
-> Pandoc -> ReaderT WriterEnv (StateT WriterState m) Text
forall a b. (a -> b) -> a -> b
$ 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, Doc Text)
 -> ReaderT
      WriterEnv (StateT WriterState m) (Doc Text -> Doc Text, Doc Text))
-> (Doc Text -> Doc Text, Doc Text)
-> ReaderT
     WriterEnv (StateT WriterState m) (Doc Text -> Doc Text, Doc Text)
forall a b. (a -> b) -> a -> b
$ (Doc Text -> Doc Text
forall a. a -> a
id, Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal "[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' opts :: WriterOptions
opts (BulletList items :: Notes
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))
-> Notes -> 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) Notes
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 Notes -> Bool
isTightList Notes
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' opts :: WriterOptions
opts (OrderedList (start :: Int
start,sty :: ListNumberStyle
sty,delim :: ListNumberDelim
delim) items :: Notes
items) = do
  let start' :: Int
start' = if Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_startnum WriterOptions
opts then Int
start else 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 (\m :: Text
m -> if Text -> Int
T.length Text
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 3
                               then Text
m Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.replicate (3 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Text -> Int
T.length Text
m) " "
                               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 (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\(item :: Text
item, num :: [Block]
num) -> WriterOptions -> Text -> [Block] -> MD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Text -> [Block] -> MD m (Doc Text)
orderedListItemToMarkdown WriterOptions
opts Text
item [Block]
num) ([(Text, [Block])]
 -> ReaderT WriterEnv (StateT WriterState m) [Doc Text])
-> [(Text, [Block])]
-> ReaderT WriterEnv (StateT WriterState m) [Doc Text]
forall a b. (a -> b) -> a -> b
$
              [Text] -> Notes -> [(Text, [Block])]
forall a b. [a] -> [b] -> [(a, b)]
zip [Text]
markers' Notes
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 Notes -> Bool
isTightList Notes
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' opts :: WriterOptions
opts (DefinitionList items :: [([Inline], Notes)]
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], Notes) -> MD m (Doc Text))
-> [([Inline], Notes)]
-> 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], Notes) -> MD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> ([Inline], Notes) -> MD m (Doc Text)
definitionListItemToMarkdown WriterOptions
opts) [([Inline], Notes)]
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 p :: 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 (\env :: WriterEnv
env -> WriterEnv
env {envInList :: Bool
envInList = Bool
True}) MD m a
p

addMarkdownAttribute :: Text -> Text
addMarkdownAttribute :: Text -> Text
addMarkdownAttribute s :: 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
       (xs :: [Tag Text]
xs,(TagOpen t :: Text
t attrs :: [Target]
attrs:rest :: [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 -> [Target] -> Tag Text
forall str. str -> [Attribute str] -> Tag str
TagOpen Text
t [Target]
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' :: [Target]
attrs' = ("markdown","1")Target -> [Target] -> [Target]
forall a. a -> [a] -> [a]
:[(Text
x,Text
y) | (x :: Text
x,y :: Text
y) <- [Target]
attrs,
                                 Text
x Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= "markdown"]
       _ -> 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 headless :: Bool
headless aligns :: [Alignment]
aligns rawHeaders :: [Doc Text]
rawHeaders rawRows :: [[Doc Text]]
rawRows = do
  let sp :: Doc Text
sp = Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal " "
  let blockFor :: Alignment -> Int -> Doc Text -> Doc Text
blockFor AlignLeft   x :: Int
x y :: 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
+ 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 0 Doc Text
forall a. Doc a
empty
      blockFor AlignCenter x :: Int
x y :: 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
+ 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 0 Doc Text
forall a. Doc a
empty
      blockFor AlignRight  x :: Int
x y :: 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
+ 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 0 Doc Text
forall a. Doc a
empty
      blockFor _           x :: Int
x y :: 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
+ 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 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 3 (Int -> Int) -> ([Doc Text] -> Int) -> [Doc Text] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> ([Doc Text] -> [Int]) -> [Doc Text] -> 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 cs :: [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 "|" 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 "|") ([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 "|"
  let toborder :: (Alignment, Int) -> Doc Text
toborder (a :: Alignment
a, w :: 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
                             AlignLeft    -> ":" 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
+ 1) "-"
                             AlignCenter  -> ":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.replicate Int
w "-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ":"
                             AlignRight   -> Int -> Text -> Text
T.replicate (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1) "-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ":"
                             AlignDefault -> Int -> Text -> Text
T.replicate (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 2) "-"
  -- 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 "|" 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 "|") ([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. (a -> b) -> [a] -> [b]
map (Alignment, Int) -> Doc Text
toborder ([(Alignment, Int)] -> [Doc Text])
-> [(Alignment, Int)] -> [Doc Text]
forall a b. (a -> b) -> a -> b
$ [Alignment] -> [Int] -> [(Alignment, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [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 "|"
  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 opts :: WriterOptions
opts multiline :: Bool
multiline headless :: Bool
headless aligns :: [Alignment]
aligns widths :: [Double]
widths rawHeaders :: [Doc Text]
rawHeaders rawRows :: [[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
==0) [Double]
widths
  let alignHeader :: Alignment -> Int -> Doc a -> Doc a
alignHeader alignment :: Alignment
alignment = case Alignment
alignment of
                                AlignLeft    -> Int -> Doc a -> Doc a
forall a. HasChars a => Int -> Doc a -> Doc a
lblock
                                AlignCenter  -> Int -> Doc a -> Doc a
forall a. HasChars a => Int -> Doc a -> Doc a
cblock
                                AlignRight   -> Int -> Doc a -> Doc a
forall a. HasChars a => Int -> Doc a -> Doc a
rblock
                                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
+ 2) (Int -> Int) -> ([Doc Text] -> Int) -> [Doc Text] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> ([Doc Text] -> [Int]) -> [Doc Text] -> 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
+ 2) (Int -> Int) -> ([Doc Text] -> Int) -> [Doc Text] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> ([Doc Text] -> [Int]) -> [Doc Text] -> 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 w :: a
w col :: [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
- 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 1 (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal " ")) ([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 " ") ([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 (\width :: Int
width -> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Int -> Text -> Text
T.replicate Int
width "-")) [Int]
widthsInChars
  let border :: Doc Text
border = if Bool
multiline
                  then 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
- 1) "-")
                  else if Bool
headless
                          then Doc Text
underline
                          else 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
< 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 bs :: [Block]
bs =
  case [Block]
bs of
        [Plain _, BulletList xs :: Notes
xs]    -> Notes -> Bool
isTightList Notes
xs
        [Plain _, OrderedList _ xs :: Notes
xs] -> Notes -> Bool
isTightList Notes
xs
        _                           -> 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 opts :: WriterOptions
opts bs :: [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
- 2) " "
  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
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 -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ 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 opts :: WriterOptions
opts marker :: Text
marker bs :: [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
                   n :: Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 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 -> Doc Text
forall a. HasChars a => a -> Doc a
literal " "
  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
+ 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 -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ 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], Notes) -> MD m (Doc Text)
definitionListItemToMarkdown opts :: WriterOptions
opts (label :: [Inline]
label, defs :: Notes
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])
-> Notes -> 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)) Notes
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
       Bool
isPlain <- (WriterEnv -> Bool)
-> ReaderT WriterEnv (StateT WriterState m) Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Bool
envPlain
       let leader :: Doc Text
leader  = if Bool
isPlain then "   " else ":  "
       let sps :: Doc Text
sps = case WriterOptions -> Int
writerTabStop WriterOptions
opts Int -> Int -> Int
forall a. Num a => a -> a -> a
- 3 of
                      n :: Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 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 -> Doc Text
forall a. HasChars a => a -> Doc a
literal " "
       let isTight :: Bool
isTight = case Notes
defs of
                        ((Plain _ : _): _) -> Bool
True
                        _                  -> 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 (\d :: [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
                            (\d :: [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 do
       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 "  " 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 opts :: WriterOptions
opts blocks :: [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
  Bool
isPlain <- (WriterEnv -> Bool)
-> ReaderT WriterEnv (StateT WriterState m) Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Bool
envPlain
  -- 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 (b :: Block
b : CodeBlock attr :: Attr
attr x :: Text
x : rest :: [Block]
rest)
         | (Bool -> Bool
not (Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_fenced_code_blocks WriterOptions
opts) Bool -> Bool -> Bool
|| Attr
attr Attr -> Attr -> Bool
forall a. Eq a => a -> a -> Bool
== Attr
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]
: Attr -> Text -> Block
CodeBlock Attr
attr Text
x Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
:
                                [Block] -> [Block]
fixBlocks [Block]
rest
      fixBlocks (b1 :: Block
b1@(BulletList _) : b2 :: Block
b2@(BulletList _) : bs :: [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 _ _) : b2 :: Block
b2@(OrderedList _ _) : bs :: [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 _) : b2 :: Block
b2@(DefinitionList _) : bs :: [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 ils :: [Inline]
ils : bs :: [Block]
bs@(RawBlock{}:_)) =
           [Inline] -> Block
Plain [Inline]
ils Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block] -> [Block]
fixBlocks [Block]
bs
      fixBlocks (Plain ils :: [Inline]
ils : bs :: [Block]
bs) | Bool
inlist =
           [Inline] -> Block
Plain [Inline]
ils Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block] -> [Block]
fixBlocks [Block]
bs
      fixBlocks (Plain ils :: [Inline]
ils : bs :: [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 f :: Format
f raw :: Text
raw) : b :: Block
b : bs :: [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
/= '\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)
             _          -> Format -> Text -> Block
RawBlock Format
f (Text
raw Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "\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 (x :: Block
x : xs :: [Block]
xs)             = Block
x Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block] -> [Block]
fixBlocks [Block]
xs
      fixBlocks []                   = []
      isListBlock :: Block -> Bool
isListBlock (BulletList _)     = Bool
True
      isListBlock (OrderedList _ _)  = Bool
True
      isListBlock (DefinitionList _) = Bool
True
      isListBlock _                  = Bool
False
      commentSep :: Block
commentSep  = if Bool
isPlain
                       then Block
Null
                       else if Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_raw_html WriterOptions
opts
                            then Format -> Text -> Block
RawBlock "html" "<!-- -->\n"
                            else Format -> Text -> Block
RawBlock "markdown" "&nbsp;\n"
  (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) ReaderT WriterEnv (StateT WriterState 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 -> MD m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> MD m (Doc Text))
-> ([Doc Text] -> Doc Text) -> [Doc Text] -> MD m (Doc Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc Text] -> Doc Text
forall a. Monoid a => [a] -> a
mconcat

getKey :: Doc Text -> Key
getKey :: Doc Text -> Key
getKey = Text -> Key
toKey (Text -> Key) -> (Doc Text -> Text) -> Doc Text -> Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Int -> Doc Text -> Text
forall a. HasChars a => Maybe Int -> Doc a -> a
render Maybe Int
forall a. Maybe a
Nothing

findUsableIndex :: [Text] -> Int -> Int
findUsableIndex :: [Text] -> Int -> Int
findUsableIndex lbls :: [Text]
lbls i :: Int
i = if (Int -> Text
forall a. Show a => a -> Text
tshow Int
i) Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
lbls
                         then [Text] -> Int -> Int
findUsableIndex [Text]
lbls (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1)
                         else Int
i

getNextIndex :: PandocMonad m => MD m Int
getNextIndex :: MD m Int
getNextIndex = do
  Refs
prevRefs <- (WriterState -> Refs)
-> ReaderT WriterEnv (StateT WriterState m) Refs
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Refs
stPrevRefs
  Refs
refs <- (WriterState -> Refs)
-> ReaderT WriterEnv (StateT WriterState m) Refs
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Refs
stRefs
  Int
i <- (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1) (Int -> Int) -> MD m Int -> MD m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (WriterState -> Int) -> MD m Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Int
stLastIdx
  let refLbls :: [Text]
refLbls = (Ref -> Text) -> Refs -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (\(r :: Text
r,_,_) -> Text
r) (Refs -> [Text]) -> Refs -> [Text]
forall a b. (a -> b) -> a -> b
$ Refs
prevRefs Refs -> Refs -> Refs
forall a. [a] -> [a] -> [a]
++ Refs
refs
  Int -> MD m Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> MD m Int) -> Int -> MD m Int
forall a b. (a -> b) -> a -> b
$ [Text] -> Int -> Int
findUsableIndex [Text]
refLbls Int
i

-- | Get reference for target; if none exists, create unique one and return.
--   Prefer label if possible; otherwise, generate a unique key.
getReference :: PandocMonad m => Attr -> Doc Text -> Target -> MD m Text
getReference :: Attr -> Doc Text -> Target -> MD m Text
getReference attr :: Attr
attr label :: Doc Text
label target :: Target
target = do
  Refs
refs <- (WriterState -> Refs)
-> ReaderT WriterEnv (StateT WriterState m) Refs
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Refs
stRefs
  case (Ref -> Bool) -> Refs -> Maybe Ref
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(_,t :: Target
t,a :: Attr
a) -> Target
t Target -> Target -> Bool
forall a. Eq a => a -> a -> Bool
== Target
target Bool -> Bool -> Bool
&& Attr
a Attr -> Attr -> Bool
forall a. Eq a => a -> a -> Bool
== Attr
attr) Refs
refs of
    Just (ref :: Text
ref, _, _) -> Text -> MD m Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
ref
    Nothing       -> do
      Map Key (Map (Target, Attr) Int)
keys <- (WriterState -> Map Key (Map (Target, Attr) Int))
-> ReaderT
     WriterEnv (StateT WriterState m) (Map Key (Map (Target, Attr) Int))
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Map Key (Map (Target, Attr) Int)
stKeys
      case Key
-> Map Key (Map (Target, Attr) Int)
-> Maybe (Map (Target, Attr) Int)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Doc Text -> Key
getKey Doc Text
label) Map Key (Map (Target, Attr) Int)
keys of
           Nothing -> do -- no other refs with this label
             (lab' :: Text
lab', idx :: Int
idx) <- if Doc Text -> Bool
forall a. Doc a -> Bool
isEmpty Doc Text
label
                               then do
                                 Int
i <- MD m Int
forall (m :: * -> *). PandocMonad m => MD m Int
getNextIndex
                                 (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
$ \s :: WriterState
s -> WriterState
s{ stLastIdx :: Int
stLastIdx = Int
i }
                                 (Text, Int) -> ReaderT WriterEnv (StateT WriterState m) (Text, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Text
forall a. Show a => a -> Text
tshow Int
i, Int
i)
                               else
                                 (Text, Int) -> ReaderT WriterEnv (StateT WriterState m) (Text, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Int -> Doc Text -> Text
forall a. HasChars a => Maybe Int -> Doc a -> a
render Maybe Int
forall a. Maybe a
Nothing Doc Text
label, 0)
             (WriterState -> WriterState)
-> ReaderT WriterEnv (StateT WriterState m) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\s :: WriterState
s -> WriterState
s{
               stRefs :: Refs
stRefs = (Text
lab', Target
target, Attr
attr) Ref -> Refs -> Refs
forall a. a -> [a] -> [a]
: Refs
refs,
               stKeys :: Map Key (Map (Target, Attr) Int)
stKeys = Key
-> Map (Target, Attr) Int
-> Map Key (Map (Target, Attr) Int)
-> Map Key (Map (Target, Attr) Int)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (Doc Text -> Key
getKey Doc Text
label)
                           ((Target, Attr)
-> Int -> Map (Target, Attr) Int -> Map (Target, Attr) Int
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (Target
target, Attr
attr) Int
idx Map (Target, Attr) Int
forall a. Monoid a => a
mempty)
                                 (WriterState -> Map Key (Map (Target, Attr) Int)
stKeys WriterState
s) })
             Text -> MD m Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
lab'

           Just km :: Map (Target, Attr) Int
km -> do -- we have refs with this label
             case (Target, Attr) -> Map (Target, Attr) Int -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Target
target, Attr
attr) Map (Target, Attr) Int
km of
                  Just i :: Int
i -> do
                    let lab' :: Text
lab' = Maybe Int -> Doc Text -> Text
forall a. HasChars a => Maybe Int -> Doc a -> a
render Maybe Int
forall a. Maybe a
Nothing (Doc Text -> Text) -> Doc Text -> Text
forall a b. (a -> b) -> a -> b
$
                               Doc Text
label Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> if Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0
                                           then Doc Text
forall a. Monoid a => a
mempty
                                           else Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Int -> Text
forall a. Show a => a -> Text
tshow Int
i)
                    -- make sure it's in stRefs; it may be
                    -- a duplicate that was printed in a previous
                    -- block:
                    Bool
-> ReaderT WriterEnv (StateT WriterState m) ()
-> ReaderT WriterEnv (StateT WriterState m) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((Text
lab', Target
target, Attr
attr) Ref -> Refs -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` Refs
refs) (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
$
                       (WriterState -> WriterState)
-> ReaderT WriterEnv (StateT WriterState m) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\s :: WriterState
s -> WriterState
s{
                         stRefs :: Refs
stRefs = (Text
lab', Target
target, Attr
attr) Ref -> Refs -> Refs
forall a. a -> [a] -> [a]
: Refs
refs })
                    Text -> MD m Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
lab'
                  Nothing -> do -- but this one is to a new target
                    Int
i <- MD m Int
forall (m :: * -> *). PandocMonad m => MD m Int
getNextIndex
                    (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
$ \s :: WriterState
s -> WriterState
s{ stLastIdx :: Int
stLastIdx = Int
i }
                    let lab' :: Text
lab' = Int -> Text
forall a. Show a => a -> Text
tshow Int
i
                    (WriterState -> WriterState)
-> ReaderT WriterEnv (StateT WriterState m) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\s :: WriterState
s -> WriterState
s{
                       stRefs :: Refs
stRefs = (Text
lab', Target
target, Attr
attr) Ref -> Refs -> Refs
forall a. a -> [a] -> [a]
: Refs
refs,
                       stKeys :: Map Key (Map (Target, Attr) Int)
stKeys = Key
-> Map (Target, Attr) Int
-> Map Key (Map (Target, Attr) Int)
-> Map Key (Map (Target, Attr) Int)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (Doc Text -> Key
getKey Doc Text
label)
                                   ((Target, Attr)
-> Int -> Map (Target, Attr) Int -> Map (Target, Attr) Int
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (Target
target, Attr
attr) Int
i Map (Target, Attr) Int
km)
                                         (WriterState -> Map Key (Map (Target, Attr) Int)
stKeys WriterState
s) })
                    Text -> MD m Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
lab'

-- | Convert list of Pandoc inline elements to markdown.
inlineListToMarkdown :: PandocMonad m => WriterOptions -> [Inline] -> MD m (Doc Text)
inlineListToMarkdown :: WriterOptions -> [Inline] -> MD m (Doc Text)
inlineListToMarkdown opts :: WriterOptions
opts lst :: [Inline]
lst = 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
  [Inline] -> MD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
[Inline] -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
go (if Bool
inlist then [Inline] -> [Inline]
avoidBadWrapsInList [Inline]
lst else [Inline]
lst)
  where go :: [Inline] -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
go [] = Doc Text -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
        go (i :: Inline
i:is :: [Inline]
is) = case Inline
i of
            (Link _ _ _) -> case [Inline]
is of
                -- If a link is followed by another link, or '[', '(' or ':'
                -- then we don't shortcut
                (Link _ _ _):_                                  -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
unshortcutable
                Space:(Link _ _ _):_                            -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
unshortcutable
                Space:(Str(Text -> Maybe Char
thead -> Just '[')):_                -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
unshortcutable
                Space:(RawInline _ (Text -> Maybe Char
thead -> Just '[')):_       -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
unshortcutable
                Space:(Cite _ _):_                              -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
unshortcutable
                SoftBreak:(Link _ _ _):_                        -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
unshortcutable
                SoftBreak:(Str(Text -> Maybe Char
thead -> Just '[')):_            -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
unshortcutable
                SoftBreak:(RawInline _ (Text -> Maybe Char
thead -> Just '[')):_   -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
unshortcutable
                SoftBreak:(Cite _ _):_                          -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
unshortcutable
                LineBreak:(Link _ _ _):_                        -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
unshortcutable
                LineBreak:(Str(Text -> Maybe Char
thead -> Just '[')):_            -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
unshortcutable
                LineBreak:(RawInline _ (Text -> Maybe Char
thead -> Just '[')):_   -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
unshortcutable
                LineBreak:(Cite _ _):_                          -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
unshortcutable
                (Cite _ _):_                                    -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
unshortcutable
                Str (Text -> Maybe Char
thead -> Just '['):_                       -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
unshortcutable
                Str (Text -> Maybe Char
thead -> Just '('):_                       -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
unshortcutable
                Str (Text -> Maybe Char
thead -> Just ':'):_                       -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
unshortcutable
                (RawInline _ (Text -> Maybe Char
thead -> Just '[')):_             -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
unshortcutable
                (RawInline _ (Text -> Maybe Char
thead -> Just '(')):_             -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
unshortcutable
                (RawInline _ (Text -> Maybe Char
thead -> Just ':')):_             -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
unshortcutable
                (RawInline _ (Text -> Text -> Maybe Text
T.stripPrefix " [" -> Just _ )):_ -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
unshortcutable
                _                                               -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
shortcutable
            _ -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
shortcutable
          where shortcutable :: ReaderT WriterEnv (StateT WriterState m) (Doc Text)
shortcutable = (Doc Text -> Doc Text -> Doc Text)
-> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
-> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
-> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
(<>) (WriterOptions
-> Inline -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> MD m (Doc Text)
inlineToMarkdown WriterOptions
opts Inline
i) ([Inline] -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
go [Inline]
is)
                unshortcutable :: ReaderT WriterEnv (StateT WriterState m) (Doc Text)
unshortcutable = do
                    Doc Text
iMark <- (WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
-> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local
                             (\env :: WriterEnv
env -> WriterEnv
env { envRefShortcutable :: Bool
envRefShortcutable = Bool
False })
                             (WriterOptions
-> Inline -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> MD m (Doc Text)
inlineToMarkdown WriterOptions
opts Inline
i)
                    (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
iMark Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>) ([Inline] -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
go [Inline]
is)
                thead :: Text -> Maybe Char
thead = ((Char, Text) -> Char) -> Maybe (Char, Text) -> Maybe Char
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Char, Text) -> Char
forall a b. (a, b) -> a
fst (Maybe (Char, Text) -> Maybe Char)
-> (Text -> Maybe (Char, Text)) -> Text -> Maybe Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe (Char, Text)
T.uncons

isSp :: Inline -> Bool
isSp :: Inline -> Bool
isSp Space     = Bool
True
isSp SoftBreak = Bool
True
isSp _         = Bool
False

avoidBadWrapsInList :: [Inline] -> [Inline]
avoidBadWrapsInList :: [Inline] -> [Inline]
avoidBadWrapsInList [] = []
avoidBadWrapsInList (s :: Inline
s:Str (Text -> Maybe (Char, Text)
T.uncons -> Just ('>',cs :: Text
cs)):xs :: [Inline]
xs) | Inline -> Bool
isSp Inline
s =
  Text -> Inline
Str (" >" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
cs) Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline] -> [Inline]
avoidBadWrapsInList [Inline]
xs
avoidBadWrapsInList (s :: Inline
s:Str (Text -> Maybe (Char, Text)
T.uncons -> Just (c :: Char
c, cs :: Text
cs)):[])
  | Text -> Bool
T.null Text
cs Bool -> Bool -> Bool
&& Inline -> Bool
isSp Inline
s Bool -> Bool -> Bool
&& Char
c Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ['-','*','+'] = Text -> Inline
Str (String -> Text
T.pack [' ', Char
c]) Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: []
avoidBadWrapsInList (s :: Inline
s:Str (Text -> Maybe (Char, Text)
T.uncons -> Just (c :: Char
c, cs :: Text
cs)):Space:xs :: [Inline]
xs)
  | Text -> Bool
T.null Text
cs Bool -> Bool -> Bool
&& Inline -> Bool
isSp Inline
s Bool -> Bool -> Bool
&& Char
c Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ['-','*','+'] =
    Text -> Inline
Str (String -> Text
T.pack [' ', Char
c]) Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Inline
Space Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline] -> [Inline]
avoidBadWrapsInList [Inline]
xs
avoidBadWrapsInList (s :: Inline
s:Str cs :: Text
cs:Space:xs :: [Inline]
xs)
  | Inline -> Bool
isSp Inline
s Bool -> Bool -> Bool
&& Text -> Bool
isOrderedListMarker Text
cs =
    Text -> Inline
Str (" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
cs) Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Inline
Space Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline] -> [Inline]
avoidBadWrapsInList [Inline]
xs
avoidBadWrapsInList (s :: Inline
s:Str cs :: Text
cs:[])
  | Inline -> Bool
isSp Inline
s Bool -> Bool -> Bool
&& Text -> Bool
isOrderedListMarker Text
cs = Text -> Inline
Str (" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
cs) Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: []
avoidBadWrapsInList (x :: Inline
x:xs :: [Inline]
xs) = Inline
x Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline] -> [Inline]
avoidBadWrapsInList [Inline]
xs

isOrderedListMarker :: Text -> Bool
isOrderedListMarker :: Text -> Bool
isOrderedListMarker xs :: Text
xs = Bool -> Bool
not (Text -> Bool
T.null Text
xs) Bool -> Bool -> Bool
&& (Text -> Char
T.last Text
xs Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ['.',')']) Bool -> Bool -> Bool
&&
              Either ParseError () -> Bool
forall a b. Either a b -> Bool
isRight (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 (ParserT
  Text ParserState Identity (Int, ListNumberStyle, ListNumberDelim)
forall s (m :: * -> *).
Stream s m Char =>
ParserT s ParserState m (Int, ListNumberStyle, ListNumberDelim)
anyOrderedListMarker ParserT
  Text ParserState Identity (Int, ListNumberStyle, ListNumberDelim)
-> Parser Text ParserState () -> Parser Text ParserState ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser Text ParserState ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof)
                       ParserState
defaultParserState "" Text
xs)

isRight :: Either a b -> Bool
isRight :: Either a b -> Bool
isRight (Right _) = Bool
True
isRight (Left  _) = Bool
False

-- | Convert Pandoc inline element to markdown.
inlineToMarkdown :: PandocMonad m => WriterOptions -> Inline -> MD m (Doc Text)
inlineToMarkdown :: WriterOptions -> Inline -> MD m (Doc Text)
inlineToMarkdown opts :: WriterOptions
opts (Span ("",["emoji"],kvs :: [Target]
kvs) [Str s :: Text
s]) = do
  case Text -> [Target] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup "data-emoji" [Target]
kvs of
       Just emojiname :: Text
emojiname | Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_emoji 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
$ ":" 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
emojiname Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> ":"
       _ -> WriterOptions -> Inline -> MD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> MD m (Doc Text)
inlineToMarkdown WriterOptions
opts (Text -> Inline
Str Text
s)
inlineToMarkdown opts :: WriterOptions
opts (Span attrs :: Attr
attrs ils :: [Inline]
ils) = do
  Bool
plain <- (WriterEnv -> Bool)
-> ReaderT WriterEnv (StateT WriterState m) Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Bool
envPlain
  Doc Text
contents <- WriterOptions -> [Inline] -> MD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> MD m (Doc Text)
inlineListToMarkdown WriterOptions
opts [Inline]
ils
  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 Bool
plain of
                True -> Doc Text
contents
                False | Attr
attrs Attr -> Attr -> Bool
forall a. Eq a => a -> a -> Bool
== Attr
nullAttr -> Doc Text
contents
                      | Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_bracketed_spans WriterOptions
opts ->
                        let attrs' :: Doc Text
attrs' = if Attr
attrs Attr -> Attr -> Bool
forall a. Eq a => a -> a -> Bool
/= Attr
nullAttr
                                        then Attr -> Doc Text
attrsToMarkdown Attr
attrs
                                        else Doc Text
forall a. Doc a
empty
                        in "[" 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 -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
attrs'
                      | 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_native_spans WriterOptions
opts ->
                        Text -> Attr -> Doc Text
forall a. HasChars a => Text -> Attr -> Doc a
tagWithAttrs "span" Attr
attrs 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
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal "</span>"
                      | Bool
otherwise -> Doc Text
contents
inlineToMarkdown _ (Emph []) = Doc Text -> MD m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
inlineToMarkdown opts :: WriterOptions
opts (Emph lst :: [Inline]
lst) = do
  Bool
plain <- (WriterEnv -> Bool)
-> ReaderT WriterEnv (StateT WriterState m) Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Bool
envPlain
  Doc Text
contents <- WriterOptions -> [Inline] -> MD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> MD m (Doc Text)
inlineListToMarkdown WriterOptions
opts [Inline]
lst
  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 Bool
plain
              then if Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_gutenberg WriterOptions
opts
                      then "_" 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
<> "_"
                      else Doc Text
contents
              else "*" 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
<> "*"
inlineToMarkdown _ (Strong []) = Doc Text -> MD m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
inlineToMarkdown opts :: WriterOptions
opts (Strong lst :: [Inline]
lst) = do
  Bool
plain <- (WriterEnv -> Bool)
-> ReaderT WriterEnv (StateT WriterState m) Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Bool
envPlain
  if Bool
plain
     then 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
$
          if 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]
lst
             else [Inline]
lst
     else do
       Doc Text
contents <- WriterOptions -> [Inline] -> MD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> MD m (Doc Text)
inlineListToMarkdown WriterOptions
opts [Inline]
lst
       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 -> 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
<> "**"
inlineToMarkdown _ (Strikeout []) = Doc Text -> MD m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
inlineToMarkdown opts :: WriterOptions
opts (Strikeout lst :: [Inline]
lst) = do
  Doc Text
contents <- WriterOptions -> [Inline] -> MD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> MD m (Doc Text)
inlineListToMarkdown WriterOptions
opts [Inline]
lst
  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_strikeout WriterOptions
opts
              then "~~" 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
<> "~~"
              else if Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_raw_html WriterOptions
opts
                       then "<s>" 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
<> "</s>"
                       else Doc Text
contents
inlineToMarkdown _ (Superscript []) = Doc Text -> MD m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
inlineToMarkdown opts :: WriterOptions
opts (Superscript lst :: [Inline]
lst) =
  (WriterEnv -> WriterEnv) -> MD m (Doc Text) -> MD m (Doc Text)
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\env :: WriterEnv
env -> WriterEnv
env {envEscapeSpaces :: Bool
envEscapeSpaces = Bool
True}) (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
contents <- WriterOptions -> [Inline] -> MD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> MD m (Doc Text)
inlineListToMarkdown WriterOptions
opts [Inline]
lst
    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_superscript WriterOptions
opts
                then "^" 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
<> "^"
                else if Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_raw_html WriterOptions
opts
                         then "<sup>" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> "</sup>"
                         else
                           let rendered :: Text
rendered = 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
                           in  case (Char -> Maybe Char) -> String -> Maybe String
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Char -> Maybe Char
toSuperscript (Text -> String
T.unpack Text
rendered) of
                                    Just r :: String
r  -> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
r
                                    Nothing -> 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
forall a. Semigroup a => a -> a -> a
<> Text
rendered Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ")"
inlineToMarkdown _ (Subscript []) = Doc Text -> MD m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
inlineToMarkdown opts :: WriterOptions
opts (Subscript lst :: [Inline]
lst) =
  (WriterEnv -> WriterEnv) -> MD m (Doc Text) -> MD m (Doc Text)
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\env :: WriterEnv
env -> WriterEnv
env {envEscapeSpaces :: Bool
envEscapeSpaces = Bool
True}) (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
contents <- WriterOptions -> [Inline] -> MD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> MD m (Doc Text)
inlineListToMarkdown WriterOptions
opts [Inline]
lst
    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_subscript WriterOptions
opts
                then "~" 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
<> "~"
                else if Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_raw_html WriterOptions
opts
                         then "<sub>" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> "</sub>"
                         else
                           let rendered :: Text
rendered = 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
                           in  case (Char -> Maybe Char) -> String -> Maybe String
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Char -> Maybe Char
toSubscript (Text -> String
T.unpack Text
rendered) of
                                    Just r :: String
r  -> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
r
                                    Nothing -> 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
forall a. Semigroup a => a -> a -> a
<> Text
rendered Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ")"
inlineToMarkdown opts :: WriterOptions
opts (SmallCaps lst :: [Inline]
lst) = do
  Bool
plain <- (WriterEnv -> Bool)
-> ReaderT WriterEnv (StateT WriterState m) Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Bool
envPlain
  if Bool -> Bool
not Bool
plain Bool -> Bool -> Bool
&&
     (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_native_spans WriterOptions
opts)
     then WriterOptions -> Inline -> MD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> MD m (Doc Text)
inlineToMarkdown WriterOptions
opts (Attr -> [Inline] -> Inline
Span ("",["smallcaps"],[]) [Inline]
lst)
     else 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
$ [Inline] -> [Inline]
forall a. Walkable Inline a => a -> a
capitalize [Inline]
lst
inlineToMarkdown opts :: WriterOptions
opts (Quoted SingleQuote lst :: [Inline]
lst) = do
  Doc Text
contents <- WriterOptions -> [Inline] -> MD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> MD m (Doc Text)
inlineListToMarkdown WriterOptions
opts [Inline]
lst
  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_smart WriterOptions
opts
              then "'" 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
<> "'"
              else
                if WriterOptions -> Bool
writerPreferAscii WriterOptions
opts
                   then "&lsquo;" 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
<> "&rsquo;"
                   else "‘" 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
<> "’"
inlineToMarkdown opts :: WriterOptions
opts (Quoted DoubleQuote lst :: [Inline]
lst) = do
  Doc Text
contents <- WriterOptions -> [Inline] -> MD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> MD m (Doc Text)
inlineListToMarkdown WriterOptions
opts [Inline]
lst
  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_smart WriterOptions
opts
              then "\"" 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
<> "\""
              else
                if WriterOptions -> Bool
writerPreferAscii WriterOptions
opts
                   then "&ldquo;" 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
<> "&rdquo;"
                   else "“" 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
<> "”"
inlineToMarkdown opts :: WriterOptions
opts (Code attr :: Attr
attr str :: Text
str) = do
  let tickGroups :: [Text]
tickGroups = (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Char -> Bool) -> Text -> Bool
T.any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '`')) ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
T.group Text
str
  let longest :: Int
longest    = if [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
tickGroups
                     then 0
                     else [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (Text -> Int) -> [Text] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Int
T.length [Text]
tickGroups
  let marker :: Text
marker     = Int -> Text -> Text
T.replicate (Int
longest Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1) "`"
  let spacer :: Text
spacer     = if (Int
longest Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0) then "" else " "
  let attrs :: Doc Text
attrs      = if Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_inline_code_attributes WriterOptions
opts Bool -> Bool -> Bool
&& Attr
attr Attr -> Attr -> Bool
forall a. Eq a => a -> a -> Bool
/= Attr
nullAttr
                      then Attr -> Doc Text
attrsToMarkdown Attr
attr
                      else Doc Text
forall a. Doc a
empty
  Bool
plain <- (WriterEnv -> Bool)
-> ReaderT WriterEnv (StateT WriterState m) Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Bool
envPlain
  if Bool
plain
     then 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
     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
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text
marker Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
spacer Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
str Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
spacer Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
marker) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
attrs
inlineToMarkdown opts :: WriterOptions
opts (Str str :: Text
str) = do
  Bool
isPlain <- (WriterEnv -> Bool)
-> ReaderT WriterEnv (StateT WriterState m) Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Bool
envPlain
  let str' :: Text
str' = (if Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_smart WriterOptions
opts
                 then WriterOptions -> Text -> Text
unsmartify WriterOptions
opts
                 else Text -> Text
forall a. a -> a
id) (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$
              if Bool
isPlain
                 then Text
str
                 else WriterOptions -> Text -> Text
escapeText WriterOptions
opts Text
str
  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'
inlineToMarkdown opts :: WriterOptions
opts (Math InlineMath str :: Text
str) =
  case WriterOptions -> HTMLMathMethod
writerHTMLMathMethod WriterOptions
opts of
       WebTeX url :: Text
url -> WriterOptions -> Inline -> MD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> MD m (Doc Text)
inlineToMarkdown WriterOptions
opts
                       (Attr -> [Inline] -> Target -> Inline
Image Attr
nullAttr [Text -> Inline
Str Text
str] (Text
url Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (String -> String
urlEncode (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
str), Text
str))
       _ | Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_tex_math_dollars 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
$ "$" 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
<> "$"
         | Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_tex_math_single_backslash 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
$ "\\(" 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
<> "\\)"
         | Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_tex_math_double_backslash 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
$ "\\\\(" 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
<> "\\\\)"
         | Bool
otherwise -> do
             Bool
plain <- (WriterEnv -> Bool)
-> ReaderT WriterEnv (StateT WriterState m) Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Bool
envPlain
             MathType
-> Text -> ReaderT WriterEnv (StateT WriterState m) [Inline]
forall (m :: * -> *).
PandocMonad m =>
MathType -> Text -> m [Inline]
texMathToInlines MathType
InlineMath Text
str ReaderT WriterEnv (StateT WriterState m) [Inline]
-> ([Inline] -> MD m (Doc Text)) -> MD m (Doc Text)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
               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] -> [Inline]) -> [Inline] -> MD m (Doc Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                 (if Bool
plain then [Inline] -> [Inline]
makeMathPlainer else [Inline] -> [Inline]
forall a. a -> a
id)
inlineToMarkdown opts :: WriterOptions
opts (Math DisplayMath str :: Text
str) =
  case WriterOptions -> HTMLMathMethod
writerHTMLMathMethod WriterOptions
opts of
      WebTeX url :: Text
url -> (\x :: Doc Text
x -> Doc Text
forall a. Doc a
blankline Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
x 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 -> Inline -> MD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> MD m (Doc Text)
inlineToMarkdown WriterOptions
opts (Attr -> [Inline] -> Target -> Inline
Image Attr
nullAttr [Text -> Inline
Str Text
str]
                    (Text
url Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (String -> String
urlEncode (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
str), Text
str))
      _ | Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_tex_math_dollars 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
$ "$$" 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
<> "$$"
        | Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_tex_math_single_backslash 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
$ "\\[" 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
<> "\\]"
        | Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_tex_math_double_backslash 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
$ "\\\\[" 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
<> "\\\\]"
        | Bool
otherwise -> (\x :: Doc Text
x -> Doc Text
forall a. Doc a
cr Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
x Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
cr) (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`
            (MathType
-> Text -> ReaderT WriterEnv (StateT WriterState m) [Inline]
forall (m :: * -> *).
PandocMonad m =>
MathType -> Text -> m [Inline]
texMathToInlines MathType
DisplayMath Text
str ReaderT WriterEnv (StateT WriterState m) [Inline]
-> ([Inline] -> MD m (Doc Text)) -> MD m (Doc Text)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= WriterOptions -> [Inline] -> MD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> MD m (Doc Text)
inlineListToMarkdown WriterOptions
opts)
inlineToMarkdown opts :: WriterOptions
opts il :: Inline
il@(RawInline f :: Format
f str :: Text
str) = do
  let tickGroups :: [Text]
tickGroups = (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Char -> Bool) -> Text -> Bool
T.any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '`')) ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
T.group Text
str
  let numticks :: Int
numticks   = if [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
tickGroups
                     then 1
                     else 1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ((Text -> Int) -> [Text] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Int
T.length [Text]
tickGroups)
  Bool
plain <- (WriterEnv -> Bool)
-> ReaderT WriterEnv (StateT WriterState m) Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Bool
envPlain
  let Format fmt :: Text
fmt = Format
f
  let rawAttribInline :: MD m (Doc Text)
rawAttribInline = 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 (Int -> Text -> Text
T.replicate Int
numticks "`") 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
<>
         Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Int -> Text -> Text
T.replicate Int
numticks "`") Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal "{=" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
fmt Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal "}"
  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 (Inline -> LogMessage
InlineNotRendered Inline
il)
  case () of
    _ | Bool
plain -> MD m (Doc Text)
renderEmpty
      | Format
f Format -> [Format] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ["markdown", "markdown_github", "markdown_phpextra",
                  "markdown_mmd", "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
      | Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_raw_attribute WriterOptions
opts -> MD m (Doc Text)
rawAttribInline
      | Format
f Format -> [Format] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ["html", "html5", "html4"] ->
            case () of
              _ | 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
                | Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_raw_attribute WriterOptions
opts -> MD m (Doc Text)
rawAttribInline
                | Bool
otherwise -> MD m (Doc Text)
renderEmpty
      | Format
f Format -> [Format] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ["latex", "tex"] ->
            case () of
              _ | 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
                | Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_raw_attribute WriterOptions
opts -> MD m (Doc Text)
rawAttribInline
                | Bool
otherwise -> MD m (Doc Text)
renderEmpty
      | Bool
otherwise -> MD m (Doc Text)
renderEmpty
inlineToMarkdown opts :: WriterOptions
opts (Inline
LineBreak) = do
  Bool
plain <- (WriterEnv -> Bool)
-> ReaderT WriterEnv (StateT WriterState m) Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Bool
envPlain
  if Bool
plain Bool -> Bool -> Bool
|| Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_hard_line_breaks WriterOptions
opts
     then Doc Text -> MD m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
cr
     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
$
          if Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_escaped_line_breaks WriterOptions
opts
             then "\\" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
cr
             else "  " Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
cr
inlineToMarkdown _ Space = do
  Bool
escapeSpaces <- (WriterEnv -> Bool)
-> ReaderT WriterEnv (StateT WriterState m) Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Bool
envEscapeSpaces
  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 Bool
escapeSpaces then "\\ " else Doc Text
forall a. Doc a
space
inlineToMarkdown opts :: WriterOptions
opts SoftBreak = do
  Bool
escapeSpaces <- (WriterEnv -> Bool)
-> ReaderT WriterEnv (StateT WriterState m) Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Bool
envEscapeSpaces
  let space' :: Doc Text
space' = if Bool
escapeSpaces then "\\ " else Doc Text
forall a. Doc a
space
  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 WriterOptions -> WrapOption
writerWrapText WriterOptions
opts of
                WrapNone     -> Doc Text
space'
                WrapAuto     -> Doc Text
space'
                WrapPreserve -> Doc Text
forall a. Doc a
cr
inlineToMarkdown opts :: WriterOptions
opts (Cite [] lst :: [Inline]
lst) = WriterOptions -> [Inline] -> MD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> MD m (Doc Text)
inlineListToMarkdown WriterOptions
opts [Inline]
lst
inlineToMarkdown opts :: WriterOptions
opts (Cite (c :: Citation
c:cs :: [Citation]
cs) lst :: [Inline]
lst)
  | Bool -> Bool
not (Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_citations WriterOptions
opts) = WriterOptions -> [Inline] -> MD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> MD m (Doc Text)
inlineListToMarkdown WriterOptions
opts [Inline]
lst
  | Bool
otherwise =
      if Citation -> CitationMode
citationMode Citation
c CitationMode -> CitationMode -> Bool
forall a. Eq a => a -> a -> Bool
== CitationMode
AuthorInText
         then do
           Doc Text
suffs <- 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
$ Citation -> [Inline]
citationSuffix Citation
c
           [Doc Text]
rest <- (Citation -> MD m (Doc Text))
-> [Citation]
-> 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 Citation -> MD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Citation -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
convertOne [Citation]
cs
           let inbr :: Doc Text
inbr = Doc Text
suffs Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
<+> [Doc Text] -> Doc Text
joincits [Doc Text]
rest
               br :: Doc Text
br   = if Doc Text -> Bool
forall a. Doc a -> Bool
isEmpty Doc Text
inbr then Doc Text
forall a. Doc a
empty else Char -> Doc Text
forall a. HasChars a => Char -> Doc a
char '[' Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
inbr Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Char -> Doc Text
forall a. HasChars a => Char -> Doc a
char ']'
           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 -> Text
forall a. Semigroup a => a -> a -> a
<> Citation -> Text
citationId Citation
c) Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
<+> Doc Text
br
         else do
           [Doc Text]
cits <- (Citation -> MD m (Doc Text))
-> [Citation]
-> 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 Citation -> MD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Citation -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
convertOne (Citation
cCitation -> [Citation] -> [Citation]
forall a. a -> [a] -> [a]
:[Citation]
cs)
           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 "[" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> [Doc Text] -> Doc Text
joincits [Doc Text]
cits Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal "]"
  where
        joincits :: [Doc Text] -> Doc Text
joincits = [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 (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal "; ") ([Doc Text] -> [Doc Text])
-> ([Doc Text] -> [Doc Text]) -> [Doc Text] -> [Doc Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Doc Text -> Bool) -> [Doc Text] -> [Doc Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Doc Text -> Bool) -> Doc Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc Text -> Bool
forall a. Doc a -> Bool
isEmpty)
        convertOne :: Citation -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
convertOne Citation { citationId :: Citation -> Text
citationId      = Text
k
                            , citationPrefix :: Citation -> [Inline]
citationPrefix  = [Inline]
pinlines
                            , citationSuffix :: Citation -> [Inline]
citationSuffix  = [Inline]
sinlines
                            , citationMode :: Citation -> CitationMode
citationMode    = CitationMode
m }
                               = do
           Doc Text
pdoc <- WriterOptions
-> [Inline] -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> MD m (Doc Text)
inlineListToMarkdown WriterOptions
opts [Inline]
pinlines
           Doc Text
sdoc <- WriterOptions
-> [Inline] -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> MD m (Doc Text)
inlineListToMarkdown WriterOptions
opts [Inline]
sinlines
           let k' :: Doc Text
k' = Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (CitationMode -> Text
forall p. IsString p => CitationMode -> p
modekey CitationMode
m Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "@" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
k)
               r :: Doc Text
r = case [Inline]
sinlines of
                        Str (Text -> Maybe (Char, Text)
T.uncons -> Just (y :: Char
y,_)):_ | Char
y Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (",;]@" :: String) -> Doc Text
k' Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
sdoc
                        _                                         -> Doc Text
k' Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
<+> Doc Text
sdoc
           Doc Text -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> ReaderT WriterEnv (StateT WriterState m) (Doc Text))
-> Doc Text -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
pdoc Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
<+> Doc Text
r
        modekey :: CitationMode -> p
modekey SuppressAuthor = "-"
        modekey _              = ""
inlineToMarkdown opts :: WriterOptions
opts lnk :: Inline
lnk@(Link attr :: Attr
attr txt :: [Inline]
txt (src :: Text
src, tit :: 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
&&
    Attr
attr Attr -> Attr -> Bool
forall a. Eq a => a -> a -> Bool
/= Attr
nullAttr = -- use raw HTML
    (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
Plain [Inline
lnk]])
  | Bool
otherwise = do
  Bool
plain <- (WriterEnv -> Bool)
-> ReaderT WriterEnv (StateT WriterState m) Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Bool
envPlain
  Doc Text
linktext <- WriterOptions -> [Inline] -> MD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> MD m (Doc Text)
inlineListToMarkdown WriterOptions
opts [Inline]
txt
  let linktitle :: Doc Text
linktitle = if Text -> Bool
T.null Text
tit
                     then Doc Text
forall a. Doc a
empty
                     else 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
forall a. Semigroup a => a -> a -> a
<> Text
tit Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "\""
  let srcSuffix :: Text
srcSuffix = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
src (Text -> Text -> Maybe Text
T.stripPrefix "mailto:" Text
src)
  let useAuto :: Bool
useAuto = Text -> Bool
isURI Text
src Bool -> Bool -> Bool
&&
                case [Inline]
txt of
                      [Str s :: Text
s] | Text -> Text
escapeURI Text
s Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
srcSuffix -> Bool
True
                      _       -> Bool
False
  let useRefLinks :: Bool
useRefLinks = WriterOptions -> Bool
writerReferenceLinks WriterOptions
opts Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
useAuto
  Bool
shortcutable <- (WriterEnv -> Bool)
-> ReaderT WriterEnv (StateT WriterState m) Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Bool
envRefShortcutable
  let useShortcutRefLinks :: Bool
useShortcutRefLinks = Bool
shortcutable Bool -> Bool -> Bool
&&
                            Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_shortcut_reference_links WriterOptions
opts
  Doc Text
reftext <- if Bool
useRefLinks
                then 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
<$> Attr
-> Doc Text
-> Target
-> ReaderT WriterEnv (StateT WriterState m) Text
forall (m :: * -> *).
PandocMonad m =>
Attr -> Doc Text -> Target -> MD m Text
getReference Attr
attr Doc Text
linktext (Text
src, Text
tit)
                else Doc Text -> MD m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Monoid a => a
mempty
  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 Bool
useAuto
              then if Bool
plain
                      then Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
srcSuffix
                      else "<" 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
srcSuffix Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> ">"
              else if Bool
useRefLinks
                      then let first :: Doc Text
first  = "[" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
linktext Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> "]"
                               second :: Doc Text
second = if Doc Text -> Key
getKey Doc Text
linktext Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Doc Text -> Key
getKey Doc Text
reftext
                                           then if Bool
useShortcutRefLinks
                                                   then ""
                                                   else "[]"
                                           else "[" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
reftext Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> "]"
                           in  Doc Text
first Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
second
                      else if Bool
plain
                              then Doc Text
linktext
                              else "[" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
linktext Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> "](" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>
                                   Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
src Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
linktitle Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> ")" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>
                                   WriterOptions -> Attr -> Doc Text
linkAttributes WriterOptions
opts Attr
attr
inlineToMarkdown opts :: WriterOptions
opts img :: Inline
img@(Image attr :: Attr
attr alternate :: [Inline]
alternate (source :: Text
source, tit :: 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
&&
    Attr
attr Attr -> Attr -> Bool
forall a. Eq a => a -> a -> Bool
/= Attr
nullAttr = -- use raw HTML
    (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
Plain [Inline
img]])
  | Bool
otherwise = do
  Bool
plain <- (WriterEnv -> Bool)
-> ReaderT WriterEnv (StateT WriterState m) Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Bool
envPlain
  let txt :: [Inline]
txt = if [Inline] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
alternate Bool -> Bool -> Bool
|| [Inline]
alternate [Inline] -> [Inline] -> Bool
forall a. Eq a => a -> a -> Bool
== [Text -> Inline
Str Text
source]
                                 -- to prevent autolinks
               then [Text -> Inline
Str ""]
               else [Inline]
alternate
  Doc Text
linkPart <- WriterOptions -> Inline -> MD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> MD m (Doc Text)
inlineToMarkdown WriterOptions
opts (Attr -> [Inline] -> Target -> Inline
Link Attr
attr [Inline]
txt (Text
source, Text
tit))
  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 Bool
plain
              then "[" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
linkPart Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> "]"
              else "!" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
linkPart
inlineToMarkdown opts :: WriterOptions
opts (Note contents :: [Block]
contents) = do
  (WriterState -> WriterState)
-> ReaderT WriterEnv (StateT WriterState m) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\st :: WriterState
st -> WriterState
st{ stNotes :: Notes
stNotes = [Block]
contents [Block] -> Notes -> Notes
forall a. a -> [a] -> [a]
: WriterState -> Notes
stNotes WriterState
st })
  WriterState
st <- ReaderT WriterEnv (StateT WriterState m) WriterState
forall s (m :: * -> *). MonadState s m => m s
get
  let ref :: Doc Text
ref = 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 (WriterState -> Int
stNoteNum WriterState
st Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Notes -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Notes -> Int) -> Notes -> Int
forall a b. (a -> b) -> a -> b
$ WriterState -> Notes
stNotes WriterState
st) Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1)
  if Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_footnotes WriterOptions
opts
     then 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 -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
ref Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> "]"
     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 -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
ref Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> "]"

makeMathPlainer :: [Inline] -> [Inline]
makeMathPlainer :: [Inline] -> [Inline]
makeMathPlainer = (Inline -> Inline) -> [Inline] -> [Inline]
forall a b. Walkable a b => (a -> a) -> b -> b
walk Inline -> Inline
go
  where
  go :: Inline -> Inline
go (Emph xs :: [Inline]
xs) = Attr -> [Inline] -> Inline
Span Attr
nullAttr [Inline]
xs
  go x :: Inline
x         = Inline
x

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