{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ViewPatterns #-}
module Text.Pandoc.Writers.Markdown.Inline (
inlineListToMarkdown,
linkAttributes,
attrsToMarkdown,
attrsToMarkua
) where
import Control.Monad (when, liftM2)
import Control.Monad.Reader
( asks, MonadReader(local) )
import Control.Monad.State.Strict
( MonadState(get), gets, modify )
import Data.Char (isAlphaNum, isDigit)
import Data.List (find, intersperse)
import Data.List.NonEmpty (nonEmpty)
import qualified Data.Map as M
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import qualified Data.Text as T
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.URI (urlEncode, escapeURI, isURI)
import Text.Pandoc.Writers.Shared
import Text.Pandoc.Walk
import Text.Pandoc.Writers.HTML (writeHtml5String)
import Text.Pandoc.Writers.Math (texMathToInlines)
import Text.Pandoc.XML (toHtml5Entities)
import Data.Coerce (coerce)
import Text.Pandoc.Writers.Markdown.Types (MarkdownVariant(..),
WriterState(..),
WriterEnv(..), MD)
escapeText :: WriterOptions -> Text -> Text
escapeText :: WriterOptions -> Text -> Text
escapeText WriterOptions
opts = String -> Text
T.pack (String -> Text) -> (Text -> String) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
go' (String -> String) -> (Text -> String) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack
where
startsWithSpace :: String -> Bool
startsWithSpace (Char
' ':String
_) = Bool
True
startsWithSpace (Char
'\t':String
_) = Bool
True
startsWithSpace [] = Bool
True
startsWithSpace String
_ = Bool
False
go' :: String -> String
go' (Char
'#':String
cs)
| Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_space_in_atx_header WriterOptions
opts
= if String -> Bool
startsWithSpace ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'#') String
cs)
then Char
'\\'Char -> String -> String
forall a. a -> [a] -> [a]
:Char
'#'Char -> String -> String
forall a. a -> [a] -> [a]
:String -> String
go String
cs
else Char
'#'Char -> String -> String
forall a. a -> [a] -> [a]
:String -> String
go String
cs
| Bool
otherwise = Char
'\\'Char -> String -> String
forall a. a -> [a] -> [a]
:Char
'#'Char -> String -> String
forall a. a -> [a] -> [a]
:String -> String
go String
cs
go' (Char
'@':String
cs)
| Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_citations WriterOptions
opts =
case String
cs of
(Char
d:String
_)
| Char -> Bool
isAlphaNum Char
d Bool -> Bool -> Bool
|| Char
d Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_' Bool -> Bool -> Bool
|| Char
d Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'{'
-> Char
'\\'Char -> String -> String
forall a. a -> [a] -> [a]
:Char
'@'Char -> String -> String
forall a. a -> [a] -> [a]
:String -> String
go String
cs
String
_ -> Char
'@'Char -> String -> String
forall a. a -> [a] -> [a]
:String -> String
go String
cs
go' String
cs = String -> String
go String
cs
go :: String -> String
go [] = []
go [Char
'\\'] = [Char
'\\',Char
'\\']
go (Char
'-':Char
'-':String
cs)
| Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_smart WriterOptions
opts = Char
'\\'Char -> String -> String
forall a. a -> [a] -> [a]
:Char
'-'Char -> String -> String
forall a. a -> [a] -> [a]
:String -> String
go(Char
'-'Char -> String -> String
forall a. a -> [a] -> [a]
:String
cs)
go (Char
'.':Char
'.':Char
'.':String
cs)
| Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_smart WriterOptions
opts = Char
'\\'Char -> String -> String
forall a. a -> [a] -> [a]
:Char
'.'Char -> String -> String
forall a. a -> [a] -> [a]
:Char
'.'Char -> String -> String
forall a. a -> [a] -> [a]
:Char
'.'Char -> String -> String
forall a. a -> [a] -> [a]
:String -> String
go String
cs
go (Char
c:Char
'_':Char
d:String
cs)
| Char -> Bool
isAlphaNum Char
c
, Char -> Bool
isAlphaNum Char
d =
if Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_intraword_underscores WriterOptions
opts
then Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:Char
'_'Char -> String -> String
forall a. a -> [a] -> [a]
:String -> String
go (Char
dChar -> String -> String
forall a. a -> [a] -> [a]
:String
cs)
else Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:Char
'\\'Char -> String -> String
forall a. a -> [a] -> [a]
:Char
'_'Char -> String -> String
forall a. a -> [a] -> [a]
:String -> String
go (Char
dChar -> String -> String
forall a. a -> [a] -> [a]
:String
cs)
go (Char
'\\':Char
c:String
cs)
| Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_raw_tex WriterOptions
opts = Char
'\\'Char -> String -> String
forall a. a -> [a] -> [a]
:Char
'\\'Char -> String -> String
forall a. a -> [a] -> [a]
:String -> String
go (Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:String
cs)
| Char -> Bool
isAlphaNum Char
c = Char
'\\' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
go (Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:String
cs)
| Bool
otherwise = Char
'\\'Char -> String -> String
forall a. a -> [a] -> [a]
:Char
'\\'Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
go String
cs
go (Char
'!':Char
'[':String
cs) = Char
'\\'Char -> String -> String
forall a. a -> [a] -> [a]
:Char
'!'Char -> String -> String
forall a. a -> [a] -> [a]
:Char
'['Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
go String
cs
go (Char
'=':Char
'=':String
cs)
| Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_mark WriterOptions
opts = Char
'\\'Char -> String -> String
forall a. a -> [a] -> [a]
:Char
'='Char -> String -> String
forall a. a -> [a] -> [a]
:String -> String
go (Char
'='Char -> String -> String
forall a. a -> [a] -> [a]
:String
cs)
go (Char
'~':Char
'~':String
cs)
| Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_strikeout WriterOptions
opts = Char
'\\'Char -> String -> String
forall a. a -> [a] -> [a]
:Char
'~'Char -> String -> String
forall a. a -> [a] -> [a]
:String -> String
go (Char
'~'Char -> String -> String
forall a. a -> [a] -> [a]
:String
cs)
go (Char
c:String
cs) =
case Char
c of
Char
'[' -> Char
'\\'Char -> String -> String
forall a. a -> [a] -> [a]
:Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:String -> String
go String
cs
Char
']' -> Char
'\\'Char -> String -> String
forall a. a -> [a] -> [a]
:Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:String -> String
go String
cs
Char
'`' -> Char
'\\'Char -> String -> String
forall a. a -> [a] -> [a]
:Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:String -> String
go String
cs
Char
'*' -> Char
'\\'Char -> String -> String
forall a. a -> [a] -> [a]
:Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:String -> String
go String
cs
Char
'_' -> Char
'\\'Char -> String -> String
forall a. a -> [a] -> [a]
:Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:String -> String
go String
cs
Char
'>' | Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_all_symbols_escapable WriterOptions
opts -> Char
'\\'Char -> String -> String
forall a. a -> [a] -> [a]
:Char
'>'Char -> String -> String
forall a. a -> [a] -> [a]
:String -> String
go String
cs
| Bool
otherwise -> String
">" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
go String
cs
Char
'<' | Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_all_symbols_escapable WriterOptions
opts -> Char
'\\'Char -> String -> String
forall a. a -> [a] -> [a]
:Char
'<'Char -> String -> String
forall a. a -> [a] -> [a]
:String -> String
go String
cs
| Bool
otherwise -> String
"<" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
go String
cs
Char
'|' | Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_pipe_tables WriterOptions
opts -> Char
'\\'Char -> String -> String
forall a. a -> [a] -> [a]
:Char
'|'Char -> String -> String
forall a. a -> [a] -> [a]
:String -> String
go String
cs
Char
'^' | Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_superscript WriterOptions
opts -> Char
'\\'Char -> String -> String
forall a. a -> [a] -> [a]
:Char
'^'Char -> String -> String
forall a. a -> [a] -> [a]
:String -> String
go String
cs
Char
'~' | Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_subscript WriterOptions
opts -> Char
'\\'Char -> String -> String
forall a. a -> [a] -> [a]
:Char
'~'Char -> String -> String
forall a. a -> [a] -> [a]
:String -> String
go String
cs
Char
'$' | Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_tex_math_dollars WriterOptions
opts -> Char
'\\'Char -> String -> String
forall a. a -> [a] -> [a]
:Char
'$'Char -> String -> String
forall a. a -> [a] -> [a]
:String -> String
go String
cs
Char
'\'' | Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_smart WriterOptions
opts -> Char
'\\'Char -> String -> String
forall a. a -> [a] -> [a]
:Char
'\''Char -> String -> String
forall a. a -> [a] -> [a]
:String -> String
go String
cs
Char
'"' | Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_smart WriterOptions
opts -> Char
'\\'Char -> String -> String
forall a. a -> [a] -> [a]
:Char
'"'Char -> String -> String
forall a. a -> [a] -> [a]
:String -> String
go String
cs
Char
_ -> Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
go String
cs
escapeMarkuaString :: Text -> Text
escapeMarkuaString :: Text -> Text
escapeMarkuaString Text
s = ((Text, Text) -> Text -> Text) -> Text -> [(Text, Text)] -> Text
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((Text -> Text -> Text -> Text) -> (Text, Text) -> Text -> Text
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace) Text
s [(Text
"--",Text
"~-~-"),
(Text
"**",Text
"~*~*"),(Text
"//",Text
"~/~/"),(Text
"^^",Text
"~^~^"),(Text
",,",Text
"~,~,")]
attrsToMarkdown :: WriterOptions -> Attr -> Doc Text
attrsToMarkdown :: WriterOptions -> Attr -> Doc Text
attrsToMarkdown WriterOptions
opts Attr
attribs = Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
braces (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
hsep [Doc Text
attribId, Doc Text
attribClasses, Doc Text
attribKeys]
where attribId :: Doc Text
attribId = case Attr
attribs of
(Text
"",[Text]
_,[(Text, Text)]
_) -> Doc Text
forall a. Doc a
empty
(Text
i,[Text]
_,[(Text, Text)]
_) -> Doc Text
"#" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
escAttr (WriterOptions -> Text
writerIdentifierPrefix WriterOptions
opts Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
i)
attribClasses :: Doc Text
attribClasses = case Attr
attribs of
(Text
_,[],[(Text, Text)]
_) -> Doc Text
forall a. Doc a
empty
(Text
_,[Text]
cs,[(Text, Text)]
_) -> [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
hsep ([Doc Text] -> Doc Text) -> [Doc Text] -> Doc Text
forall a b. (a -> b) -> a -> b
$
(Text -> Doc Text) -> [Text] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Doc Text
escAttr (Text -> Doc Text) -> (Text -> Text) -> Text -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"."Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>)) ([Text] -> [Doc Text]) -> [Text] -> [Doc Text]
forall a b. (a -> b) -> a -> b
$
(Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
T.null) [Text]
cs
attribKeys :: Doc Text
attribKeys = case Attr
attribs of
(Text
_,[Text]
_,[]) -> Doc Text
forall a. Doc a
empty
(Text
_,[Text]
_,[(Text, Text)]
ks) -> [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
hsep ([Doc Text] -> Doc Text) -> [Doc Text] -> Doc Text
forall a b. (a -> b) -> a -> b
$
((Text, Text) -> Doc Text) -> [(Text, Text)] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map (\(Text
k,Text
v) -> Text -> Doc Text
escAttr Text
k
Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"=\"" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>
Text -> Doc Text
escAttr Text
v Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"\"") [(Text, Text)]
ks
escAttr :: Text -> Doc Text
escAttr = [Doc Text] -> Doc Text
forall a. Monoid a => [a] -> a
mconcat ([Doc Text] -> Doc Text)
-> (Text -> [Doc Text]) -> Text -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Doc Text) -> String -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Doc Text
escAttrChar (String -> [Doc Text]) -> (Text -> String) -> Text -> [Doc Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack
escAttrChar :: Char -> Doc Text
escAttrChar Char
'"' = Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
"\\\""
escAttrChar Char
'\\' = Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
"\\\\"
escAttrChar Char
c = Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Char -> Text
T.singleton Char
c
attrsToMarkua:: WriterOptions -> Attr -> Doc Text
attrsToMarkua :: WriterOptions -> Attr -> Doc Text
attrsToMarkua WriterOptions
opts Attr
attributes
| [Doc Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Doc Text]
list = Doc Text
forall a. Doc a
empty
| Bool
otherwise = Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
braces (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ [Doc Text] -> Doc Text
intercalateDocText [Doc Text]
list
where attrId :: [Doc Text]
attrId = case Attr
attributes of
(Text
"",[Text]
_,[(Text, Text)]
_) -> []
(Text
i,[Text]
_,[(Text, Text)]
_) -> [Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Text
"id: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> WriterOptions -> Text
writerIdentifierPrefix WriterOptions
opts Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
i]
attrClasses :: [Doc Text]
attrClasses = case Attr
attributes of
(Text
_,[],[(Text, Text)]
_) -> []
(Text
_,[Text]
classes,[(Text, Text)]
_) -> (Text -> Doc Text) -> [Text] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Doc Text
escAttr (Text -> Doc Text) -> (Text -> Text) -> Text -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"class: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>))
[Text]
classes
attrKeyValues :: [Doc Text]
attrKeyValues = case Attr
attributes of
(Text
_,[Text]
_,[]) -> []
(Text
_,[Text]
_,[(Text, Text)]
keyvalues) -> ((Text, Text) -> Doc Text) -> [(Text, Text)] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map ((\(Text
k,Text
v) -> Text -> Doc Text
escAttr Text
k
Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
": " Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
escAttr Text
v) ((Text, Text) -> Doc Text)
-> ((Text, Text) -> (Text, Text)) -> (Text, Text) -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(Text, Text) -> (Text, Text)
preprocessKeyValues) [(Text, Text)]
keyvalues
escAttr :: Text -> Doc Text
escAttr = [Doc Text] -> Doc Text
forall a. Monoid a => [a] -> a
mconcat ([Doc Text] -> Doc Text)
-> (Text -> [Doc Text]) -> Text -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Doc Text) -> String -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Doc Text
escAttrChar (String -> [Doc Text]) -> (Text -> String) -> Text -> [Doc Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack
escAttrChar :: Char -> Doc Text
escAttrChar Char
'"' = Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
"\""
escAttrChar Char
c = Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Char -> Text
T.singleton Char
c
list :: [Doc Text]
list = [[Doc Text]] -> [Doc Text]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Doc Text]
attrId, [Doc Text]
attrClasses, [Doc Text]
attrKeyValues]
preprocessKeyValues :: (Text, Text) -> (Text, Text)
preprocessKeyValues :: (Text, Text) -> (Text, Text)
preprocessKeyValues (Text
key,Text
value)
| Text
key Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"alt" Bool -> Bool -> Bool
||
Text
key Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"caption" Bool -> Bool -> Bool
||
Text
key Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"title" = (Text
key, Text -> Text
inquotes Text
value)
| Bool
otherwise = (Text
key,Text
value)
intercalateDocText :: [Doc Text] -> Doc Text
intercalateDocText :: [Doc Text] -> Doc Text
intercalateDocText [] = Doc Text
forall a. Doc a
empty
intercalateDocText [Doc Text
x] = Doc Text
x
intercalateDocText (Doc Text
x:[Doc Text]
xs) = Doc Text
x 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] -> Doc Text
intercalateDocText [Doc Text]
xs)
addKeyValueToAttr :: Attr -> (Text,Text) -> Attr
addKeyValueToAttr :: Attr -> (Text, Text) -> Attr
addKeyValueToAttr (Text
ident,[Text]
classes,[(Text, Text)]
kvs) (Text
key,Text
value)
| Bool -> Bool
not (Text -> Bool
T.null Text
key) Bool -> Bool -> Bool
&& Bool -> Bool
not (Text -> Bool
T.null Text
value) = (Text
ident,
[Text]
classes,
(Text
key,Text
value)(Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
: [(Text, Text)]
kvs)
| Bool
otherwise = (Text
ident,[Text]
classes,[(Text, Text)]
kvs)
linkAttributes :: WriterOptions -> Attr -> Doc Text
linkAttributes :: WriterOptions -> Attr -> Doc Text
linkAttributes WriterOptions
opts Attr
attr =
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) Bool -> Bool -> Bool
&& Attr
attr Attr -> Attr -> Bool
forall a. Eq a => a -> a -> Bool
/= Attr
nullAttr
then WriterOptions -> Attr -> Doc Text
attrsToMarkdown WriterOptions
opts Attr
attr
else Doc Text
forall a. Doc a
empty
getKey :: Doc Text -> Key
getKey :: Doc Text -> Key
getKey = Text -> Key
toKey (Text -> Key) -> (Doc Text -> Text) -> Doc Text -> Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Int -> Doc Text -> Text
forall a. HasChars a => Maybe Int -> Doc a -> a
render Maybe Int
forall a. Maybe a
Nothing
findUsableIndex :: [Text] -> Int -> Int
findUsableIndex :: [Text] -> Int -> Int
findUsableIndex [Text]
lbls Int
i = if Int -> Text
forall a. Show a => a -> Text
tshow Int
i Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
lbls
then [Text] -> Int -> Int
findUsableIndex [Text]
lbls (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
else Int
i
getNextIndex :: PandocMonad m => MD m Int
getNextIndex :: forall (m :: * -> *). PandocMonad m => MD m Int
getNextIndex = do
prevRefs <- (WriterState -> Refs)
-> ReaderT WriterEnv (StateT WriterState m) Refs
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Refs
stPrevRefs
refs <- gets stRefs
i <- (+ 1) <$> gets stLastIdx
modify $ \WriterState
s -> WriterState
s{ stLastIdx = i }
let refLbls = ((Text, (Text, Text), Attr) -> Text) -> Refs -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (\(Text
r,(Text, Text)
_,Attr
_) -> Text
r) (Refs -> [Text]) -> Refs -> [Text]
forall a b. (a -> b) -> a -> b
$ Refs
prevRefs Refs -> Refs -> Refs
forall a. [a] -> [a] -> [a]
++ Refs
refs
return $ findUsableIndex refLbls i
getReference :: PandocMonad m => Attr -> Doc Text -> Target -> MD m Text
getReference :: forall (m :: * -> *).
PandocMonad m =>
Attr -> Doc Text -> (Text, Text) -> MD m Text
getReference Attr
attr Doc Text
label (Text, Text)
target = do
refs <- (WriterState -> Refs)
-> ReaderT WriterEnv (StateT WriterState m) Refs
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Refs
stRefs
case find (\(Text
_,(Text, Text)
t,Attr
a) -> (Text, Text)
t (Text, Text) -> (Text, Text) -> Bool
forall a. Eq a => a -> a -> Bool
== (Text, Text)
target Bool -> Bool -> Bool
&& Attr
a Attr -> Attr -> Bool
forall a. Eq a => a -> a -> Bool
== Attr
attr) refs of
Just (Text
ref, (Text, Text)
_, Attr
_) -> Text -> ReaderT WriterEnv (StateT WriterState m) Text
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
ref
Maybe (Text, (Text, Text), Attr)
Nothing -> do
keys <- (WriterState -> Map Key (Map ((Text, Text), Attr) Int))
-> ReaderT
WriterEnv
(StateT WriterState m)
(Map Key (Map ((Text, Text), Attr) Int))
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Map Key (Map ((Text, Text), Attr) Int)
stKeys
let key = Doc Text -> Key
getKey Doc Text
label
let rawkey = Key -> Text
forall a b. Coercible a b => a -> b
coerce Key
key
case M.lookup key keys of
Maybe (Map ((Text, Text), Attr) Int)
Nothing -> do
(lab', idx) <- if Text -> Bool
T.null Text
rawkey Bool -> Bool -> Bool
||
Text -> Int
T.length Text
rawkey Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
999 Bool -> Bool -> Bool
||
(Char -> Bool) -> Text -> Bool
T.any (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'[' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
']') Text
rawkey
then do
i <- MD m Int
forall (m :: * -> *). PandocMonad m => MD m Int
getNextIndex
return (tshow i, i)
else
(Text, Int) -> ReaderT WriterEnv (StateT WriterState m) (Text, Int)
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Int -> Doc Text -> Text
forall a. HasChars a => Maybe Int -> Doc a -> a
render Maybe Int
forall a. Maybe a
Nothing Doc Text
label, Int
0)
modify (\WriterState
s -> WriterState
s{
stRefs = (lab', target, attr) : refs,
stKeys = M.insert (getKey label)
(M.insert (target, attr) idx mempty)
(stKeys s) })
return lab'
Just Map ((Text, Text), Attr) Int
km ->
case ((Text, Text), Attr) -> Map ((Text, Text), Attr) Int -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup ((Text, Text)
target, Attr
attr) Map ((Text, Text), Attr) Int
km of
Just Int
i -> do
let lab' :: Text
lab' = Maybe Int -> Doc Text -> Text
forall a. HasChars a => Maybe Int -> Doc a -> a
render Maybe Int
forall a. Maybe a
Nothing (Doc Text -> Text) -> Doc Text -> Text
forall a b. (a -> b) -> a -> b
$
Doc Text
label Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> if Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
then Doc Text
forall a. Monoid a => a
mempty
else Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Int -> Text
forall a. Show a => a -> Text
tshow Int
i)
Bool
-> ReaderT WriterEnv (StateT WriterState m) ()
-> ReaderT WriterEnv (StateT WriterState m) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((Text
lab', (Text, Text)
target, Attr
attr) (Text, (Text, Text), Attr) -> Refs -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` Refs
refs) (ReaderT WriterEnv (StateT WriterState m) ()
-> ReaderT WriterEnv (StateT WriterState m) ())
-> ReaderT WriterEnv (StateT WriterState m) ()
-> ReaderT WriterEnv (StateT WriterState m) ()
forall a b. (a -> b) -> a -> b
$
(WriterState -> WriterState)
-> ReaderT WriterEnv (StateT WriterState m) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\WriterState
s -> WriterState
s{
stRefs = (lab', target, attr) : refs })
Text -> ReaderT WriterEnv (StateT WriterState m) Text
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
lab'
Maybe Int
Nothing -> do
i <- MD m Int
forall (m :: * -> *). PandocMonad m => MD m Int
getNextIndex
let lab' = Int -> Text
forall a. Show a => a -> Text
tshow Int
i
modify (\WriterState
s -> WriterState
s{
stRefs = (lab', target, attr) : refs,
stKeys = M.insert key
(M.insert (target, attr) i km)
(stKeys s) })
return lab'
inlineListToMarkdown :: PandocMonad m => WriterOptions -> [Inline] -> MD m (Doc Text)
inlineListToMarkdown :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> MD m (Doc Text)
inlineListToMarkdown WriterOptions
opts [Inline]
ils = 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
avoidBadWraps inlist <$> go ils
where go :: [Inline] -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
go [] = 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
forall a. Doc a
empty
go (x :: Inline
x@Math{}:y :: Inline
y@(Str Text
t):[Inline]
zs)
| (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isDigit (Int -> Text -> Text
T.take Int
1 Text
t)
= (Doc Text -> Doc Text -> Doc Text)
-> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
-> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
-> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
(<>) (WriterOptions
-> Inline -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> MD m (Doc Text)
inlineToMarkdown WriterOptions
opts Inline
x)
([Inline] -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
go (Format -> Text -> Inline
RawInline (Text -> Format
Format Text
"html") Text
"<!-- -->" Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Inline
y Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
zs))
go (Str Text
t : Inline
i : [Inline]
is)
| Inline -> Bool
isLinkOrSpan Inline
i
, Int -> Text -> Text
T.takeEnd Int
1 Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"!"
= do x <- WriterOptions
-> Inline -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> MD m (Doc Text)
inlineToMarkdown WriterOptions
opts (Text -> Inline
Str (Int -> Text -> Text
T.dropEnd Int
1 Text
t))
((x <> "\\!") <>) <$> go (i:is)
go (Inline
i:[Inline]
is) = case Inline
i of
Link {} -> case [Inline]
is of
Link {}:[Inline]
_ -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
unshortcutable
Inline
Space:Link {}:[Inline]
_ -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
unshortcutable
Inline
Space:(Str(Text -> Maybe Char
thead -> Just Char
'[')):[Inline]
_ -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
unshortcutable
Inline
Space:(RawInline Format
_ (Text -> Maybe Char
thead -> Just Char
'[')):[Inline]
_ -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
unshortcutable
Inline
Space:(Cite [Citation]
_ [Inline]
_):[Inline]
_ -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
unshortcutable
Inline
SoftBreak:Link {}:[Inline]
_ -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
unshortcutable
Inline
SoftBreak:(Str(Text -> Maybe Char
thead -> Just Char
'[')):[Inline]
_ -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
unshortcutable
Inline
SoftBreak:(RawInline Format
_ (Text -> Maybe Char
thead -> Just Char
'[')):[Inline]
_ -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
unshortcutable
Inline
SoftBreak:(Cite [Citation]
_ [Inline]
_):[Inline]
_ -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
unshortcutable
Inline
LineBreak:Link {}:[Inline]
_ -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
unshortcutable
Inline
LineBreak:(Str(Text -> Maybe Char
thead -> Just Char
'[')):[Inline]
_ -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
unshortcutable
Inline
LineBreak:(RawInline Format
_ (Text -> Maybe Char
thead -> Just Char
'[')):[Inline]
_ -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
unshortcutable
Inline
LineBreak:(Cite [Citation]
_ [Inline]
_):[Inline]
_ -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
unshortcutable
(Cite [Citation]
_ [Inline]
_):[Inline]
_ -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
unshortcutable
Str (Text -> Maybe Char
thead -> Just Char
'['):[Inline]
_ -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
unshortcutable
Str (Text -> Maybe Char
thead -> Just Char
'('):[Inline]
_ -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
unshortcutable
Str (Text -> Maybe Char
thead -> Just Char
':'):[Inline]
_ -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
unshortcutable
(RawInline Format
_ (Text -> Maybe Char
thead -> Just Char
'[')):[Inline]
_ -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
unshortcutable
(RawInline Format
_ (Text -> Maybe Char
thead -> Just Char
'(')):[Inline]
_ -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
unshortcutable
(RawInline Format
_ (Text -> Maybe Char
thead -> Just Char
':')):[Inline]
_ -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
unshortcutable
(RawInline Format
_ (Text -> Text -> Maybe Text
T.stripPrefix Text
" [" -> Just Text
_ )):[Inline]
_ -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
unshortcutable
[Inline]
_ -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
shortcutable
Inline
_ -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
shortcutable
where
shortcutable :: ReaderT WriterEnv (StateT WriterState m) (Doc Text)
shortcutable = (Doc Text -> Doc Text -> Doc Text)
-> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
-> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
-> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
(<>) (WriterOptions
-> Inline -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> MD m (Doc Text)
inlineToMarkdown WriterOptions
opts Inline
i) ([Inline] -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
go [Inline]
is)
unshortcutable :: ReaderT WriterEnv (StateT WriterState m) (Doc Text)
unshortcutable = do
iMark <- (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 { envRefShortcutable = False })
(WriterOptions
-> Inline -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> MD m (Doc Text)
inlineToMarkdown WriterOptions
opts Inline
i)
fmap (iMark <>) (go is)
thead :: Text -> Maybe Char
thead = ((Char, Text) -> Char) -> Maybe (Char, Text) -> Maybe Char
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Char, Text) -> Char
forall a b. (a, b) -> a
fst (Maybe (Char, Text) -> Maybe Char)
-> (Text -> Maybe (Char, Text)) -> Text -> Maybe Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe (Char, Text)
T.uncons
isLinkOrSpan :: Inline -> Bool
isLinkOrSpan Link{} = Bool
True
isLinkOrSpan Span{} = Bool
True
isLinkOrSpan Inline
_ = Bool
False
avoidBadWraps :: Bool -> Doc Text -> Doc Text
avoidBadWraps :: Bool -> Doc Text -> Doc Text
avoidBadWraps Bool
inListItem = [Doc Text] -> Doc Text
go ([Doc Text] -> Doc Text)
-> (Doc Text -> [Doc Text]) -> Doc Text -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc Text -> [Doc Text]
forall {a}. Doc a -> [Doc a]
toList
where
go :: [Doc Text] -> Doc Text
go [] = Doc Text
forall a. Monoid a => a
mempty
go (Doc Text
BreakingSpace : Text Int
len Text
t : Doc Text
BreakingSpace : [Doc Text]
xs)
= case Text -> Maybe (Char, Text)
T.uncons Text
t of
Just (Char
c,Text
t')
| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'>'
Bool -> Bool -> Bool
|| ((Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'*' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'+') Bool -> Bool -> Bool
&& Text -> Bool
T.null Text
t')
Bool -> Bool -> Bool
|| (Bool
inListItem Bool -> Bool -> Bool
&& Text -> Bool
isOrderedListMarker Text
t)
Bool -> Bool -> Bool
|| (Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"1." Bool -> Bool -> Bool
|| Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"1)")
-> Int -> Text -> Doc Text
forall a. Int -> a -> Doc a
Text (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> [Doc Text] -> Doc Text
go (Doc Text
forall a. Doc a
BreakingSpace Doc Text -> [Doc Text] -> [Doc Text]
forall a. a -> [a] -> [a]
: [Doc Text]
xs)
Maybe (Char, Text)
_ -> Doc Text
forall a. Doc a
BreakingSpace Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Doc Text
forall a. Int -> a -> Doc a
Text Int
len Text
t Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> [Doc Text] -> Doc Text
go (Doc Text
forall a. Doc a
BreakingSpace Doc Text -> [Doc Text] -> [Doc Text]
forall a. a -> [a] -> [a]
: [Doc Text]
xs)
go (Doc Text
x:[Doc Text]
xs) = Doc Text
x Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> [Doc Text] -> Doc Text
go [Doc Text]
xs
toList :: Doc a -> [Doc a]
toList (Concat (Concat Doc a
a Doc a
b) Doc a
c) = Doc a -> [Doc a]
toList (Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
Concat Doc a
a (Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
Concat Doc a
b Doc a
c))
toList (Concat Doc a
a Doc a
b) = Doc a
a Doc a -> [Doc a] -> [Doc a]
forall a. a -> [a] -> [a]
: Doc a -> [Doc a]
toList Doc a
b
toList Doc a
x = [Doc a
x]
inlineToMarkdown :: PandocMonad m => WriterOptions -> Inline -> MD m (Doc Text)
inlineToMarkdown :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> MD m (Doc Text)
inlineToMarkdown WriterOptions
opts (Span (Text
"",[Text
"emoji"],[(Text, Text)]
kvs) [Str Text
s]) =
case Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"data-emoji" [(Text, Text)]
kvs of
Just Text
emojiname | Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_emoji WriterOptions
opts ->
Doc Text -> MD m (Doc Text)
forall 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
$ 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
emojiname Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
":"
Maybe Text
_ -> WriterOptions -> Inline -> MD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> MD m (Doc Text)
inlineToMarkdown WriterOptions
opts (Text -> Inline
Str Text
s)
inlineToMarkdown WriterOptions
opts (Span (Text
"",[Text
"mark"],[]) [Inline]
ils)
| Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_mark WriterOptions
opts
= do contents <- WriterOptions -> [Inline] -> MD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> MD m (Doc Text)
inlineListToMarkdown WriterOptions
opts [Inline]
ils
return $ "==" <> contents <> "=="
inlineToMarkdown WriterOptions
opts (Span Attr
attrs [Inline]
ils) = 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
contents <- inlineListToMarkdown opts ils
return $ case attrs of
(Text
_,[Text
"csl-block"],[(Text, Text)]
_) -> (Doc Text
forall a. Doc a
cr Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>)
(Text
_,[Text
"csl-left-margin"],[(Text, Text)]
_) -> (Doc Text
forall a. Doc a
cr Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>)
(Text
_,[Text
"csl-indent"],[(Text, Text)]
_) -> (Doc Text
forall a. Doc a
cr Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>)
Attr
_ -> Doc Text -> Doc Text
forall a. a -> a
id
$ case variant of
MarkdownVariant
PlainText -> Doc Text
contents
MarkdownVariant
Markua -> Doc Text
"`" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"`" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> WriterOptions -> Attr -> Doc Text
attrsToMarkua WriterOptions
opts Attr
attrs
MarkdownVariant
_ | Attr
attrs Attr -> Attr -> Bool
forall a. Eq a => a -> a -> Bool
== Attr
nullAttr -> Doc Text
contents
| Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_bracketed_spans WriterOptions
opts ->
let attrs' :: Doc Text
attrs' = if Attr
attrs Attr -> Attr -> Bool
forall a. Eq a => a -> a -> Bool
/= Attr
nullAttr
then WriterOptions -> Attr -> Doc Text
attrsToMarkdown WriterOptions
opts Attr
attrs
else Doc Text
forall a. Doc a
empty
in Doc Text
"[" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"]" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
attrs'
| Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_raw_html WriterOptions
opts Bool -> Bool -> Bool
||
Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_native_spans WriterOptions
opts ->
Text -> Attr -> Doc Text
forall a. HasChars a => a -> Attr -> Doc a
tagWithAttrs Text
"span" Attr
attrs Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
"</span>"
| Bool
otherwise -> Doc Text
contents
inlineToMarkdown WriterOptions
_ (Emph []) = 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
forall a. Doc a
empty
inlineToMarkdown WriterOptions
opts (Emph [Inline]
lst) = 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
contents <- inlineListToMarkdown opts lst
return $ case variant of
MarkdownVariant
PlainText
| Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_gutenberg WriterOptions
opts -> Doc Text
"_" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"_"
| Bool
otherwise -> Doc Text
contents
MarkdownVariant
_ -> Doc Text
"*" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"*"
inlineToMarkdown WriterOptions
_ (Underline []) = 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
forall a. Doc a
empty
inlineToMarkdown WriterOptions
opts (Underline [Inline]
lst) = 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
contents <- inlineListToMarkdown opts lst
case variant of
MarkdownVariant
PlainText -> 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
contents
MarkdownVariant
_ | Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_bracketed_spans 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
$ Doc Text
"[" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"]" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"{.underline}"
| Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_native_spans 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 -> Attr -> Doc Text
forall a. HasChars a => a -> Attr -> Doc a
tagWithAttrs Text
"span" (Text
"", [Text
"underline"], [])
Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents
Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
"</span>"
| 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
$ Doc Text
"<u>" 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
"</u>"
| Bool
otherwise -> WriterOptions -> Inline -> MD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> MD m (Doc Text)
inlineToMarkdown WriterOptions
opts ([Inline] -> Inline
Emph [Inline]
lst)
inlineToMarkdown WriterOptions
_ (Strong []) = 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
forall a. Doc a
empty
inlineToMarkdown WriterOptions
opts (Strong [Inline]
lst) = 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 ->
WriterOptions -> [Inline] -> MD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> MD m (Doc Text)
inlineListToMarkdown WriterOptions
opts ([Inline] -> MD m (Doc Text)) -> [Inline] -> MD m (Doc Text)
forall a b. (a -> b) -> a -> b
$
if Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_gutenberg WriterOptions
opts
then [Inline] -> [Inline]
forall a. Walkable Inline a => a -> a
capitalize [Inline]
lst
else [Inline]
lst
MarkdownVariant
_ -> do
contents <- WriterOptions -> [Inline] -> MD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> MD m (Doc Text)
inlineListToMarkdown WriterOptions
opts [Inline]
lst
return $ "**" <> contents <> "**"
inlineToMarkdown WriterOptions
_ (Strikeout []) = 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
forall a. Doc a
empty
inlineToMarkdown WriterOptions
opts (Strikeout [Inline]
lst) = do
contents <- WriterOptions -> [Inline] -> MD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> MD m (Doc Text)
inlineListToMarkdown WriterOptions
opts [Inline]
lst
return $ if isEnabled Ext_strikeout opts
then "~~" <> contents <> "~~"
else if isEnabled Ext_raw_html opts
then "<s>" <> contents <> "</s>"
else contents
inlineToMarkdown WriterOptions
_ (Superscript []) = 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
forall a. Doc a
empty
inlineToMarkdown WriterOptions
opts (Superscript [Inline]
lst) =
(WriterEnv -> WriterEnv) -> MD m (Doc Text) -> MD 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 {envEscapeSpaces = envVariant env == Markdown}) (MD m (Doc Text) -> MD m (Doc Text))
-> MD m (Doc Text) -> MD m (Doc Text)
forall a b. (a -> b) -> a -> b
$ do
contents <- WriterOptions -> [Inline] -> MD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> MD m (Doc Text)
inlineListToMarkdown WriterOptions
opts [Inline]
lst
if isEnabled Ext_superscript opts
then return $ "^" <> contents <> "^"
else if isEnabled Ext_raw_html opts
then return $ "<sup>" <> contents <> "</sup>"
else
case traverse toSuperscriptInline lst of
Just [Inline]
xs' | Bool -> Bool
not (WriterOptions -> Bool
writerPreferAscii WriterOptions
opts)
-> WriterOptions -> [Inline] -> MD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> MD m (Doc Text)
inlineListToMarkdown WriterOptions
opts [Inline]
xs'
Maybe [Inline]
_ -> do
let rendered :: Text
rendered = Maybe Int -> Doc Text -> Text
forall a. HasChars a => Maybe Int -> Doc a -> a
render Maybe Int
forall a. Maybe a
Nothing Doc Text
contents
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
$
case (Char -> Maybe Char) -> String -> Maybe String
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 Char -> Maybe Char
toSuperscript (Text -> String
T.unpack Text
rendered) of
Just String
r -> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
r
Maybe String
Nothing -> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Text
"^(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
rendered Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
inlineToMarkdown WriterOptions
_ (Subscript []) = 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
forall a. Doc a
empty
inlineToMarkdown WriterOptions
opts (Subscript [Inline]
lst) =
(WriterEnv -> WriterEnv) -> MD m (Doc Text) -> MD 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 {envEscapeSpaces = envVariant env == Markdown}) (MD m (Doc Text) -> MD m (Doc Text))
-> MD m (Doc Text) -> MD m (Doc Text)
forall a b. (a -> b) -> a -> b
$ do
contents <- WriterOptions -> [Inline] -> MD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> MD m (Doc Text)
inlineListToMarkdown WriterOptions
opts [Inline]
lst
if isEnabled Ext_subscript opts
then return $ "~" <> contents <> "~"
else if isEnabled Ext_raw_html opts
then return $ "<sub>" <> contents <> "</sub>"
else
case traverse toSubscriptInline lst of
Just [Inline]
xs' | Bool -> Bool
not (WriterOptions -> Bool
writerPreferAscii WriterOptions
opts)
-> WriterOptions -> [Inline] -> MD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> MD m (Doc Text)
inlineListToMarkdown WriterOptions
opts [Inline]
xs'
Maybe [Inline]
_ -> do
let rendered :: Text
rendered = Maybe Int -> Doc Text -> Text
forall a. HasChars a => Maybe Int -> Doc a -> a
render Maybe Int
forall a. Maybe a
Nothing Doc Text
contents
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
$
case (Char -> Maybe Char) -> String -> Maybe String
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 Char -> Maybe Char
toSuperscript (Text -> String
T.unpack Text
rendered) of
Just String
r -> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
r
Maybe String
Nothing -> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Text
"_(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
rendered Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
inlineToMarkdown WriterOptions
opts (SmallCaps [Inline]
lst) = 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
if variant /= PlainText &&
(isEnabled Ext_raw_html opts || isEnabled Ext_native_spans opts)
then inlineToMarkdown opts (Span ("",["smallcaps"],[]) lst)
else inlineListToMarkdown opts $ capitalize lst
inlineToMarkdown WriterOptions
opts (Quoted QuoteType
SingleQuote [Inline]
lst) = do
contents <- WriterOptions -> [Inline] -> MD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> MD m (Doc Text)
inlineListToMarkdown WriterOptions
opts [Inline]
lst
return $ if isEnabled Ext_smart opts
then "'" <> contents <> "'"
else
if writerPreferAscii opts
then "‘" <> contents <> "’"
else "‘" <> contents <> "’"
inlineToMarkdown WriterOptions
opts (Quoted QuoteType
DoubleQuote [Inline]
lst) = do
contents <- WriterOptions -> [Inline] -> MD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> MD m (Doc Text)
inlineListToMarkdown WriterOptions
opts [Inline]
lst
return $ if isEnabled Ext_smart opts
then "\"" <> contents <> "\""
else
if writerPreferAscii opts
then "“" <> contents <> "”"
else "“" <> contents <> "”"
inlineToMarkdown WriterOptions
opts (Code Attr
attr 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 tickGroups = (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Char -> Bool) -> Text -> Bool
T.any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'`')) ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
T.group Text
str
let longest = Int -> (NonEmpty Int -> Int) -> Maybe (NonEmpty Int) -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 NonEmpty Int -> Int
forall a. Ord a => NonEmpty a -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (Maybe (NonEmpty Int) -> Int) -> Maybe (NonEmpty Int) -> Int
forall a b. (a -> b) -> a -> b
$ [Int] -> Maybe (NonEmpty Int)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty ([Int] -> Maybe (NonEmpty Int)) -> [Int] -> Maybe (NonEmpty Int)
forall a b. (a -> b) -> a -> b
$ (Text -> Int) -> [Text] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Int
T.length [Text]
tickGroups
let marker = Int -> Text -> Text
T.replicate (Int
longest Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Text
"`"
let spacer = if Int
longest Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then Text
"" else Text
" "
let attrsEnabled = Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_inline_code_attributes WriterOptions
opts Bool -> Bool -> Bool
||
Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_attributes WriterOptions
opts
let attrs = case MarkdownVariant
variant of
MarkdownVariant
Markua -> WriterOptions -> Attr -> Doc Text
attrsToMarkua WriterOptions
opts Attr
attr
MarkdownVariant
_ -> if Bool
attrsEnabled Bool -> Bool -> Bool
&& Attr
attr Attr -> Attr -> Bool
forall a. Eq a => a -> a -> Bool
/= Attr
nullAttr
then WriterOptions -> Attr -> Doc Text
attrsToMarkdown WriterOptions
opts Attr
attr
else Doc Text
forall a. Doc a
empty
case variant of
MarkdownVariant
PlainText -> 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
MarkdownVariant
_ -> 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
marker Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
spacer Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
str Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
spacer Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
marker) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
attrs
inlineToMarkdown WriterOptions
opts (Str 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 str' = case MarkdownVariant
variant of
MarkdownVariant
Markua -> Text -> Text
escapeMarkuaString Text
str
MarkdownVariant
_ -> (if WriterOptions -> Bool
writerPreferAscii WriterOptions
opts
then Text -> Text
toHtml5Entities
else Text -> Text
forall a. a -> a
id) (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(if Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_smart WriterOptions
opts
then WriterOptions -> Text -> Text
unsmartify WriterOptions
opts
else Text -> Text
forall a. a -> a
id) (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(if MarkdownVariant
variant MarkdownVariant -> MarkdownVariant -> Bool
forall a. Eq a => a -> a -> Bool
== MarkdownVariant
PlainText
then Text -> Text
forall a. a -> a
id
else WriterOptions -> Text -> Text
escapeText WriterOptions
opts) (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text
str
return $ literal str'
inlineToMarkdown WriterOptions
opts (Math MathType
InlineMath 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
case () of
()
_ | MarkdownVariant
variant MarkdownVariant -> MarkdownVariant -> Bool
forall a. Eq a => a -> a -> Bool
== MarkdownVariant
Markua -> 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
$ Doc Text
"`" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
str Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"`" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"$"
| Bool
otherwise -> case WriterOptions -> HTMLMathMethod
writerHTMLMathMethod WriterOptions
opts of
WebTeX Text
url ->
let str' :: Text
str' = Text -> Text
T.strip Text
str
in WriterOptions -> Inline -> MD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> MD m (Doc Text)
inlineToMarkdown WriterOptions
opts
(Attr -> [Inline] -> (Text, Text) -> Inline
Image Attr
nullAttr [Text -> Inline
Str Text
str'] (Text
url Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
urlEncode Text
str', Text
str'))
HTMLMathMethod
_ | Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_tex_math_gfm 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
$ Doc Text
"$`" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
str Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"`$"
| Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_tex_math_dollars WriterOptions
opts ->
Doc Text -> MD m (Doc Text)
forall 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
$ Doc Text
"$" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
str Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"$"
| Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_tex_math_single_backslash WriterOptions
opts ->
Doc Text -> MD m (Doc Text)
forall 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
$ Doc Text
"\\(" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
str Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"\\)"
| Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_tex_math_double_backslash WriterOptions
opts ->
Doc Text -> MD m (Doc Text)
forall 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
$ Doc Text
"\\\\(" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
str Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"\\\\)"
| Bool
otherwise ->
MathType
-> Text -> ReaderT WriterEnv (StateT WriterState m) [Inline]
forall (m :: * -> *).
PandocMonad m =>
MathType -> Text -> m [Inline]
texMathToInlines MathType
InlineMath Text
str ReaderT WriterEnv (StateT WriterState m) [Inline]
-> ([Inline] -> MD m (Doc Text)) -> MD m (Doc Text)
forall 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 -> [Inline] -> MD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> MD m (Doc Text)
inlineListToMarkdown WriterOptions
opts ([Inline] -> MD m (Doc Text))
-> ([Inline] -> [Inline]) -> [Inline] -> MD m (Doc Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(if MarkdownVariant
variant MarkdownVariant -> MarkdownVariant -> Bool
forall a. Eq a => a -> a -> Bool
== MarkdownVariant
PlainText then [Inline] -> [Inline]
makeMathPlainer else [Inline] -> [Inline]
forall a. a -> a
id)
inlineToMarkdown WriterOptions
opts (Math MathType
DisplayMath 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
case () of
()
_ | MarkdownVariant
variant MarkdownVariant -> MarkdownVariant -> Bool
forall a. Eq a => a -> a -> Bool
== MarkdownVariant
Markua -> do
let attributes :: Doc Text
attributes = WriterOptions -> Attr -> Doc Text
attrsToMarkua WriterOptions
opts (Attr -> (Text, Text) -> Attr
addKeyValueToAttr (Text
"",[],[])
(Text
"format", Text
"latex"))
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
$ Doc Text
forall a. Doc a
blankline Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
attributes 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
"```" 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
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
"```" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
blankline
| Bool
otherwise -> case WriterOptions -> HTMLMathMethod
writerHTMLMathMethod WriterOptions
opts of
WebTeX Text
url ->
let str' :: Text
str' = Text -> Text
T.strip Text
str
in (\Doc Text
x -> Doc Text
forall a. Doc a
blankline Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
x Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
blankline) (Doc Text -> Doc Text) -> MD m (Doc Text) -> MD m (Doc Text)
forall 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 -> Inline -> MD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> MD m (Doc Text)
inlineToMarkdown WriterOptions
opts (Attr -> [Inline] -> (Text, Text) -> Inline
Image Attr
nullAttr [Text -> Inline
Str Text
str']
(Text
url Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
urlEncode Text
str', Text
str'))
HTMLMathMethod
_ | Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_tex_math_gfm 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
$ 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
"``` math"
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
<> Doc Text
forall a. Doc a
cr
| Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_tex_math_dollars WriterOptions
opts ->
Doc Text -> MD m (Doc Text)
forall 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
$ Doc Text
"$$" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
str Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"$$"
| Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_tex_math_single_backslash WriterOptions
opts ->
Doc Text -> MD m (Doc Text)
forall 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
$ Doc Text
"\\[" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
str Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"\\]"
| Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_tex_math_double_backslash WriterOptions
opts ->
Doc Text -> MD m (Doc Text)
forall 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
$ Doc Text
"\\\\[" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
str Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"\\\\]"
| Bool
otherwise -> (\Doc Text
x -> Doc Text
forall a. Doc a
cr Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
x Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
cr) (Doc Text -> Doc Text) -> MD m (Doc Text) -> MD m (Doc Text)
forall 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`
(MathType
-> Text -> ReaderT WriterEnv (StateT WriterState m) [Inline]
forall (m :: * -> *).
PandocMonad m =>
MathType -> Text -> m [Inline]
texMathToInlines MathType
DisplayMath Text
str ReaderT WriterEnv (StateT WriterState m) [Inline]
-> ([Inline] -> MD m (Doc Text)) -> MD m (Doc Text)
forall 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 -> [Inline] -> MD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> MD m (Doc Text)
inlineListToMarkdown WriterOptions
opts)
inlineToMarkdown WriterOptions
opts il :: Inline
il@(RawInline Format
f Text
str) = do
let tickGroups :: [Text]
tickGroups = (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Char -> Bool) -> Text -> Bool
T.any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'`')) ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
T.group Text
str
let numticks :: Int
numticks = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> (NonEmpty Int -> Int) -> Maybe (NonEmpty Int) -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 NonEmpty Int -> Int
forall a. Ord a => NonEmpty a -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Maybe (NonEmpty Int)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty ((Text -> Int) -> [Text] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Int
T.length [Text]
tickGroups))
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 rawAttribInline = 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 (Int -> Text -> Text
T.replicate Int
numticks Text
"`") Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
str Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>
Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Int -> Text -> Text
T.replicate Int
numticks 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
"{=" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
fmt Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
"}"
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 (Inline -> LogMessage
InlineNotRendered Inline
il)
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
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
str
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
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
str
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
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
str
MarkdownVariant
Markua -> MD m (Doc Text)
renderEmpty
MarkdownVariant
_ | Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_raw_attribute WriterOptions
opts -> MD m (Doc Text)
rawAttribInline
| Format
f Format -> [Format] -> Bool
forall 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
| 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
MarkdownVariant
_ -> MD m (Doc Text)
renderEmpty
inlineToMarkdown WriterOptions
opts Inline
LineBreak = 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
if variant == PlainText || isEnabled Ext_hard_line_breaks opts
then return cr
else return $
if isEnabled Ext_escaped_line_breaks opts
then "\\" <> cr
else " " <> cr
inlineToMarkdown WriterOptions
_ Inline
Space = do
escapeSpaces <- (WriterEnv -> Bool)
-> ReaderT WriterEnv (StateT WriterState m) Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Bool
envEscapeSpaces
return $ if escapeSpaces then "\\ " else space
inlineToMarkdown WriterOptions
opts Inline
SoftBreak = do
escapeSpaces <- (WriterEnv -> Bool)
-> ReaderT WriterEnv (StateT WriterState m) Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Bool
envEscapeSpaces
let space' = if Bool
escapeSpaces then Doc Text
"\\ " else Doc Text
forall a. Doc a
space
return $ case writerWrapText opts of
WrapOption
WrapNone -> Doc Text
space'
WrapOption
WrapAuto -> Doc Text
space'
WrapOption
WrapPreserve -> Doc Text
forall a. Doc a
cr
inlineToMarkdown WriterOptions
opts (Cite [] [Inline]
lst) = WriterOptions -> [Inline] -> MD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> MD m (Doc Text)
inlineListToMarkdown WriterOptions
opts [Inline]
lst
inlineToMarkdown WriterOptions
opts (Cite (Citation
c:[Citation]
cs) [Inline]
lst)
| Bool -> Bool
not (Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_citations WriterOptions
opts) = WriterOptions -> [Inline] -> MD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> MD m (Doc Text)
inlineListToMarkdown WriterOptions
opts [Inline]
lst
| Bool
otherwise =
if Citation -> CitationMode
citationMode Citation
c CitationMode -> CitationMode -> Bool
forall a. Eq a => a -> a -> Bool
== CitationMode
AuthorInText
then do
suffs <- WriterOptions -> [Inline] -> MD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> MD m (Doc Text)
inlineListToMarkdown WriterOptions
opts ([Inline] -> MD m (Doc Text)) -> [Inline] -> MD m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Citation -> [Inline]
citationSuffix Citation
c
rest <- mapM convertOne cs
let inbr = Doc Text
suffs Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>
(if Bool -> Bool
not ([Inline] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Citation -> [Inline]
citationSuffix Citation
c)) Bool -> Bool -> Bool
&& Bool -> Bool
not ([Doc Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Doc Text]
rest)
then String -> Doc Text
forall a. HasChars a => String -> Doc a
text String
";"
else Doc Text
forall a. Monoid a => a
mempty)
Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
<+> [Doc Text] -> Doc Text
joincits [Doc Text]
rest
br = if Doc Text -> Bool
forall a. Doc a -> Bool
isEmpty Doc Text
inbr then Doc Text
forall a. Doc a
empty else Char -> Doc Text
forall a. HasChars a => Char -> Doc a
char Char
'[' Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
inbr Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Char -> Doc Text
forall a. HasChars a => Char -> Doc a
char Char
']'
return $ literal ("@" <> maybeInBraces (citationId c)) <+> br
else do
cits <- (Citation -> MD m (Doc Text))
-> [Citation]
-> ReaderT WriterEnv (StateT WriterState m) [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Citation -> MD m (Doc Text)
forall {m :: * -> *}.
PandocMonad m =>
Citation -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
convertOne (Citation
cCitation -> [Citation] -> [Citation]
forall a. a -> [a] -> [a]
:[Citation]
cs)
return $ literal "[" <> joincits cits <> literal "]"
where
maybeInBraces :: a -> a
maybeInBraces a
key =
case Parsec Sources ParserState ()
-> ParserState -> a -> Either PandocError ()
forall t st a.
ToSources t =>
Parsec Sources st a -> st -> t -> Either PandocError a
readWith (Bool -> ParsecT Sources ParserState Identity (Bool, Text)
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char, HasLastStrPosition st) =>
Bool -> ParsecT s st m (Bool, Text)
citeKey Bool
False ParsecT Sources ParserState Identity (Bool, Text)
-> Parsec Sources ParserState () -> Parsec Sources ParserState ()
forall a b.
ParsecT Sources ParserState Identity a
-> ParsecT Sources ParserState Identity b
-> ParsecT Sources ParserState Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parsec Sources ParserState ()
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m ()
spaces Parsec Sources ParserState ()
-> Parsec Sources ParserState () -> Parsec Sources ParserState ()
forall a b.
ParsecT Sources ParserState Identity a
-> ParsecT Sources ParserState Identity b
-> ParsecT Sources ParserState Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parsec Sources ParserState ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof)
ParserState
defaultParserState (a
"@" a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
key) of
Left PandocError
_ -> a
"{" a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
key a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
"}"
Right ()
_ -> a
key
joincits :: [Doc Text] -> Doc Text
joincits = [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
hcat ([Doc Text] -> Doc Text)
-> ([Doc Text] -> [Doc Text]) -> [Doc Text] -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc Text -> [Doc Text] -> [Doc Text]
forall a. a -> [a] -> [a]
intersperse (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
"; ") ([Doc Text] -> [Doc Text])
-> ([Doc Text] -> [Doc Text]) -> [Doc Text] -> [Doc Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Doc Text -> Bool) -> [Doc Text] -> [Doc Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Doc Text -> Bool) -> Doc Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc Text -> Bool
forall a. Doc a -> Bool
isEmpty)
convertOne :: Citation -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
convertOne Citation { citationId :: Citation -> Text
citationId = Text
k
, citationPrefix :: Citation -> [Inline]
citationPrefix = [Inline]
pinlines
, citationSuffix :: Citation -> [Inline]
citationSuffix = [Inline]
sinlines
, citationMode :: Citation -> CitationMode
citationMode = CitationMode
m }
= do
pdoc <- WriterOptions
-> [Inline] -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> MD m (Doc Text)
inlineListToMarkdown WriterOptions
opts [Inline]
pinlines
sdoc <- inlineListToMarkdown opts sinlines
let k' = Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (CitationMode -> Text
forall {a}. IsString a => CitationMode -> a
modekey CitationMode
m Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"@" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
forall {a}. (ToSources a, Semigroup a, IsString a) => a -> a
maybeInBraces Text
k)
r = case [Inline]
sinlines of
Str (Text -> Maybe (Char, Text)
T.uncons -> Just (Char
y,Text
_)):[Inline]
_
| Char
y Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (String
",;]@" :: String) -> Doc Text
k' Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
sdoc
Inline
Space:[Inline]
_ -> Doc Text
k' Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
sdoc
[Inline]
_ -> Doc Text
k' Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
<+> Doc Text
sdoc
return $ pdoc <+> r
modekey :: CitationMode -> a
modekey CitationMode
SuppressAuthor = a
"-"
modekey CitationMode
_ = a
""
inlineToMarkdown WriterOptions
opts lnk :: Inline
lnk@(Link attr :: Attr
attr@(Text
ident,[Text]
classes,[(Text, Text)]
kvs) [Inline]
txt (Text
src, Text
tit)) = 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
linktext <- inlineListToMarkdown opts txt
let linktitle = if Text -> Bool
T.null Text
tit
then Doc Text
forall a. Doc a
empty
else Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Text
" \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
tit Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\""
let srcSuffix = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
src (Text -> Text -> Maybe Text
T.stripPrefix Text
"mailto:" Text
src)
let useAuto = Text -> Bool
isURI Text
src Bool -> Bool -> Bool
&&
Text -> Bool
T.null Text
ident Bool -> Bool -> Bool
&&
[(Text, Text)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Text, Text)]
kvs Bool -> Bool -> Bool
&&
([Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
classes Bool -> Bool -> Bool
|| [Text]
classes [Text] -> [Text] -> Bool
forall a. Eq a => a -> a -> Bool
== [Text
"uri"] Bool -> Bool -> Bool
|| [Text]
classes [Text] -> [Text] -> Bool
forall a. Eq a => a -> a -> Bool
== [Text
"email"]) Bool -> Bool -> Bool
&&
case [Inline]
txt of
[Str Text
s] | Text -> Text
escapeURI Text
s Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
srcSuffix -> Bool
True
[Inline]
_ -> Bool
False
let useWikilink = Text
tit Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"wikilink" Bool -> Bool -> Bool
&&
(Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_wikilinks_title_after_pipe WriterOptions
opts Bool -> Bool -> Bool
||
Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_wikilinks_title_before_pipe WriterOptions
opts)
let useRefLinks = WriterOptions -> Bool
writerReferenceLinks WriterOptions
opts Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
useAuto
shortcutable <- asks envRefShortcutable
let useShortcutRefLinks = Bool
shortcutable 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_shortcut_reference_links WriterOptions
opts)
reftext <- if useRefLinks
then literal <$> getReference attr linktext (src, tit)
else return mempty
case variant of
MarkdownVariant
PlainText
| Bool
useAuto -> 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
srcSuffix
| Bool
otherwise -> 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
linktext
MarkdownVariant
Markua
| Text -> Bool
T.null Text
tit -> 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
$ Doc Text
result Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> WriterOptions -> Attr -> Doc Text
attrsToMarkua WriterOptions
opts Attr
attr
| Bool
otherwise -> 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
$ Doc Text
result Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> WriterOptions -> Attr -> Doc Text
attrsToMarkua WriterOptions
opts Attr
attributes
where result :: Doc Text
result = Doc Text
"[" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
linktext Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"](" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
src) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
")"
attributes :: Attr
attributes = Attr -> (Text, Text) -> Attr
addKeyValueToAttr Attr
attr (Text
"title", Text
tit)
MarkdownVariant
_ | Text
src Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== [Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify [Inline]
txt Bool -> Bool -> Bool
&& Bool
useWikilink ->
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
$ 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 ([Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify [Inline]
txt) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"]]"
| Bool
useAuto -> 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
$ 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
srcSuffix Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
">"
| Bool
useWikilink Bool -> Bool -> Bool
&& Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_wikilinks_title_after_pipe 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
$
Doc Text
"[[" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
src Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"|" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal ([Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify [Inline]
txt) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"]]"
| Bool
useWikilink Bool -> Bool -> Bool
&& Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_wikilinks_title_before_pipe 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
$
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 ([Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify [Inline]
txt) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"|" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
src Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"]]"
| Bool
useRefLinks ->
let first :: Doc Text
first = Doc Text
"[" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
linktext Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"]"
second :: Doc Text
second = if Doc Text -> Key
getKey Doc Text
linktext Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Doc Text -> Key
getKey Doc Text
reftext
then if Bool
useShortcutRefLinks
then Doc Text
""
else Doc Text
"[]"
else Doc Text
"[" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
reftext Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"]"
in 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
$ Doc Text
first Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
second
| Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_raw_html WriterOptions
opts
, Bool -> Bool
not (Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_link_attributes WriterOptions
opts Bool -> Bool -> Bool
|| Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_attributes WriterOptions
opts)
, Attr
attr Attr -> Attr -> Bool
forall a. Eq a => a -> a -> Bool
/= Attr
nullAttr ->
Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> (Text -> Text) -> Text -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.strip (Text -> Doc Text)
-> ReaderT WriterEnv (StateT WriterState m) Text -> MD m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
WriterOptions
-> Pandoc -> ReaderT WriterEnv (StateT WriterState m) Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeHtml5String WriterOptions
opts{ writerTemplate = Nothing }
(Meta -> [Block] -> Pandoc
Pandoc Meta
nullMeta [[Inline] -> Block
Plain [Inline
lnk]])
| Bool
otherwise -> 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
$
Doc Text
"[" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
linktext Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"](" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
src Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
linktitle 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
<>
WriterOptions -> Attr -> Doc Text
linkAttributes WriterOptions
opts Attr
attr
inlineToMarkdown WriterOptions
opts img :: Inline
img@(Image Attr
attr [Inline]
alternate (Text
source, Text
tit))
| Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_raw_html WriterOptions
opts Bool -> Bool -> Bool
&&
Bool -> Bool
not (Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_link_attributes WriterOptions
opts Bool -> Bool -> Bool
|| Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_attributes WriterOptions
opts) Bool -> Bool -> Bool
&&
Attr
attr Attr -> Attr -> Bool
forall a. Eq a => a -> a -> Bool
/= Attr
nullAttr =
Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> (Text -> Text) -> Text -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.strip (Text -> Doc Text)
-> ReaderT WriterEnv (StateT WriterState m) Text -> MD m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
WriterOptions
-> Pandoc -> ReaderT WriterEnv (StateT WriterState m) Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeHtml5String WriterOptions
opts{ writerTemplate = Nothing } (Meta -> [Block] -> Pandoc
Pandoc Meta
nullMeta [[Inline] -> Block
Plain [Inline
img]])
| Bool
otherwise = 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 txt = if [Inline] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
alternate Bool -> Bool -> Bool
|| [Inline]
alternate [Inline] -> [Inline] -> Bool
forall a. Eq a => a -> a -> Bool
== [Text -> Inline
Str Text
source]
then [Text -> Inline
Str Text
""]
else [Inline]
alternate
linkPart <- inlineToMarkdown opts (Link attr txt (source, tit))
alt <- inlineListToMarkdown opts alternate
let attributes | MarkdownVariant
variant MarkdownVariant -> MarkdownVariant -> Bool
forall a. Eq a => a -> a -> Bool
== MarkdownVariant
Markua = WriterOptions -> Attr -> Doc Text
attrsToMarkua WriterOptions
opts (Attr -> Doc Text) -> Attr -> Doc Text
forall a b. (a -> b) -> a -> b
$
Attr -> (Text, Text) -> Attr
addKeyValueToAttr (Attr -> (Text, Text) -> Attr
addKeyValueToAttr Attr
attr (Text
"title", Text
tit))
(Text
"alt", Maybe Int -> Doc Text -> Text
forall a. HasChars a => Maybe Int -> Doc a -> a
render (Int -> Maybe Int
forall a. a -> Maybe a
Just (WriterOptions -> Int
writerColumns WriterOptions
opts)) Doc Text
alt)
| Bool
otherwise = Doc Text
forall a. Doc a
empty
return $ case variant of
MarkdownVariant
PlainText -> Doc Text
"[" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
linkPart Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"]"
MarkdownVariant
Markua -> Doc Text
forall a. Doc a
cr Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
attributes 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
"" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
cr
MarkdownVariant
_ -> Doc Text
"!" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
linkPart
inlineToMarkdown WriterOptions
opts (Note [Block]
contents) = do
(WriterState -> WriterState)
-> ReaderT WriterEnv (StateT WriterState m) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\WriterState
st -> WriterState
st{ stNotes = contents : stNotes st })
st <- ReaderT WriterEnv (StateT WriterState m) WriterState
forall s (m :: * -> *). MonadState s m => m s
get
let ref = Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ WriterOptions -> Text
writerIdentifierPrefix WriterOptions
opts Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow (WriterState -> Int
stNoteNum WriterState
st Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [[Block]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (WriterState -> [[Block]]
stNotes WriterState
st) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
if isEnabled Ext_footnotes opts
then return $ "[^" <> ref <> "]"
else return $ "[" <> ref <> "]"
makeMathPlainer :: [Inline] -> [Inline]
makeMathPlainer :: [Inline] -> [Inline]
makeMathPlainer = (Inline -> Inline) -> [Inline] -> [Inline]
forall a b. Walkable a b => (a -> a) -> b -> b
walk Inline -> Inline
go
where
go :: Inline -> Inline
go (Emph [Inline]
xs) = Attr -> [Inline] -> Inline
Span Attr
nullAttr [Inline]
xs
go Inline
x = Inline
x