{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE BangPatterns #-}
module Text.Pandoc.Writers.Markdown (
writeMarkdown,
writeCommonMark,
writeMarkua,
writePlain) where
import Control.Monad (foldM, zipWithM, MonadPlus(..), when, liftM)
import Control.Monad.Reader ( asks, MonadReader(local) )
import Control.Monad.State.Strict ( gets, modify )
import Data.Default
import Data.List (intersperse, sortOn, union)
import Data.List.NonEmpty (nonEmpty, NonEmpty(..))
import qualified Data.Map as M
import Data.Maybe (fromMaybe, mapMaybe, isNothing)
import qualified Data.Set as Set
import Data.Text (Text)
import Data.Char (isSpace)
import qualified Data.Text as T
import Text.HTML.TagSoup (Tag (..), isTagText, parseTags)
import Text.Pandoc.Class.PandocMonad (PandocMonad, report)
import Text.Pandoc.Definition
import Text.Pandoc.Logging
import Text.Pandoc.Options
import Text.Pandoc.Parsing hiding (blankline, blanklines, char, space)
import Text.DocLayout
import Text.Pandoc.Shared
import Text.Pandoc.Writers.Shared
import Text.Pandoc.Templates (renderTemplate)
import Text.DocTemplates (Val(..), Context(..), FromContext(..))
import Text.Pandoc.Walk
import Text.Pandoc.Writers.HTML (writeHtml5String)
import Text.Pandoc.Writers.Markdown.Inline (inlineListToMarkdown,
linkAttributes,
attrsToMarkdown,
attrsToMarkua)
import Text.Pandoc.Writers.Markdown.Table (pipeTable, pandocTable)
import Text.Pandoc.Writers.Markdown.Types (MarkdownVariant(..),
WriterState(..),
WriterEnv(..),
Ref, Refs, MD, evalMD)
writeMarkdown :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writeMarkdown :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeMarkdown WriterOptions
opts Pandoc
document =
MD m Text -> WriterEnv -> WriterState -> m Text
forall (m :: * -> *) a.
PandocMonad m =>
MD m a -> WriterEnv -> WriterState -> m a
evalMD (WriterOptions -> Pandoc -> MD m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> MD m Text
pandocToMarkdown WriterOptions
opts{
writerWrapText = if isEnabled Ext_hard_line_breaks opts
then WrapNone
else writerWrapText opts }
Pandoc
document) WriterEnv
forall a. Default a => a
def WriterState
forall a. Default a => a
def
writePlain :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writePlain :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writePlain WriterOptions
opts Pandoc
document =
MD m Text -> WriterEnv -> WriterState -> m Text
forall (m :: * -> *) a.
PandocMonad m =>
MD m a -> WriterEnv -> WriterState -> m a
evalMD (WriterOptions -> Pandoc -> MD m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> MD m Text
pandocToMarkdown WriterOptions
opts Pandoc
document) WriterEnv
forall a. Default a => a
def{ envVariant = PlainText } WriterState
forall a. Default a => a
def
writeCommonMark :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writeCommonMark :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeCommonMark WriterOptions
opts Pandoc
document =
MD m Text -> WriterEnv -> WriterState -> m Text
forall (m :: * -> *) a.
PandocMonad m =>
MD m a -> WriterEnv -> WriterState -> m a
evalMD (WriterOptions -> Pandoc -> MD m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> MD m Text
pandocToMarkdown WriterOptions
opts' Pandoc
document) WriterEnv
forall a. Default a => a
def{ envVariant = Commonmark } WriterState
forall a. Default a => a
def
where
opts' :: WriterOptions
opts' = WriterOptions
opts{ writerExtensions =
enableExtension Ext_all_symbols_escapable $
enableExtension Ext_intraword_underscores $
writerExtensions opts ,
writerWrapText =
if isEnabled Ext_hard_line_breaks opts
then WrapNone
else writerWrapText opts }
writeMarkua :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writeMarkua :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeMarkua WriterOptions
opts Pandoc
document =
MD m Text -> WriterEnv -> WriterState -> m Text
forall (m :: * -> *) a.
PandocMonad m =>
MD m a -> WriterEnv -> WriterState -> m a
evalMD (WriterOptions -> Pandoc -> MD m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> MD m Text
pandocToMarkdown WriterOptions
opts' Pandoc
document) WriterEnv
forall a. Default a => a
def{ envVariant = Markua } WriterState
forall a. Default a => a
def
where
opts' :: WriterOptions
opts' = WriterOptions
opts{ writerExtensions =
enableExtension Ext_hard_line_breaks $
enableExtension Ext_pipe_tables $
enableExtension Ext_fancy_lists $
enableExtension Ext_startnum $
enableExtension Ext_strikeout $
enableExtension Ext_subscript $
enableExtension Ext_superscript $
enableExtension Ext_definition_lists $
enableExtension Ext_smart $
enableExtension Ext_footnotes
mempty ,
writerWrapText =
if isEnabled Ext_hard_line_breaks opts
then WrapNone
else writerWrapText opts }
pandocTitleBlock :: Doc Text -> [Doc Text] -> Doc Text -> Doc Text
pandocTitleBlock :: Doc Text -> [Doc Text] -> Doc Text -> Doc Text
pandocTitleBlock Doc Text
tit [Doc Text]
auths Doc Text
dat =
Int -> Doc Text -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a -> Doc a
hang Int
2 (String -> Doc Text
forall a. HasChars a => String -> Doc a
text String
"% ") Doc Text
tit Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
cr Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>
Int -> Doc Text -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a -> Doc a
hang Int
2 (String -> Doc Text
forall a. HasChars a => String -> Doc a
text String
"% ") ([Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat ([Doc Text] -> Doc Text) -> [Doc Text] -> Doc Text
forall a b. (a -> b) -> a -> b
$ (Doc Text -> Doc Text) -> [Doc Text] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map Doc Text -> Doc Text
forall a. IsString a => Doc a -> Doc a
nowrap [Doc Text]
auths) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
cr Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>
Int -> Doc Text -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a -> Doc a
hang Int
2 (String -> Doc Text
forall a. HasChars a => String -> Doc a
text String
"% ") Doc Text
dat Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
cr
mmdTitleBlock :: Context Text -> Doc Text
mmdTitleBlock :: Context Text -> Doc Text
mmdTitleBlock (Context Map Text (Val Text)
hashmap) =
[Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat ([Doc Text] -> Doc Text) -> [Doc Text] -> Doc Text
forall a b. (a -> b) -> a -> b
$ ((Text, Val Text) -> Doc Text) -> [(Text, Val Text)] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Val Text) -> Doc Text
forall {a}.
(HasChars a, ToText a, FromText a) =>
(Text, Val a) -> Doc a
go ([(Text, Val Text)] -> [Doc Text])
-> [(Text, Val Text)] -> [Doc Text]
forall a b. (a -> b) -> a -> b
$ ((Text, Val Text) -> Text)
-> [(Text, Val Text)] -> [(Text, Val Text)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Text -> Text
T.toCaseFold (Text -> Text)
-> ((Text, Val Text) -> Text) -> (Text, Val Text) -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, Val Text) -> Text
forall a b. (a, b) -> a
fst) ([(Text, Val Text)] -> [(Text, Val Text)])
-> [(Text, Val Text)] -> [(Text, Val Text)]
forall a b. (a -> b) -> a -> b
$ Map Text (Val Text) -> [(Text, Val Text)]
forall k a. Map k a -> [(k, a)]
M.toList Map Text (Val Text)
hashmap
where go :: (Text, Val a) -> Doc a
go (Text
k,Val a
v) =
case (String -> Doc a
forall a. HasChars a => String -> Doc a
text (Text -> String
T.unpack Text
k), Val a
v) of
(Doc a
k', ListVal [Val a]
xs)
| [Val a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Val a]
xs -> Doc a
forall a. Doc a
empty
| Bool
otherwise -> Doc a
k' Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a
":" Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a
forall a. Doc a
space Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<>
[Doc a] -> Doc a
forall a. [Doc a] -> Doc a
hcat (Doc a -> [Doc a] -> [Doc a]
forall a. a -> [a] -> [a]
intersperse Doc a
"; " ([Doc a] -> [Doc a]) -> [Doc a] -> [Doc a]
forall a b. (a -> b) -> a -> b
$
(Val a -> Maybe (Doc a)) -> [Val a] -> [Doc a]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Val a -> Maybe (Doc a)
forall a b. FromContext a b => Val a -> Maybe b
fromVal [Val a]
xs)
(Doc a
k', SimpleVal Doc a
x)
| Doc a -> Bool
forall a. Doc a -> Bool
isEmpty Doc a
x -> Doc a
forall a. Doc a
empty
| Bool
otherwise -> Doc a
k' Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a
":" Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a
forall a. Doc a
space Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<>
Int -> Doc a -> Doc a
forall a. IsString a => Int -> Doc a -> Doc a
nest Int
2 (Doc a -> Doc a
forall {a}. HasChars a => Doc a -> Doc a
removeBlankLines (Doc a -> Doc a
forall a. Doc a -> Doc a
chomp Doc a
x))
(Doc a, Val a)
_ -> Doc a
forall a. Doc a
empty
removeBlankLines :: Doc a -> Doc a
removeBlankLines BlankLines{} = Doc a
forall a. Doc a
cr Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> String -> Doc a
forall a. HasChars a => String -> Doc a
text String
"." Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a
forall a. Doc a
cr
removeBlankLines (Concat Doc a
x Doc a
y) = Doc a -> Doc a
removeBlankLines Doc a
x Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<>
Doc a -> Doc a
removeBlankLines Doc a
y
removeBlankLines Doc a
x = Doc a
x
plainTitleBlock :: Doc Text -> [Doc Text] -> Doc Text -> Doc Text
plainTitleBlock :: Doc Text -> [Doc Text] -> Doc Text -> Doc Text
plainTitleBlock Doc Text
tit [Doc Text]
auths Doc Text
dat =
Doc Text
tit Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
cr Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>
[Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
hcat (Doc Text -> [Doc Text] -> [Doc Text]
forall a. a -> [a] -> [a]
intersperse (String -> Doc Text
forall a. HasChars a => String -> Doc a
text String
"; ") [Doc Text]
auths) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
cr Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>
Doc Text
dat Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
cr
yamlMetadataBlock :: Context Text -> Doc Text
yamlMetadataBlock :: Context Text -> Doc Text
yamlMetadataBlock Context Text
v = Doc Text
"---" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Context Text -> Doc Text
contextToYaml Context Text
v Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
"---"
contextToYaml :: Context Text -> Doc Text
contextToYaml :: Context Text -> Doc Text
contextToYaml (Context Map Text (Val Text)
o) =
[Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat ([Doc Text] -> Doc Text) -> [Doc Text] -> Doc Text
forall a b. (a -> b) -> a -> b
$ ((Text, Val Text) -> Doc Text) -> [(Text, Val Text)] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Val Text) -> Doc Text
keyvalToYaml ([(Text, Val Text)] -> [Doc Text])
-> [(Text, Val Text)] -> [Doc Text]
forall a b. (a -> b) -> a -> b
$ ((Text, Val Text) -> Text)
-> [(Text, Val Text)] -> [(Text, Val Text)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Text -> Text
T.toCaseFold (Text -> Text)
-> ((Text, Val Text) -> Text) -> (Text, Val Text) -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, Val Text) -> Text
forall a b. (a, b) -> a
fst) ([(Text, Val Text)] -> [(Text, Val Text)])
-> [(Text, Val Text)] -> [(Text, Val Text)]
forall a b. (a -> b) -> a -> b
$ Map Text (Val Text) -> [(Text, Val Text)]
forall k a. Map k a -> [(k, a)]
M.toList Map Text (Val Text)
o
where
keyvalToYaml :: (Text, Val Text) -> Doc Text
keyvalToYaml (Text
k,Val Text
v) =
case (String -> Doc Text
forall a. HasChars a => String -> Doc a
text (Text -> String
T.unpack Text
k), Val Text
v) of
(Doc Text
k', ListVal [Val Text]
vs)
| [Val Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Val Text]
vs -> Doc Text
forall a. Doc a
empty
| Bool
otherwise -> (Doc Text
k' Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
":") Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Val Text -> Doc Text
valToYaml Val Text
v
(Doc Text
k', MapVal (Context Map Text (Val Text)
m))
| Map Text (Val Text) -> Bool
forall k a. Map k a -> Bool
M.null Map Text (Val Text)
m -> Doc Text
k' Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
": {}"
| Bool
otherwise -> (Doc Text
k' Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
":") Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Int -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a
nest Int
2 (Val Text -> Doc Text
valToYaml Val Text
v)
(Doc Text
_, SimpleVal Doc Text
x)
| Doc Text -> Bool
forall a. Doc a -> Bool
isEmpty Doc Text
x -> Doc Text
forall a. Doc a
empty
(Doc Text
_, Val Text
NullVal) -> Doc Text
forall a. Doc a
empty
(Doc Text
k', Val Text
_) -> Doc Text
k' Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
":" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
<+> Int -> Doc Text -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a -> Doc a
hang Int
2 Doc Text
"" (Val Text -> Doc Text
valToYaml Val Text
v)
valToYaml :: Val Text -> Doc Text
valToYaml :: Val Text -> Doc Text
valToYaml (ListVal [Val Text]
xs) =
[Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat ([Doc Text] -> Doc Text) -> [Doc Text] -> Doc Text
forall a b. (a -> b) -> a -> b
$ (Val Text -> Doc Text) -> [Val Text] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map (\Val Text
v -> Int -> Doc Text -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a -> Doc a
hang Int
2 Doc Text
"- " (Val Text -> Doc Text
valToYaml Val Text
v)) [Val Text]
xs
valToYaml (MapVal Context Text
c) = Context Text -> Doc Text
contextToYaml Context Text
c
valToYaml (BoolVal Bool
True) = Doc Text
"true"
valToYaml (BoolVal Bool
False) = Doc Text
"false"
valToYaml (SimpleVal Doc Text
x)
| Doc Text -> Bool
forall a. Doc a -> Bool
isEmpty Doc Text
x = Doc Text
forall a. Doc a
empty
| Bool
otherwise =
if Doc Text -> Bool
forall a. Doc a -> Bool
hasNewlines Doc Text
x
then Int -> Doc Text -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a -> Doc a
hang Int
0 (Doc Text
"|" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
cr) Doc Text
x
else case Doc Text
x of
Text Int
_ Text
t | Text -> Bool
isSpecialString Text
t ->
Doc Text
"\"" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> (Text -> Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> Doc a -> Doc b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
escapeInDoubleQuotes Doc Text
x Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"\""
Doc Text
_ | Maybe Bool -> Bool
forall a. Maybe a -> Bool
isNothing ((Bool -> Text -> Maybe Bool) -> Bool -> Doc Text -> Maybe Bool
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Bool -> Text -> Maybe Bool
needsDoubleQuotes Bool
True Doc Text
x) ->
Doc Text
"\"" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> (Text -> Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> Doc a -> Doc b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
escapeInDoubleQuotes Doc Text
x Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"\""
| Bool
otherwise -> Doc Text
x
where
isSpecialString :: Text -> Bool
isSpecialString Text
t = Text -> Set Text -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member Text
t Set Text
specialStrings
specialStrings :: Set Text
specialStrings = [Text] -> Set Text
forall a. Ord a => [a] -> Set a
Set.fromList
[Text
"y", Text
"Y", Text
"yes", Text
"Yes", Text
"YES", Text
"n", Text
"N",
Text
"no", Text
"No", Text
"NO", Text
"true", Text
"True", Text
"TRUE",
Text
"false", Text
"False", Text
"FALSE", Text
"on", Text
"On", Text
"ON",
Text
"off", Text
"Off", Text
"OFF", Text
"null", Text
"Null",
Text
"NULL", Text
"~", Text
"*"]
needsDoubleQuotes :: Bool -> Text -> Maybe Bool
needsDoubleQuotes Bool
isFirst Text
t
= if (Char -> Bool) -> Text -> Bool
T.any Char -> Bool
isBadAnywhere Text
t Bool -> Bool -> Bool
||
(Bool
isFirst Bool -> Bool -> Bool
&& (Char -> Bool) -> Text -> Bool
T.any Char -> Bool
isYamlPunct (Int -> Text -> Text
T.take Int
1 Text
t))
then Maybe Bool
forall a. Maybe a
Nothing
else Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False
isBadAnywhere :: Char -> Bool
isBadAnywhere Char
'#' = Bool
True
isBadAnywhere Char
':' = Bool
True
isBadAnywhere Char
_ = Bool
False
hasNewlines :: Doc a -> Bool
hasNewlines Doc a
NewLine = Bool
True
hasNewlines BlankLines{} = Bool
True
hasNewlines Doc a
CarriageReturn = Bool
True
hasNewlines (Concat Doc a
w Doc a
z) = Doc a -> Bool
hasNewlines Doc a
w Bool -> Bool -> Bool
|| Doc a -> Bool
hasNewlines Doc a
z
hasNewlines Doc a
_ = Bool
False
isYamlPunct :: Char -> Bool
isYamlPunct = (Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'-',Char
'?',Char
':',Char
',',Char
'[',Char
']',Char
'{',Char
'}',
Char
'#',Char
'&',Char
'*',Char
'!',Char
'|',Char
'>',Char
'\'',Char
'"', Char
'%',Char
'@',Char
'`'])
escapeInDoubleQuotes :: Text -> Text
escapeInDoubleQuotes = HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"\"" Text
"\\\"" (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"\\" Text
"\\\\"
valToYaml Val Text
_ = Doc Text
forall a. Doc a
empty
pandocToMarkdown :: PandocMonad m => WriterOptions -> Pandoc -> MD m Text
pandocToMarkdown :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> MD m Text
pandocToMarkdown WriterOptions
opts (Pandoc Meta
meta [Block]
blocks) = do
let colwidth :: Maybe Int
colwidth = if WriterOptions -> WrapOption
writerWrapText WriterOptions
opts WrapOption -> WrapOption -> Bool
forall a. Eq a => a -> a -> Bool
== WrapOption
WrapAuto
then Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ WriterOptions -> Int
writerColumns WriterOptions
opts
else Maybe Int
forall a. Maybe a
Nothing
variant <- (WriterEnv -> MarkdownVariant)
-> ReaderT WriterEnv (StateT WriterState m) MarkdownVariant
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> MarkdownVariant
envVariant
metadata <- metaToContext'
(blockListToMarkdown opts)
(inlineListToMarkdown opts)
meta
let title' = Doc Text -> Maybe (Doc Text) -> Doc Text
forall a. a -> Maybe a -> a
fromMaybe Doc Text
forall a. Doc a
empty (Maybe (Doc Text) -> Doc Text) -> Maybe (Doc Text) -> Doc Text
forall a b. (a -> b) -> a -> b
$ Text -> Context Text -> Maybe (Doc Text)
forall a b. FromContext a b => Text -> Context a -> Maybe b
getField Text
"title" Context Text
metadata
let authors' = [Doc Text] -> Maybe [Doc Text] -> [Doc Text]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [Doc Text] -> [Doc Text]) -> Maybe [Doc Text] -> [Doc Text]
forall a b. (a -> b) -> a -> b
$ Text -> Context Text -> Maybe [Doc Text]
forall a b. FromContext a b => Text -> Context a -> Maybe b
getField Text
"author" Context Text
metadata
let date' = Doc Text -> Maybe (Doc Text) -> Doc Text
forall a. a -> Maybe a -> a
fromMaybe Doc Text
forall a. Doc a
empty (Maybe (Doc Text) -> Doc Text) -> Maybe (Doc Text) -> Doc Text
forall a b. (a -> b) -> a -> b
$ Text -> Context Text -> Maybe (Doc Text)
forall a b. FromContext a b => Text -> Context a -> Maybe b
getField Text
"date" Context Text
metadata
let titleblock = case WriterOptions -> Maybe (Template Text)
writerTemplate WriterOptions
opts of
Just Template Text
_ | MarkdownVariant
variant MarkdownVariant -> MarkdownVariant -> Bool
forall a. Eq a => a -> a -> Bool
== MarkdownVariant
PlainText ->
Doc Text -> [Doc Text] -> Doc Text -> Doc Text
plainTitleBlock Doc Text
title' [Doc Text]
authors' Doc Text
date'
| Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_yaml_metadata_block WriterOptions
opts ->
Context Text -> Doc Text
yamlMetadataBlock Context Text
metadata
| Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_pandoc_title_block WriterOptions
opts ->
Doc Text -> [Doc Text] -> Doc Text -> Doc Text
pandocTitleBlock Doc Text
title' [Doc Text]
authors' Doc Text
date'
| Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_mmd_title_block WriterOptions
opts ->
Context Text -> Doc Text
mmdTitleBlock Context Text
metadata
| Bool
otherwise -> Doc Text
forall a. Doc a
empty
Maybe (Template Text)
Nothing -> Doc Text
forall a. Doc a
empty
let modifyTOC =
if Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_link_attributes WriterOptions
opts Bool -> Bool -> Bool
|| Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_attributes WriterOptions
opts
then Block -> Block
forall a. a -> a
id
else (Inline -> Inline) -> Block -> Block
forall a b. Walkable a b => (a -> a) -> b -> b
walk ((Inline -> Inline) -> Block -> Block)
-> (Inline -> Inline) -> Block -> Block
forall a b. (a -> b) -> a -> b
$ \Inline
inln -> case Inline
inln of
Link Attr
_attr [Inline]
contents Target
tgt -> Attr -> [Inline] -> Target -> Inline
Link Attr
nullAttr [Inline]
contents Target
tgt
Inline
_ -> Inline
inln
toc <- if writerTableOfContents opts
then blockToMarkdown opts . modifyTOC $ toTableOfContents opts blocks
else return mempty
let blocks' = if Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_citations WriterOptions
opts
then case [Block] -> [Block]
forall a. [a] -> [a]
reverse [Block]
blocks of
(Div (Text
"refs",[Text]
_,[Target]
_) [Block]
_):[Block]
xs -> [Block] -> [Block]
forall a. [a] -> [a]
reverse [Block]
xs
[Block]
_ -> [Block]
blocks
else [Block]
blocks
body <- blockListToMarkdown opts blocks'
notesAndRefs' <- notesAndRefs opts
let main = Doc Text
body Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
notesAndRefs'
let context =
Text -> Doc Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"toc" Doc Text
toc
(Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"table-of-contents" Doc Text
toc
(Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"body" Doc Text
main
(Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$ (if Meta -> Bool
isNullMeta Meta
meta
then Context Text -> Context Text
forall a. a -> a
id
else Text -> Doc Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"titleblock" Doc Text
titleblock)
(Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$ WriterOptions -> Context Text -> Context Text
forall a.
TemplateTarget a =>
WriterOptions -> Context a -> Context a
addVariablesToContext WriterOptions
opts Context Text
metadata
return $ render colwidth $
case writerTemplate opts of
Maybe (Template Text)
Nothing -> Doc Text
main
Just Template Text
tpl -> Template Text -> Context Text -> Doc Text
forall a b.
(TemplateTarget a, ToContext a b) =>
Template a -> b -> Doc a
renderTemplate Template Text
tpl Context Text
context
refsToMarkdown :: PandocMonad m => WriterOptions -> Refs -> MD m (Doc Text)
refsToMarkdown :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Refs -> MD m (Doc Text)
refsToMarkdown WriterOptions
opts Refs
refs = [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat ([Doc Text] -> Doc Text)
-> ReaderT WriterEnv (StateT WriterState m) [Doc Text]
-> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Ref -> ReaderT WriterEnv (StateT WriterState 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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (WriterOptions
-> Ref -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Ref -> MD m (Doc Text)
keyToMarkdown WriterOptions
opts) Refs
refs
keyToMarkdown :: PandocMonad m
=> WriterOptions
-> Ref
-> MD m (Doc Text)
keyToMarkdown :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Ref -> MD m (Doc Text)
keyToMarkdown WriterOptions
opts (Text
label', (Text
src, Text
tit), 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 -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
tit Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"\""
Doc Text -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
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
$ Int -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a
nest Int
2 (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Int -> Doc Text -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a -> Doc a
hang Int
2
(Doc Text
"[" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
label' Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"]:" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
space) (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
src Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
tit')
Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
<+> WriterOptions -> Attr -> Doc Text
linkAttributes WriterOptions
opts Attr
attr
notesToMarkdown :: PandocMonad m => WriterOptions -> [[Block]] -> MD m (Doc Text)
notesToMarkdown :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [[Block]] -> MD m (Doc Text)
notesToMarkdown WriterOptions
opts [[Block]]
notes = do
n <- (WriterState -> Int)
-> ReaderT WriterEnv (StateT WriterState m) Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Int
stNoteNum
notes' <- zipWithM (noteToMarkdown opts) [n..] notes
modify $ \WriterState
st -> WriterState
st { stNoteNum = stNoteNum st + length notes }
return $ vsep notes'
noteToMarkdown :: PandocMonad m => WriterOptions -> Int -> [Block] -> MD m (Doc Text)
noteToMarkdown :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Int -> [Block] -> MD m (Doc Text)
noteToMarkdown WriterOptions
opts Int
num [Block]
blocks = do
contents <- WriterOptions -> [Block] -> MD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> MD m (Doc Text)
blockListToMarkdown WriterOptions
opts [Block]
blocks
let 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 = if Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_footnotes WriterOptions
opts
then Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
"[^" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
num' Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
"]:"
else Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
"[" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
num' Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
"]"
let markerSize = Int
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 hspacer = case WriterOptions -> Int
writerTabStop WriterOptions
opts Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
markerSize of
Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 -> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.replicate Int
n Text
" "
Int
_ -> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
" "
let spacer = case [Block]
blocks of
Para{}:[Block]
_ -> Doc Text
hspacer
Plain{}:[Block]
_ -> Doc Text
hspacer
[Block]
_ -> Doc Text
forall a. Doc a
cr
return $ if isEnabled Ext_footnotes opts
then hang (writerTabStop opts) (marker <> spacer) contents
else marker <> spacer <> contents
classOrAttrsToMarkdown :: WriterOptions -> Attr -> Doc Text
classOrAttrsToMarkdown :: WriterOptions -> Attr -> Doc Text
classOrAttrsToMarkdown WriterOptions
_ (Text
"",[Text
cls],[]) = Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
cls
classOrAttrsToMarkdown WriterOptions
opts Attr
attrs = WriterOptions -> Attr -> Doc Text
attrsToMarkdown WriterOptions
opts Attr
attrs
olMarker :: Parsec Text ParserState ()
olMarker :: Parsec Text ParserState ()
olMarker = do (start, style', delim) <- ParsecT
Text ParserState Identity (Int, ListNumberStyle, ListNumberDelim)
forall s (m :: * -> *).
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s ParserState m (Int, ListNumberStyle, ListNumberDelim)
anyOrderedListMarker
if delim == Period &&
(style' == UpperAlpha || (style' == UpperRoman &&
start `elem` [1, 5, 10, 50, 100, 500, 1000]))
then mzero
else eof
beginsWithOrderedListMarker :: Text -> Bool
beginsWithOrderedListMarker :: Text -> Bool
beginsWithOrderedListMarker Text
str =
case Parsec 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 Parsec Text ParserState ()
olMarker ParserState
defaultParserState String
"para start" (Int -> Text -> Text
T.take Int
10 Text
str) of
Left ParseError
_ -> Bool
False
Right ()
_ -> Bool
True
notesAndRefs :: PandocMonad m => WriterOptions -> MD m (Doc Text)
notesAndRefs :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> MD m (Doc Text)
notesAndRefs WriterOptions
opts = do
notes' <- (WriterState -> [[Block]])
-> ReaderT WriterEnv (StateT WriterState m) [[Block]]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> [[Block]]
stNotes ReaderT WriterEnv (StateT WriterState m) [[Block]]
-> ([[Block]]
-> ReaderT WriterEnv (StateT WriterState m) (Doc Text))
-> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
forall a b.
ReaderT WriterEnv (StateT WriterState m) a
-> (a -> ReaderT WriterEnv (StateT WriterState m) b)
-> ReaderT WriterEnv (StateT WriterState m) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= WriterOptions
-> [[Block]] -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [[Block]] -> MD m (Doc Text)
notesToMarkdown WriterOptions
opts ([[Block]] -> ReaderT WriterEnv (StateT WriterState m) (Doc Text))
-> ([[Block]] -> [[Block]])
-> [[Block]]
-> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Block]] -> [[Block]]
forall a. [a] -> [a]
reverse
modify $ \WriterState
s -> WriterState
s { stNotes = [] }
refs' <- gets stRefs >>= refsToMarkdown opts . reverse
modify $ \WriterState
s -> WriterState
s { stPrevRefs = stPrevRefs s ++ stRefs s
, stRefs = []}
let 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
return $
(if isEmpty notes' then empty else blankline <> notes') <>
(if isEmpty refs' then empty else blankline <> refs') <>
endSpacing
blockToMarkdown :: PandocMonad m
=> WriterOptions
-> Block
-> MD m (Doc Text)
blockToMarkdown :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> MD m (Doc Text)
blockToMarkdown WriterOptions
opts Block
blk =
(WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
-> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
forall a.
(WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (StateT WriterState m) a
-> ReaderT WriterEnv (StateT WriterState m) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
env -> WriterEnv
env {envBlockLevel = envBlockLevel env + 1}) (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
$
do doc <- WriterOptions
-> Block -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> MD m (Doc Text)
blockToMarkdown' WriterOptions
opts Block
blk
blkLevel <- asks envBlockLevel
if writerReferenceLocation opts == EndOfBlock && blkLevel == 1
then notesAndRefs opts >>= (\Doc Text
d -> Doc Text -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
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
doc Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
d)
else return doc
blockToMarkdown' :: PandocMonad m
=> WriterOptions
-> Block
-> MD m (Doc Text)
blockToMarkdown' :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> MD m (Doc Text)
blockToMarkdown' WriterOptions
opts (Div attrs :: Attr
attrs@(Text
_,[Text]
classes,[Target]
_) [Block]
bs)
| Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_alerts WriterOptions
opts
, (Text
cls:[Text]
_) <- [Text]
classes
, Text
cls Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"note", Text
"tip", Text
"warning", Text
"caution", Text
"important"]
, (Div (Text
"", [Text
"title"], []) [Block]
_ : Para [Inline]
ils : [Block]
bs') <- [Block]
bs
= 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
$ [Block] -> Block
BlockQuote ([Block] -> Block) -> [Block] -> Block
forall a b. (a -> b) -> a -> b
$
([Inline] -> Block
Para (Format -> Text -> Inline
RawInline (Text -> Format
Format Text
"markdown") (case Text
cls of
Text
"note" -> Text
"[!NOTE]\n"
Text
"tip" -> Text
"[!TIP]\n"
Text
"warning" -> Text
"[!WARNING]\n"
Text
"caution" -> Text
"[!CAUTION]\n"
Text
"important" -> Text
"[!IMPORTANT]\n"
Text
_ -> Text
"[!NOTE]\n") Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
ils)) Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
bs'
| Bool
otherwise = do
contents <- WriterOptions -> [Block] -> MD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> MD m (Doc Text)
blockListToMarkdown WriterOptions
opts [Block]
bs
variant <- asks envVariant
return $
case () of
()
_ | MarkdownVariant
variant MarkdownVariant -> MarkdownVariant -> Bool
forall a. Eq a => a -> a -> Bool
== MarkdownVariant
Markua ->
case () of
() | Text
"blurb" Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes'
-> String -> Doc Text -> Doc Text
forall a. IsString a => String -> Doc a -> Doc a
prefixed String
"B> " Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
blankline
| Text
"aside" Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes'
-> String -> Doc Text -> Doc Text
forall a. IsString a => String -> Doc a -> Doc a
prefixed String
"A> " Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
blankline
| (Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (Text -> String
T.unpack Text
id')) String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"ref"
-> Doc Text
contents 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
| 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 ->
let attrsToMd :: Attr -> Doc Text
attrsToMd = if MarkdownVariant
variant MarkdownVariant -> MarkdownVariant -> Bool
forall a. Eq a => a -> a -> Bool
== MarkdownVariant
Commonmark
then WriterOptions -> Attr -> Doc Text
attrsToMarkdown WriterOptions
opts
else WriterOptions -> Attr -> Doc Text
classOrAttrsToMarkdown WriterOptions
opts
divNesting :: Int
divNesting = [Block] -> Int
computeDivNestingLevel [Block]
bs
numcolons :: Int
numcolons = Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
divNesting
colons :: Doc Text
colons = 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
numcolons Text
":"
in Doc Text -> Doc Text
forall a. IsString a => Doc a -> Doc a
nowrap (Doc Text
colons Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
<+> Attr -> Doc Text
attrsToMd 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
$$
Doc Text
colons Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
blankline
| Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_native_divs WriterOptions
opts Bool -> Bool -> Bool
||
(Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_raw_html WriterOptions
opts Bool -> Bool -> Bool
&&
(MarkdownVariant
variant MarkdownVariant -> MarkdownVariant -> Bool
forall a. Eq a => a -> a -> Bool
== MarkdownVariant
Commonmark Bool -> Bool -> Bool
||
Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_markdown_in_html_blocks WriterOptions
opts)) ->
Text -> Attr -> Doc Text
forall a. HasChars a => a -> Attr -> Doc a
tagWithAttrs Text
"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
<> Doc Text
"</div>" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
blankline
| Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_raw_html WriterOptions
opts Bool -> Bool -> Bool
&&
Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_markdown_attribute WriterOptions
opts ->
Text -> Attr -> Doc Text
forall a. HasChars a => a -> Attr -> Doc a
tagWithAttrs Text
"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
<> Doc Text
"</div>" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
blankline
| Bool
otherwise -> Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
blankline
where (Text
id',[Text]
classes',[Target]
kvs') = Attr
attrs
attrs' :: Attr
attrs' = (Text
id',[Text]
classes',(Text
"markdown",Text
"1")Target -> [Target] -> [Target]
forall a. a -> [a] -> [a]
:[Target]
kvs')
blockToMarkdown' WriterOptions
opts (Plain [Inline]
inlines) = do
variant <- (WriterEnv -> MarkdownVariant)
-> ReaderT WriterEnv (StateT WriterState m) MarkdownVariant
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> MarkdownVariant
envVariant
let escapeMarker = (Char -> Text) -> Text -> Text
T.concatMap ((Char -> Text) -> Text -> Text) -> (Char -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ \Char
x -> if (Char -> Bool) -> Text -> Bool
T.any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
x) Text
".()"
then String -> Text
T.pack [Char
'\\', Char
x]
else Char -> Text
T.singleton Char
x
let startsWithSpace (Inline
Space:[Inline]
_) = Bool
True
startsWithSpace (Inline
SoftBreak:[Inline]
_) = Bool
True
startsWithSpace [Inline]
_ = Bool
False
let inlines' =
if MarkdownVariant
variant MarkdownVariant -> MarkdownVariant -> Bool
forall a. Eq a => a -> a -> Bool
== MarkdownVariant
PlainText
then [Inline]
inlines
else case [Inline]
inlines of
(Str Text
t:[Inline]
ys)
| [Inline] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
ys Bool -> Bool -> Bool
|| [Inline] -> Bool
startsWithSpace [Inline]
ys
, Text -> Bool
beginsWithOrderedListMarker Text
t
-> Format -> Text -> Inline
RawInline (Text -> Format
Format Text
"markdown") (Text -> Text
escapeMarker Text
t)Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
:[Inline]
ys
(Str Text
t:[Inline]
_)
| Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"+" Bool -> Bool -> Bool
|| Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"-" Bool -> Bool -> Bool
||
(Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"%" Bool -> Bool -> Bool
&& Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_pandoc_title_block WriterOptions
opts Bool -> Bool -> Bool
&&
Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_all_symbols_escapable WriterOptions
opts)
-> Format -> Text -> Inline
RawInline (Text -> Format
Format Text
"markdown") Text
"\\" Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
inlines
[Inline]
_ -> [Inline]
inlines
contents <- inlineListToMarkdown opts inlines'
return $ contents <> cr
blockToMarkdown' WriterOptions
opts (Para [Inline]
inlines) =
(Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
blankline) (Doc Text -> Doc Text) -> MD m (Doc Text) -> MD m (Doc Text)
forall a b.
(a -> b)
-> ReaderT WriterEnv (StateT WriterState m) a
-> ReaderT WriterEnv (StateT WriterState m) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` WriterOptions -> Block -> MD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> MD m (Doc Text)
blockToMarkdown WriterOptions
opts ([Inline] -> Block
Plain [Inline]
inlines)
blockToMarkdown' WriterOptions
opts (LineBlock [[Inline]]
lns) = do
variant <- (WriterEnv -> MarkdownVariant)
-> ReaderT WriterEnv (StateT WriterState m) MarkdownVariant
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> MarkdownVariant
envVariant
case variant of
MarkdownVariant
PlainText -> do
let emptyToBlank :: Doc a -> Doc a
emptyToBlank Doc a
l = if Doc a -> Bool
forall a. Doc a -> Bool
isEmpty Doc a
l then Doc a
forall a. Doc a
blankline else Doc a
l
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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((Doc Text -> Doc Text) -> MD m (Doc Text) -> MD m (Doc Text)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Doc Text -> Doc Text
forall a. Doc a -> Doc a
emptyToBlank (MD m (Doc Text) -> MD m (Doc Text))
-> ([Inline] -> MD m (Doc Text)) -> [Inline] -> MD m (Doc Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterOptions -> [Inline] -> MD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> MD m (Doc Text)
inlineListToMarkdown WriterOptions
opts) [[Inline]]
lns
return $ vcat mdLines <> blankline
MarkdownVariant
_ ->
if Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_line_blocks WriterOptions
opts
then do
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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (WriterOptions -> [Inline] -> MD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> MD m (Doc Text)
inlineListToMarkdown WriterOptions
opts) [[Inline]]
lns
return $ vcat (map (hang 2 (literal "| ")) mdLines) <> blankline
else WriterOptions -> Block -> MD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> MD m (Doc Text)
blockToMarkdown WriterOptions
opts (Block -> MD m (Doc Text)) -> Block -> MD m (Doc Text)
forall a b. (a -> b) -> a -> b
$ [[Inline]] -> Block
linesToPara [[Inline]]
lns
blockToMarkdown' WriterOptions
opts b :: Block
b@(RawBlock Format
f Text
str) = do
variant <- (WriterEnv -> MarkdownVariant)
-> ReaderT WriterEnv (StateT WriterState m) MarkdownVariant
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> MarkdownVariant
envVariant
let Format fmt = f
let rawAttribBlock = Doc Text -> MD m (Doc Text)
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> MD m (Doc Text)) -> Doc Text -> MD m (Doc Text)
forall a b. (a -> b) -> a -> b
$
(Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
"```{=" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
fmt Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"}") Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
str Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
(Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
"```" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
"\n")
let renderEmpty = Doc Text
forall a. Monoid a => a
mempty Doc Text
-> ReaderT WriterEnv (StateT WriterState m) () -> MD m (Doc Text)
forall a b.
a
-> ReaderT WriterEnv (StateT WriterState m) b
-> ReaderT WriterEnv (StateT WriterState m) a
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 variant of
MarkdownVariant
PlainText
| Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Format
"plain" -> Doc Text -> MD m (Doc Text)
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> MD m (Doc Text)) -> Doc Text -> MD m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Int -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a
nest Int
0 (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
str) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
"\n"
MarkdownVariant
Commonmark
| Format
f Format -> [Format] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Format
"gfm", Format
"commonmark", Format
"commonmark_x", Format
"markdown"]
-> Doc Text -> MD m (Doc Text)
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> MD m (Doc Text)) -> Doc Text -> MD m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Int -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a
nest Int
0 (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
str) Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
forall a. Doc a
blankline
| Format
f Format -> [Format] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Format
"html", Format
"html5", Format
"html4"]
-> Doc Text -> MD m (Doc Text)
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
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
removeBlankLinesInHTML Text
str) Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
forall a. Doc a
blankline
MarkdownVariant
Markdown
| Format
f Format -> [Format] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Format
"markdown", Format
"markdown_github", Format
"markdown_phpextra",
Format
"markdown_mmd", Format
"markdown_strict"]
-> Doc Text -> MD m (Doc Text)
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> MD m (Doc Text)) -> Doc Text -> MD m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Int -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a
nest Int
0 (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
str) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
"\n"
MarkdownVariant
Markua -> MD m (Doc Text)
renderEmpty
MarkdownVariant
_ | Format
f Format -> [Format] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Format
"html", Format
"html5", Format
"html4"]
, Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_markdown_attribute WriterOptions
opts
-> Doc Text -> MD m (Doc Text)
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> MD m (Doc Text)) -> Doc Text -> MD m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Text
addMarkdownAttribute Text
str) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
"\n"
| Format
f Format -> [Format] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Format
"html", Format
"html5", Format
"html4"]
, Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_raw_html WriterOptions
opts
-> Doc Text -> MD m (Doc Text)
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> MD m (Doc Text)) -> Doc Text -> MD m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
str Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
"\n"
| Format
f Format -> [Format] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Format
"latex", Format
"tex"]
, Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_raw_tex WriterOptions
opts
-> Doc Text -> MD m (Doc Text)
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> MD m (Doc Text)) -> Doc Text -> MD m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
str Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
"\n"
| Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_raw_attribute WriterOptions
opts -> MD m (Doc Text)
rawAttribBlock
MarkdownVariant
_ -> MD m (Doc Text)
renderEmpty
blockToMarkdown' WriterOptions
opts Block
HorizontalRule = do
variant <- (WriterEnv -> MarkdownVariant)
-> ReaderT WriterEnv (StateT WriterState m) MarkdownVariant
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> MarkdownVariant
envVariant
let indicator = case MarkdownVariant
variant of
MarkdownVariant
Markua -> Text
"* * *"
MarkdownVariant
_ -> Int -> Text -> Text
T.replicate (WriterOptions -> Int
writerColumns WriterOptions
opts) Text
"-"
return $ blankline <> literal indicator <> blankline
blockToMarkdown' WriterOptions
opts (Header Int
level Attr
attr [Inline]
inlines) = do
blkLevel <- (WriterEnv -> Int) -> ReaderT WriterEnv (StateT WriterState m) Int
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Int
envBlockLevel
refs <- if writerReferenceLocation opts == EndOfSection && blkLevel == 1
then notesAndRefs opts
else return empty
variant <- asks envVariant
ids <- gets stIds
let autoId = Extensions -> [Inline] -> Set Text -> Text
uniqueIdent (WriterOptions -> Extensions
writerExtensions WriterOptions
opts) [Inline]
inlines Set Text
ids
modify $ \WriterState
st -> WriterState
st{ stIds = Set.insert autoId ids }
let attr' = case Attr
attr of
(Text
"",[],[]) -> Doc Text
forall a. Doc a
empty
(Text
id',[],[]) | (Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_auto_identifiers WriterOptions
opts
Bool -> Bool -> Bool
|| Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_gfm_auto_identifiers WriterOptions
opts)
Bool -> Bool -> Bool
&& Text
id' Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
autoId -> Doc Text
forall a. Doc a
empty
(Text
id',[Text]
_,[Target]
_) | 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')
Attr
_ | MarkdownVariant
variant MarkdownVariant -> MarkdownVariant -> Bool
forall a. Eq a => a -> a -> Bool
== MarkdownVariant
Markua -> WriterOptions -> Attr -> Doc Text
attrsToMarkua WriterOptions
opts Attr
attr
| Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_header_attributes WriterOptions
opts Bool -> Bool -> Bool
||
Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_attributes WriterOptions
opts ->
Doc Text
forall a. Doc a
space Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> WriterOptions -> Attr -> Doc Text
attrsToMarkdown WriterOptions
opts Attr
attr
| Bool
otherwise -> Doc Text
forall a. Doc a
empty
contents <- inlineListToMarkdown opts $
walk lineBreakToSpace $
if level == 1 && variant == PlainText &&
isEnabled Ext_gutenberg opts
then capitalize inlines
else inlines
let setext = WriterOptions -> Bool
writerSetextHeaders WriterOptions
opts
when (not setext && isEnabled Ext_literate_haskell opts) $
report $ ATXHeadingInLHS level (render Nothing contents)
let hdr = Doc Text -> Doc Text
forall a. IsString a => Doc a -> Doc a
nowrap (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ case Int
level of
Int
1 | MarkdownVariant
variant MarkdownVariant -> MarkdownVariant -> Bool
forall a. Eq a => a -> a -> Bool
== MarkdownVariant
PlainText ->
if Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_gutenberg WriterOptions
opts
then Int -> Doc Text
forall a. Int -> Doc a
blanklines Int
3 Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Int -> Doc Text
forall a. Int -> Doc a
blanklines Int
2
else Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
blankline
| Bool
setext ->
Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
attr' Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
cr Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Int -> Text -> Text
T.replicate (Doc Text -> Int
forall a. (IsString a, HasChars a) => Doc a -> Int
offset Doc Text
contents) Text
"=") Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>
Doc Text
forall a. Doc a
blankline
Int
2 | MarkdownVariant
variant MarkdownVariant -> MarkdownVariant -> Bool
forall a. Eq a => a -> a -> Bool
== MarkdownVariant
PlainText ->
if Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_gutenberg WriterOptions
opts
then Int -> Doc Text
forall a. Int -> Doc a
blanklines Int
2 Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
blankline
else Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
blankline
| Bool
setext ->
Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
attr' Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
cr Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Int -> Text -> Text
T.replicate (Doc Text -> Int
forall a. (IsString a, HasChars a) => Doc a -> Int
offset Doc Text
contents) Text
"-") Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>
Doc Text
forall a. Doc a
blankline
Int
_ | MarkdownVariant
variant MarkdownVariant -> MarkdownVariant -> Bool
forall a. Eq a => a -> a -> Bool
== MarkdownVariant
PlainText Bool -> Bool -> Bool
|| Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_literate_haskell WriterOptions
opts ->
Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
blankline
Int
_ | MarkdownVariant
variant MarkdownVariant -> MarkdownVariant -> Bool
forall a. Eq a => a -> a -> Bool
== MarkdownVariant
Markua -> 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 Int
level Text
"#")
Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
space Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
blankline
Int
_ -> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Int -> Text -> Text
T.replicate Int
level Text
"#") Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
space Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
attr' Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
blankline
return $ refs <> hdr
blockToMarkdown' WriterOptions
opts (CodeBlock (Text
_,[Text]
classes,[Target]
_) Text
str)
| Text
"haskell" Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes Bool -> Bool -> Bool
&& Text
"literate" Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes Bool -> Bool -> Bool
&&
Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_literate_haskell WriterOptions
opts =
Doc Text -> MD m (Doc Text)
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> MD m (Doc Text)) -> Doc Text -> MD m (Doc Text)
forall a b. (a -> b) -> a -> b
$ String -> Doc Text -> Doc Text
forall a. IsString a => String -> Doc a -> Doc a
prefixed String
"> " (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
str) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
blankline
blockToMarkdown' WriterOptions
opts (CodeBlock Attr
attribs Text
str) = do
variant <- (WriterEnv -> MarkdownVariant)
-> ReaderT WriterEnv (StateT WriterState m) MarkdownVariant
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> MarkdownVariant
envVariant
return $
case attribs == nullAttr of
Bool
False | MarkdownVariant
variant MarkdownVariant -> MarkdownVariant -> Bool
forall a. Eq a => a -> a -> Bool
== MarkdownVariant
Commonmark Bool -> Bool -> Bool
||
Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_backtick_code_blocks WriterOptions
opts ->
Doc Text
backticks Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
attrs Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
cr Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
str Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
cr Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
backticks Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
blankline
| Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_fenced_code_blocks WriterOptions
opts ->
Doc Text
tildes Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
attrs Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
cr Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
str Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
cr Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
tildes Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
blankline
Bool
_ | MarkdownVariant
variant MarkdownVariant -> MarkdownVariant -> Bool
forall a. Eq a => a -> a -> Bool
== MarkdownVariant
Markua -> Doc Text
forall a. Doc a
blankline Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> WriterOptions -> Attr -> Doc Text
attrsToMarkua WriterOptions
opts Attr
attribs 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
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
cr Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
blankline
| Bool
otherwise -> Int -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a
nest (WriterOptions -> Int
writerTabStop WriterOptions
opts) (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
str) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
blankline
where
endlineLen :: Char -> Int
endlineLen Char
c = Int -> (NonEmpty Int -> Int) -> Maybe (NonEmpty Int) -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
3 ((Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int -> Int) -> (NonEmpty Int -> Int) -> NonEmpty Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Int -> Int
forall a. Ord a => NonEmpty a -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum) (Maybe (NonEmpty Int) -> Int) -> Maybe (NonEmpty Int) -> Int
forall a b. (a -> b) -> a -> b
$ [Int] -> Maybe (NonEmpty Int)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty
[Text -> Int
T.length Text
ln
| Text
ln <- (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
trim (Text -> [Text]
T.lines Text
str)
, String -> Text
T.pack [Char
c,Char
c,Char
c] Text -> Text -> Bool
`T.isPrefixOf` Text
ln
, (Char -> Bool) -> Text -> Bool
T.all (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c) Text
ln]
endline :: Char -> Doc Text
endline Char
c = Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.replicate (Char -> Int
endlineLen Char
c) (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Char -> Text
T.singleton Char
c
backticks :: Doc Text
backticks = Char -> Doc Text
endline Char
'`'
tildes :: Doc Text
tildes = Char -> Doc Text
endline Char
'~'
attrs :: Doc Text
attrs = if Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_fenced_code_attributes WriterOptions
opts Bool -> Bool -> Bool
||
Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_attributes WriterOptions
opts
then Doc Text -> Doc Text
forall a. IsString a => Doc a -> Doc a
nowrap (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Doc Text
" " Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> WriterOptions -> Attr -> Doc Text
classOrAttrsToMarkdown WriterOptions
opts Attr
attribs
else case Attr
attribs of
(Text
_,Text
cls:[Text]
_,[Target]
_) -> Doc Text
" " Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
cls
Attr
_ -> Doc Text
forall a. Doc a
empty
blockToMarkdown' WriterOptions
opts (BlockQuote [Block]
blocks) = do
variant <- (WriterEnv -> MarkdownVariant)
-> ReaderT WriterEnv (StateT WriterState m) MarkdownVariant
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> MarkdownVariant
envVariant
let leader
| Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_literate_haskell WriterOptions
opts = String
" > "
| MarkdownVariant
variant MarkdownVariant -> MarkdownVariant -> Bool
forall a. Eq a => a -> a -> Bool
== MarkdownVariant
PlainText = String
" "
| Bool
otherwise = String
"> "
contents <- blockListToMarkdown opts blocks
return $ text leader <> prefixed leader contents <> blankline
blockToMarkdown' WriterOptions
opts t :: Block
t@(Table (Text
ident,[Text]
_,[Target]
_) Caption
blkCapt [ColSpec]
specs TableHead
thead [TableBody]
tbody TableFoot
tfoot) = do
let ([Inline]
caption, [Alignment]
aligns, [Double]
widths, [[Block]]
headers, [[[Block]]]
rows) = Caption
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> ([Inline], [Alignment], [Double], [[Block]], [[[Block]]])
toLegacyTable Caption
blkCapt [ColSpec]
specs TableHead
thead [TableBody]
tbody TableFoot
tfoot
let numcols :: Int
numcols = NonEmpty Int -> Int
forall a. Ord a => NonEmpty a -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Alignment] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Alignment]
aligns Int -> [Int] -> NonEmpty Int
forall a. a -> [a] -> NonEmpty a
:| [Double] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Double]
widths Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:
([[Block]] -> Int) -> [[[Block]]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map [[Block]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([[Block]]
headers[[Block]] -> [[[Block]]] -> [[[Block]]]
forall a. a -> [a] -> [a]
:[[[Block]]]
rows))
caption' <- WriterOptions -> [Inline] -> MD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> MD m (Doc Text)
inlineListToMarkdown WriterOptions
opts [Inline]
caption
let caption'' = if Text -> Bool
T.null Text
ident
then Doc Text
caption'
else Doc Text
caption' Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
<+> WriterOptions -> Attr -> Doc Text
attrsToMarkdown WriterOptions
opts (Text
ident,[],[])
let caption'''
| [Inline] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
caption = Doc Text
forall a. Doc a
blankline
| Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_table_captions WriterOptions
opts
= Doc Text
forall a. Doc a
blankline Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ (Doc Text
": " Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
caption'') Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
forall a. Doc a
blankline
| Bool
otherwise = Doc Text
forall a. Doc a
blankline Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
caption'' Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
forall a. Doc a
blankline
let hasSimpleCells = [[[Block]]] -> Bool
onlySimpleTableCells ([[[Block]]] -> Bool) -> [[[Block]]] -> Bool
forall a b. (a -> b) -> a -> b
$ [[Block]]
headers [[Block]] -> [[[Block]]] -> [[[Block]]]
forall a. a -> [a] -> [a]
: [[[Block]]]
rows
let isSimple = Bool
hasSimpleCells Bool -> Bool -> Bool
&& (Double -> Bool) -> [Double] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
==Double
0) [Double]
widths
let isPlainBlock (Plain [Inline]
_) = Bool
True
isPlainBlock Block
_ = Bool
False
let hasBlocks = Bool -> Bool
not (([[Block]] -> Bool) -> [[[Block]]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (([Block] -> Bool) -> [[Block]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((Block -> Bool) -> [Block] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Block -> Bool
isPlainBlock)) ([[[Block]]] -> Bool) -> [[[Block]]] -> Bool
forall a b. (a -> b) -> a -> b
$ [[Block]]
headers[[Block]] -> [[[Block]]] -> [[[Block]]]
forall a. a -> [a] -> [a]
:[[[Block]]]
rows)
let padRow [Doc a]
r = case Int
numcols Int -> Int -> Int
forall a. Num a => a -> a -> a
- [Doc a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Doc a]
r of
Int
x | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 -> [Doc a]
r [Doc a] -> [Doc a] -> [Doc a]
forall a. [a] -> [a] -> [a]
++ Int -> Doc a -> [Doc a]
forall a. Int -> a -> [a]
replicate Int
x Doc a
forall a. Doc a
empty
| Bool
otherwise -> [Doc a]
r
let aligns' = case Int
numcols Int -> Int -> Int
forall a. Num a => a -> a -> a
- [Alignment] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Alignment]
aligns of
Int
x | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 -> [Alignment]
aligns [Alignment] -> [Alignment] -> [Alignment]
forall a. [a] -> [a] -> [a]
++ Int -> Alignment -> [Alignment]
forall a. Int -> a -> [a]
replicate Int
x Alignment
AlignDefault
| Bool
otherwise -> [Alignment]
aligns
let widths' = case Int
numcols Int -> Int -> Int
forall a. Num a => a -> a -> a
- [Double] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Double]
widths of
Int
x | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 -> [Double]
widths [Double] -> [Double] -> [Double]
forall a. [a] -> [a] -> [a]
++ Int -> Double -> [Double]
forall a. Int -> a -> [a]
replicate Int
x Double
0.0
| Bool
otherwise -> [Double]
widths
case True of
Bool
_ | Bool
isSimple Bool -> Bool -> Bool
&&
Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_simple_tables WriterOptions
opts -> do
rawHeaders <- [Doc Text] -> [Doc Text]
forall {a}. [Doc a] -> [Doc a]
padRow ([Doc Text] -> [Doc Text])
-> ReaderT WriterEnv (StateT WriterState m) [Doc Text]
-> ReaderT WriterEnv (StateT WriterState m) [Doc Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Block] -> MD m (Doc Text))
-> [[Block]] -> ReaderT WriterEnv (StateT WriterState m) [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (WriterOptions -> [Block] -> MD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> MD m (Doc Text)
blockListToMarkdown WriterOptions
opts) [[Block]]
headers
rawRows <- mapM (fmap padRow . mapM (blockListToMarkdown opts))
rows
tbl <- pandocTable opts False (all null headers)
aligns' widths' rawHeaders rawRows
return $ nest 2 (tbl $$ caption''') $$ blankline
| Bool
isSimple Bool -> Bool -> Bool
&&
Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_pipe_tables WriterOptions
opts -> do
rawHeaders <- [Doc Text] -> [Doc Text]
forall {a}. [Doc a] -> [Doc a]
padRow ([Doc Text] -> [Doc Text])
-> ReaderT WriterEnv (StateT WriterState m) [Doc Text]
-> ReaderT WriterEnv (StateT WriterState m) [Doc Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Block] -> MD m (Doc Text))
-> [[Block]] -> ReaderT WriterEnv (StateT WriterState m) [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (WriterOptions -> [Block] -> MD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> MD m (Doc Text)
blockListToMarkdown WriterOptions
opts) [[Block]]
headers
rawRows <- mapM (fmap padRow . mapM (blockListToMarkdown opts))
rows
tbl <- pipeTable opts (all null headers) aligns' widths'
rawHeaders rawRows
return $ (tbl $$ caption''') $$ blankline
| 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
rawHeaders <- [Doc Text] -> [Doc Text]
forall {a}. [Doc a] -> [Doc a]
padRow ([Doc Text] -> [Doc Text])
-> ReaderT WriterEnv (StateT WriterState m) [Doc Text]
-> ReaderT WriterEnv (StateT WriterState m) [Doc Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Block] -> MD m (Doc Text))
-> [[Block]] -> ReaderT WriterEnv (StateT WriterState m) [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (WriterOptions -> [Block] -> MD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> MD m (Doc Text)
blockListToMarkdown WriterOptions
opts) [[Block]]
headers
rawRows <- mapM (fmap padRow . mapM (blockListToMarkdown opts))
rows
tbl <- pandocTable opts True (all null headers)
aligns' widths' rawHeaders rawRows
return $ nest 2 (tbl $$ caption''') $$ blankline
| Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_grid_tables WriterOptions
opts Bool -> Bool -> Bool
&&
WriterOptions -> Int
writerColumns WriterOptions
opts Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
numcols -> do
tbl <- WriterOptions
-> (WriterOptions -> [Block] -> MD m (Doc Text))
-> Bool
-> [Alignment]
-> [Double]
-> [[Block]]
-> [[[Block]]]
-> MD m (Doc Text)
forall (m :: * -> *) a.
(Monad m, HasChars a) =>
WriterOptions
-> (WriterOptions -> [Block] -> m (Doc a))
-> Bool
-> [Alignment]
-> [Double]
-> [[Block]]
-> [[[Block]]]
-> m (Doc a)
gridTable WriterOptions
opts WriterOptions -> [Block] -> MD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> MD m (Doc Text)
blockListToMarkdown
(([Block] -> Bool) -> [[Block]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all [Block] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Block]]
headers) [Alignment]
aligns' [Double]
widths' [[Block]]
headers [[[Block]]]
rows
return $ (tbl $$ caption''') $$ blankline
| Bool
hasSimpleCells Bool -> Bool -> Bool
&&
Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_pipe_tables WriterOptions
opts -> do
rawHeaders <- [Doc Text] -> [Doc Text]
forall {a}. [Doc a] -> [Doc a]
padRow ([Doc Text] -> [Doc Text])
-> ReaderT WriterEnv (StateT WriterState m) [Doc Text]
-> ReaderT WriterEnv (StateT WriterState m) [Doc Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Block] -> MD m (Doc Text))
-> [[Block]] -> ReaderT WriterEnv (StateT WriterState m) [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (WriterOptions -> [Block] -> MD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> MD m (Doc Text)
blockListToMarkdown WriterOptions
opts) [[Block]]
headers
rawRows <- mapM (fmap padRow . mapM (blockListToMarkdown opts))
rows
tbl <- pipeTable opts (all null headers) aligns' widths'
rawHeaders rawRows
return $ (tbl $$ caption''') $$ blankline
| Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_raw_html WriterOptions
opts -> do
tbl <- 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
removeBlankLinesInHTML (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 = Nothing }
(Meta -> [Block] -> Pandoc
Pandoc Meta
nullMeta [Block
t])
return $ tbl $$ blankline
| Bool
otherwise
-> do
LogMessage -> ReaderT WriterEnv (StateT WriterState m) ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (Block -> LogMessage
BlockNotRendered Block
t)
Doc Text -> MD m (Doc Text)
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
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
"[TABLE]" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
caption''') Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
forall a. Doc a
blankline
blockToMarkdown' WriterOptions
opts (BulletList [[Block]]
items) = do
contents <- ReaderT WriterEnv (StateT WriterState m) [Doc Text]
-> ReaderT WriterEnv (StateT WriterState m) [Doc Text]
forall (m :: * -> *) a. Monad m => MD m a -> MD m a
inList (ReaderT WriterEnv (StateT WriterState m) [Doc Text]
-> ReaderT WriterEnv (StateT WriterState m) [Doc Text])
-> ReaderT WriterEnv (StateT WriterState m) [Doc Text]
-> ReaderT WriterEnv (StateT WriterState m) [Doc Text]
forall a b. (a -> b) -> a -> b
$ ([Block] -> MD m (Doc Text))
-> [[Block]] -> ReaderT WriterEnv (StateT WriterState m) [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (WriterOptions -> [Block] -> MD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> MD m (Doc Text)
bulletListItemToMarkdown WriterOptions
opts) [[Block]]
items
return $ (if isTightList items then vcat else vsep)
contents <> blankline
blockToMarkdown' WriterOptions
opts (OrderedList (Int
start,ListNumberStyle
sty,ListNumberDelim
delim) [[Block]]
items) = do
variant <- (WriterEnv -> MarkdownVariant)
-> ReaderT WriterEnv (StateT WriterState m) MarkdownVariant
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> MarkdownVariant
envVariant
let start' = if MarkdownVariant
variant MarkdownVariant -> MarkdownVariant -> Bool
forall a. Eq a => a -> a -> Bool
== MarkdownVariant
Commonmark Bool -> Bool -> Bool
|| Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_startnum WriterOptions
opts
then Int
start
else Int
1
let sty' = 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' | Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_fancy_lists WriterOptions
opts =
case MarkdownVariant
variant of
MarkdownVariant
Markua -> if ListNumberDelim
delim ListNumberDelim -> ListNumberDelim -> Bool
forall a. Eq a => a -> a -> Bool
== ListNumberDelim
TwoParens then ListNumberDelim
OneParen else ListNumberDelim
delim
MarkdownVariant
_ -> ListNumberDelim
delim
| MarkdownVariant
variant MarkdownVariant -> MarkdownVariant -> Bool
forall a. Eq a => a -> a -> Bool
== MarkdownVariant
Commonmark Bool -> Bool -> Bool
&&
(ListNumberDelim
delim ListNumberDelim -> ListNumberDelim -> Bool
forall a. Eq a => a -> a -> Bool
== ListNumberDelim
OneParen Bool -> Bool -> Bool
|| ListNumberDelim
delim ListNumberDelim -> ListNumberDelim -> Bool
forall a. Eq a => a -> a -> Bool
== ListNumberDelim
TwoParens) = ListNumberDelim
OneParen
| Bool
otherwise = ListNumberDelim
DefaultDelim
let attribs = (Int
start', ListNumberStyle
sty', ListNumberDelim
delim')
let markers = (Int, ListNumberStyle, ListNumberDelim) -> [Text]
orderedListMarkers (Int, ListNumberStyle, ListNumberDelim)
attribs
let markers' = case MarkdownVariant
variant of
MarkdownVariant
Markua -> [Text]
markers
MarkdownVariant
_ -> (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (\Text
m -> if Text -> Int
T.length Text
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
3
then Text
m Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.replicate (Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Text -> Int
T.length Text
m) Text
" "
else Text
m) [Text]
markers
contents <- inList $
zipWithM (orderedListItemToMarkdown opts) markers' items
return $ (if isTightList items then vcat else vsep) contents <> blankline
blockToMarkdown' WriterOptions
opts (DefinitionList [([Inline], [[Block]])]
items) = do
contents <- ReaderT WriterEnv (StateT WriterState m) [Doc Text]
-> ReaderT WriterEnv (StateT WriterState m) [Doc Text]
forall (m :: * -> *) a. Monad m => MD m a -> MD m a
inList (ReaderT WriterEnv (StateT WriterState m) [Doc Text]
-> ReaderT WriterEnv (StateT WriterState m) [Doc Text])
-> ReaderT WriterEnv (StateT WriterState m) [Doc Text]
-> ReaderT WriterEnv (StateT WriterState m) [Doc Text]
forall a b. (a -> b) -> a -> b
$ (([Inline], [[Block]]) -> MD m (Doc Text))
-> [([Inline], [[Block]])]
-> ReaderT WriterEnv (StateT WriterState m) [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (WriterOptions -> ([Inline], [[Block]]) -> MD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> ([Inline], [[Block]]) -> MD m (Doc Text)
definitionListItemToMarkdown WriterOptions
opts) [([Inline], [[Block]])]
items
return $ mconcat contents <> blankline
blockToMarkdown' WriterOptions
opts (Figure Attr
figattr Caption
capt [Block]
body) = do
let combinedAttr :: (a, b, c) -> Maybe (Text, b, c)
combinedAttr (a, b, c)
imgattr = case (a, b, c)
imgattr of
(a
"", b
cls, c
kv) | (Text
figid, [], []) <- Attr
figattr -> (Text, b, c) -> Maybe (Text, b, c)
forall a. a -> Maybe a
Just (Text
figid, b
cls, c
kv)
(a, b, c)
_ -> Maybe (Text, b, c)
forall a. Maybe a
Nothing
let combinedAlt :: [Inline] -> Maybe [Inline]
combinedAlt [Inline]
alt = case Caption
capt of
Caption Maybe [Inline]
Nothing [] -> if [Inline] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
alt
then [Inline] -> Maybe [Inline]
forall a. a -> Maybe a
Just [Text -> Inline
Str Text
"image"]
else [Inline] -> Maybe [Inline]
forall a. a -> Maybe a
Just [Inline]
alt
Caption Maybe [Inline]
Nothing [Plain [Inline]
captInlines]
| [Inline]
captInlines [Inline] -> [Inline] -> Bool
forall a. Eq a => a -> a -> Bool
== [Inline]
alt Bool -> Bool -> Bool
|| [Inline] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
alt -> [Inline] -> Maybe [Inline]
forall a. a -> Maybe a
Just [Inline]
captInlines
Caption
_ -> Maybe [Inline]
forall a. Maybe a
Nothing
case [Block]
body of
[Plain [Image Attr
imgAttr [Inline]
alt (Text
src, Text
ttl)]]
| Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_implicit_figures WriterOptions
opts
, Just [Inline]
descr <- [Inline] -> Maybe [Inline]
combinedAlt [Inline]
alt
, Just Attr
imgAttr' <- Attr -> Maybe Attr
forall {a} {b} {c}.
(Eq a, IsString a) =>
(a, b, c) -> Maybe (Text, b, c)
combinedAttr Attr
imgAttr
, Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_link_attributes WriterOptions
opts Bool -> Bool -> Bool
|| Attr
imgAttr' Attr -> Attr -> Bool
forall a. Eq a => a -> a -> Bool
== Attr
nullAttr
-> do
let tgt' :: Target
tgt' = (Text
src, Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
ttl (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Maybe Text
T.stripPrefix Text
"fig:" Text
ttl)
contents <- WriterOptions -> [Inline] -> MD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> MD m (Doc Text)
inlineListToMarkdown WriterOptions
opts [Attr -> [Inline] -> Target -> Inline
Image Attr
imgAttr' [Inline]
descr Target
tgt']
return $ contents <> blankline
[Block]
_ ->
if Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_raw_html WriterOptions
opts
then WriterOptions -> Attr -> Caption -> [Block] -> MD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Attr -> Caption -> [Block] -> MD m (Doc Text)
figureToMarkdown WriterOptions
opts Attr
figattr Caption
capt [Block]
body
else if (Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_fenced_divs WriterOptions
opts Bool -> Bool -> Bool
|| Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_native_divs WriterOptions
opts) Bool -> Bool -> Bool
||
Bool -> Bool
not (Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_implicit_figures WriterOptions
opts)
then 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
$ Attr -> Caption -> [Block] -> Block
figureDiv Attr
figattr Caption
capt [Block]
body
else WriterOptions -> [Block] -> MD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> MD m (Doc Text)
blockListToMarkdown WriterOptions
opts [Block]
body
inList :: Monad m => MD m a -> MD m a
inList :: forall (m :: * -> *) a. Monad m => MD m a -> MD m a
inList MD m a
p = (WriterEnv -> WriterEnv) -> MD m a -> MD m a
forall a.
(WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (StateT WriterState m) a
-> ReaderT WriterEnv (StateT WriterState m) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
env -> WriterEnv
env {envInList = True}) MD m a
p
addMarkdownAttribute :: Text -> Text
addMarkdownAttribute :: Text -> Text
addMarkdownAttribute Text
s =
case (Tag Text -> Bool) -> [Tag Text] -> ([Tag Text], [Tag Text])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Tag Text -> Bool
forall str. Tag str -> Bool
isTagText ([Tag Text] -> ([Tag Text], [Tag Text]))
-> [Tag Text] -> ([Tag Text], [Tag Text])
forall a b. (a -> b) -> a -> b
$ [Tag Text] -> [Tag Text]
forall a. [a] -> [a]
reverse ([Tag Text] -> [Tag Text]) -> [Tag Text] -> [Tag Text]
forall a b. (a -> b) -> a -> b
$ Text -> [Tag Text]
forall str. StringLike str => str -> [Tag str]
parseTags Text
s of
([Tag Text]
xs, TagOpen Text
t [Target]
attrs:[Tag Text]
rest) ->
[Tag Text] -> Text
renderTags' ([Tag Text] -> Text) -> [Tag Text] -> Text
forall a b. (a -> b) -> a -> b
$ [Tag Text] -> [Tag Text]
forall a. [a] -> [a]
reverse [Tag Text]
rest [Tag Text] -> [Tag Text] -> [Tag Text]
forall a. [a] -> [a] -> [a]
++ (Text -> [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' = (Text
"markdown",Text
"1")Target -> [Target] -> [Target]
forall a. a -> [a] -> [a]
:[(Text
x,Text
y) | (Text
x,Text
y) <- [Target]
attrs,
Text
x Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"markdown"]
([Tag Text], [Tag Text])
_ -> Text
s
figureToMarkdown :: PandocMonad m
=> WriterOptions
-> Attr
-> Caption
-> [Block]
-> MD m (Doc Text)
figureToMarkdown :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Attr -> Caption -> [Block] -> MD m (Doc Text)
figureToMarkdown WriterOptions
opts attr :: Attr
attr@(Text
ident, [Text]
classes, [Target]
kvs) Caption
capt [Block]
body
| Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_raw_html WriterOptions
opts =
(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
-> ReaderT WriterEnv (StateT WriterState 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 = Nothing }
(Meta -> [Block] -> Pandoc
Pandoc Meta
nullMeta [Attr -> Caption -> [Block] -> Block
Figure Attr
attr Caption
capt [Block]
body])
| Bool
otherwise = let attr' :: Attr
attr' = (Text
ident, [Text
"figure"] [Text] -> [Text] -> [Text]
forall a. Eq a => [a] -> [a] -> [a]
`union` [Text]
classes, [Target]
kvs)
in WriterOptions
-> Block -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> MD m (Doc Text)
blockToMarkdown' WriterOptions
opts (Attr -> [Block] -> Block
Div Attr
attr' [Block]
body)
itemEndsWithTightList :: [Block] -> Bool
itemEndsWithTightList :: [Block] -> Bool
itemEndsWithTightList [Block]
bs =
case [Block]
bs of
[Plain [Inline]
_, BulletList [[Block]]
xs] -> [[Block]] -> Bool
isTightList [[Block]]
xs
[Plain [Inline]
_, OrderedList (Int, ListNumberStyle, ListNumberDelim)
_ [[Block]]
xs] -> [[Block]] -> Bool
isTightList [[Block]]
xs
[Block]
_ -> Bool
False
bulletListItemToMarkdown :: PandocMonad m => WriterOptions -> [Block] -> MD m (Doc Text)
bulletListItemToMarkdown :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> MD m (Doc Text)
bulletListItemToMarkdown WriterOptions
opts [Block]
bs = do
variant <- (WriterEnv -> MarkdownVariant)
-> ReaderT WriterEnv (StateT WriterState m) MarkdownVariant
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> MarkdownVariant
envVariant
let exts = WriterOptions -> Extensions
writerExtensions WriterOptions
opts
contents <- blockListToMarkdown opts $ taskListItemToAscii exts bs
let start = case MarkdownVariant
variant of
MarkdownVariant
Markua -> Text
"* "
MarkdownVariant
Commonmark -> Text
"- "
MarkdownVariant
_ -> Text
"- " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.replicate (WriterOptions -> Int
writerTabStop WriterOptions
opts Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2) Text
" "
let 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
return $ hang (T.length start) (literal start) contents'
orderedListItemToMarkdown :: PandocMonad m
=> WriterOptions
-> Text
-> [Block]
-> MD m (Doc Text)
orderedListItemToMarkdown :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Text -> [Block] -> MD m (Doc Text)
orderedListItemToMarkdown WriterOptions
opts Text
marker [Block]
bs = do
let exts :: Extensions
exts = WriterOptions -> Extensions
writerExtensions WriterOptions
opts
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
variant <- asks envVariant
let sps = case WriterOptions -> Int
writerTabStop WriterOptions
opts Int -> Int -> Int
forall a. Num a => a -> a -> a
- Text -> Int
T.length Text
marker of
Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 -> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.replicate Int
n Text
" "
Int
_ -> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
" "
let ind = if Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_four_space_rule WriterOptions
opts
then WriterOptions -> Int
writerTabStop WriterOptions
opts
else Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (WriterOptions -> Int
writerTabStop WriterOptions
opts) (Text -> Int
T.length Text
marker Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
let start = case MarkdownVariant
variant of
MarkdownVariant
Markua -> 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
" "
MarkdownVariant
_ -> 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
let 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
return $ hang ind start contents'
definitionListItemToMarkdown :: PandocMonad m
=> WriterOptions
-> ([Inline],[[Block]])
-> MD m (Doc Text)
definitionListItemToMarkdown :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> ([Inline], [[Block]]) -> MD m (Doc Text)
definitionListItemToMarkdown WriterOptions
opts ([Inline]
label, [[Block]]
defs) = do
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)
defs' <- mapM (mapM (blockToMarkdown opts)) defs
if isEnabled Ext_definition_lists opts
then do
let tabStop = WriterOptions -> Int
writerTabStop WriterOptions
opts
variant <- asks envVariant
let leader = case MarkdownVariant
variant of
MarkdownVariant
PlainText -> Doc Text
" "
MarkdownVariant
Markua -> Doc Text
":"
MarkdownVariant
_ -> Doc Text
": "
let sps = case WriterOptions -> Int
writerTabStop WriterOptions
opts Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
3 of
Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 -> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.replicate Int
n Text
" "
Int
_ -> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
" "
let isTight = case [[Block]]
defs of
((Plain [Inline]
_ : [Block]
_): [[Block]]
_) -> Bool
True
[[Block]]
_ -> Bool
False
if isEnabled Ext_compact_definition_lists opts
then do
let contents = [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat ([Doc Text] -> Doc Text) -> [Doc Text] -> Doc Text
forall a b. (a -> b) -> a -> b
$ ([Doc Text] -> Doc Text) -> [[Doc Text]] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map (\[Doc Text]
d -> Int -> Doc Text -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a -> Doc a
hang Int
tabStop (Doc Text
leader Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
sps)
(Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat [Doc Text]
d Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
cr) [[Doc Text]]
defs'
return $ nowrap labelText <> cr <> contents <> cr
else do
let contents = (if Bool
isTight then [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat else [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vsep) ([Doc Text] -> Doc Text) -> [Doc Text] -> Doc Text
forall a b. (a -> b) -> a -> b
$ ([Doc Text] -> Doc Text) -> [[Doc Text]] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map
(\[Doc Text]
d -> Int -> Doc Text -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a -> Doc a
hang Int
tabStop (Doc Text
leader Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
sps) (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat [Doc Text]
d)
[[Doc Text]]
defs'
return $ blankline <> nowrap labelText $$
(if isTight then empty else blankline) <> contents <> blankline
else
return $ nowrap (chomp labelText <> literal " " <> cr) <>
vsep (map vsep defs') <> blankline
blockListToMarkdown :: PandocMonad m
=> WriterOptions
-> [Block]
-> MD m (Doc Text)
blockListToMarkdown :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> MD m (Doc Text)
blockListToMarkdown WriterOptions
opts [Block]
blocks = do
inlist <- (WriterEnv -> Bool)
-> ReaderT WriterEnv (StateT WriterState m) Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Bool
envInList
variant <- asks envVariant
let fixBlocks (Block
b : CodeBlock Attr
attr Text
x : [Block]
rest)
| (Bool -> Bool
not (MarkdownVariant
variant MarkdownVariant -> MarkdownVariant -> Bool
forall a. Eq a => a -> a -> Bool
== MarkdownVariant
Commonmark Bool -> Bool -> Bool
||
Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_backtick_code_blocks WriterOptions
opts Bool -> Bool -> Bool
||
Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_fenced_code_blocks WriterOptions
opts) Bool -> Bool -> Bool
||
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 [[Block]]
_) : b2 :: Block
b2@(BulletList [[Block]]
_) : [Block]
bs) =
Block
b1 Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: Block
commentSep Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block] -> [Block]
fixBlocks (Block
b2Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
:[Block]
bs)
fixBlocks (b1 :: Block
b1@(OrderedList (Int, ListNumberStyle, ListNumberDelim)
_ [[Block]]
_) : b2 :: Block
b2@(OrderedList (Int, ListNumberStyle, ListNumberDelim)
_ [[Block]]
_) : [Block]
bs) =
Block
b1 Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: Block
commentSep Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block] -> [Block]
fixBlocks (Block
b2Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
:[Block]
bs)
fixBlocks (b1 :: Block
b1@(DefinitionList [([Inline], [[Block]])]
_) : b2 :: Block
b2@(DefinitionList [([Inline], [[Block]])]
_) : [Block]
bs) =
Block
b1 Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: Block
commentSep Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block] -> [Block]
fixBlocks (Block
b2Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
:[Block]
bs)
fixBlocks (Plain [Inline]
ils : bs :: [Block]
bs@(RawBlock{}:[Block]
_)) =
[Inline] -> Block
Plain [Inline]
ils Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block] -> [Block]
fixBlocks [Block]
bs
fixBlocks (Plain [Inline]
ils : bs :: [Block]
bs@(Div{}:[Block]
_))
| Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_fenced_divs WriterOptions
opts =
[Inline] -> Block
Para [Inline]
ils Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block] -> [Block]
fixBlocks [Block]
bs
fixBlocks (Plain [Inline]
ils : [Block]
bs) | Bool
inlist =
[Inline] -> Block
Plain [Inline]
ils Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block] -> [Block]
fixBlocks [Block]
bs
fixBlocks (Plain [Inline]
ils : [Block]
bs) =
[Inline] -> Block
Para [Inline]
ils Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block] -> [Block]
fixBlocks [Block]
bs
fixBlocks (r :: Block
r@(RawBlock Format
f Text
raw) : Block
b : [Block]
bs)
| Bool -> Bool
not (Text -> Bool
T.null Text
raw)
, HasCallStack => Text -> Char
Text -> Char
T.last Text
raw Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n' =
case Block
b of
Plain{} -> Block
r Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block] -> [Block]
fixBlocks (Block
bBlock -> [Block] -> [Block]
forall a. a -> [a] -> [a]
:[Block]
bs)
RawBlock{} -> Block
r Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block] -> [Block]
fixBlocks (Block
bBlock -> [Block] -> [Block]
forall a. a -> [a] -> [a]
:[Block]
bs)
Block
_ -> Format -> Text -> Block
RawBlock Format
f (Text
raw Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n") Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block] -> [Block]
fixBlocks (Block
bBlock -> [Block] -> [Block]
forall a. a -> [a] -> [a]
:[Block]
bs)
fixBlocks (Block
x : [Block]
xs) = Block
x Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block] -> [Block]
fixBlocks [Block]
xs
fixBlocks [] = []
isListBlock (BulletList [[Block]]
_) = Bool
True
isListBlock (OrderedList (Int, ListNumberStyle, ListNumberDelim)
_ [[Block]]
_) = Bool
True
isListBlock (DefinitionList [([Inline], [[Block]])]
_) = Bool
True
isListBlock Block
_ = Bool
False
commentSep
| MarkdownVariant
variant MarkdownVariant -> MarkdownVariant -> Bool
forall a. Eq a => a -> a -> Bool
== MarkdownVariant
PlainText = [Inline] -> Block
Plain []
| MarkdownVariant
variant MarkdownVariant -> MarkdownVariant -> Bool
forall a. Eq a => a -> a -> Bool
== MarkdownVariant
Markua = [Inline] -> Block
Plain []
| Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_raw_html WriterOptions
opts = Format -> Text -> Block
RawBlock Format
"html" Text
"<!-- -->\n"
| Bool
otherwise = Format -> Text -> Block
RawBlock Format
"markdown" Text
" \n"
mconcat <$> mapM (blockToMarkdown opts) (fixBlocks blocks)
lineBreakToSpace :: Inline -> Inline
lineBreakToSpace :: Inline -> Inline
lineBreakToSpace Inline
LineBreak = Inline
Space
lineBreakToSpace Inline
SoftBreak = Inline
Space
lineBreakToSpace Inline
x = Inline
x
removeBlankLinesInHTML :: Text -> Text
removeBlankLinesInHTML :: Text -> Text
removeBlankLinesInHTML = String -> Text
T.pack (String -> Text) -> (Text -> String) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> String -> String
go Bool
False (String -> String) -> (Text -> String) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack
where go :: Bool -> String -> String
go Bool
_ [] = []
go Bool
True (Char
'\n':String
cs) = String
" " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Bool -> String -> String
go Bool
False String
cs
go Bool
False (Char
'\n':String
cs) = Char
'\n' Char -> String -> String
forall a. a -> [a] -> [a]
: Bool -> String -> String
go Bool
True String
cs
go !Bool
afternewline (!Char
c:String
cs)
| Char -> Bool
isSpace Char
c = Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: Bool -> String -> String
go Bool
afternewline String
cs
| Bool
otherwise = Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: Bool -> String -> String
go Bool
False String
cs
computeDivNestingLevel :: [Block] -> Int
computeDivNestingLevel :: [Block] -> Int
computeDivNestingLevel = (Block -> Int -> Int) -> Int -> [Block] -> Int
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Block -> Int -> Int
forall {t}. (Ord t, Num t) => Block -> t -> t
go Int
0
where
go :: Block -> t -> t
go (Div Attr
_ [Block]
bls') t
n = t -> t -> t
forall a. Ord a => a -> a -> a
max (t
n t -> t -> t
forall a. Num a => a -> a -> a
+ t
1) ((Block -> t -> t) -> t -> [Block] -> t
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Block -> t -> t
go (t
n t -> t -> t
forall a. Num a => a -> a -> a
+ t
1) [Block]
bls')
go Block
_ t
n = t
n