{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}
module Text.Pandoc.Writers.CommonMark (writeCommonMark) where
import CMarkGFM
import Control.Monad.State.Strict (State, get, modify, runState)
import Data.Char (isAscii)
import Data.Foldable (foldrM)
import Data.List (transpose)
import Data.Text (Text)
import qualified Data.Text as T
import Network.HTTP (urlEncode)
import Text.Pandoc.Class.PandocMonad (PandocMonad)
import Text.Pandoc.Definition
import Text.Pandoc.Options
import Text.Pandoc.Shared (capitalize, isTightList,
linesToPara, onlySimpleTableCells, taskListItemToAscii, tshow)
import Text.Pandoc.Templates (renderTemplate)
import Text.Pandoc.Walk (walk, walkM)
import Text.Pandoc.Writers.HTML (writeHtml5String, tagWithAttributes)
import Text.Pandoc.Writers.Shared
import Text.Pandoc.XML (toHtml5Entities)
import Text.DocLayout (literal, render)
writeCommonMark :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writeCommonMark :: WriterOptions -> Pandoc -> m Text
writeCommonMark WriterOptions
opts (Pandoc Meta
meta [Block]
blocks) = do
Text
toc <- if WriterOptions -> Bool
writerTableOfContents WriterOptions
opts
then WriterOptions -> [Block] -> m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> m Text
blocksToCommonMark WriterOptions
opts [ WriterOptions -> [Block] -> Block
toTableOfContents WriterOptions
opts [Block]
blocks ]
else Text -> m Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
forall a. Monoid a => a
mempty
let ([Block]
blocks', [[Block]]
notes) = State [[Block]] [Block] -> [[Block]] -> ([Block], [[Block]])
forall s a. State s a -> s -> (a, s)
runState ((Inline -> StateT [[Block]] Identity Inline)
-> [Block] -> State [[Block]] [Block]
forall a b (m :: * -> *).
(Walkable a b, Monad m, Applicative m, Functor m) =>
(a -> m a) -> b -> m b
walkM Inline -> StateT [[Block]] Identity Inline
processNotes [Block]
blocks) []
notes' :: [Block]
notes' = [ListAttributes -> [[Block]] -> Block
OrderedList (Int
1, ListNumberStyle
Decimal, ListNumberDelim
Period) ([[Block]] -> Block) -> [[Block]] -> Block
forall a b. (a -> b) -> a -> b
$ [[Block]] -> [[Block]]
forall a. [a] -> [a]
reverse [[Block]]
notes | Bool -> Bool
not ([[Block]] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Block]]
notes)]
Text
main <- WriterOptions -> [Block] -> m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> m Text
blocksToCommonMark WriterOptions
opts ([Block]
blocks' [Block] -> [Block] -> [Block]
forall a. [a] -> [a] -> [a]
++ [Block]
notes')
Context Text
metadata <- WriterOptions
-> ([Block] -> m (Doc Text))
-> ([Inline] -> m (Doc Text))
-> Meta
-> m (Context Text)
forall (m :: * -> *) a.
(Monad m, TemplateTarget a) =>
WriterOptions
-> ([Block] -> m (Doc a))
-> ([Inline] -> m (Doc a))
-> Meta
-> m (Context a)
metaToContext WriterOptions
opts
((Text -> Doc Text) -> m Text -> m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (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.stripEnd) (m Text -> m (Doc Text))
-> ([Block] -> m Text) -> [Block] -> m (Doc Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterOptions -> [Block] -> m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> m Text
blocksToCommonMark WriterOptions
opts)
((Text -> Doc Text) -> m Text -> m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (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.stripEnd) (m Text -> m (Doc Text))
-> ([Inline] -> m Text) -> [Inline] -> m (Doc Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterOptions -> [Inline] -> m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> m Text
inlinesToCommonMark WriterOptions
opts)
Meta
meta
let context :: Context Text
context =
Text -> Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"toc" Text
toc
(Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"table-of-contents" Text
toc
(Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"body" Text
main Context Text
metadata
Text -> m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> m Text) -> Text -> m Text
forall a b. (a -> b) -> a -> b
$
case WriterOptions -> Maybe (Template Text)
writerTemplate WriterOptions
opts of
Maybe (Template Text)
Nothing -> Text
main
Just Template Text
tpl -> 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
$ Template Text -> Context Text -> Doc Text
forall a b.
(TemplateTarget a, ToContext a b) =>
Template a -> b -> Doc a
renderTemplate Template Text
tpl Context Text
context
softBreakToSpace :: Inline -> Inline
softBreakToSpace :: Inline -> Inline
softBreakToSpace Inline
SoftBreak = Inline
Space
softBreakToSpace Inline
x = Inline
x
processNotes :: Inline -> State [[Block]] Inline
processNotes :: Inline -> StateT [[Block]] Identity Inline
processNotes (Note [Block]
bs) = do
([[Block]] -> [[Block]]) -> StateT [[Block]] Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ([Block]
bs [Block] -> [[Block]] -> [[Block]]
forall a. a -> [a] -> [a]
:)
[[Block]]
notes <- StateT [[Block]] Identity [[Block]]
forall s (m :: * -> *). MonadState s m => m s
get
Inline -> StateT [[Block]] Identity Inline
forall (m :: * -> *) a. Monad m => a -> m a
return (Inline -> StateT [[Block]] Identity Inline)
-> Inline -> StateT [[Block]] Identity Inline
forall a b. (a -> b) -> a -> b
$ Text -> Inline
Str (Text -> Inline) -> Text -> Inline
forall a b. (a -> b) -> a -> b
$ Text
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow ([[Block]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Block]]
notes) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]"
processNotes Inline
x = Inline -> StateT [[Block]] Identity Inline
forall (m :: * -> *) a. Monad m => a -> m a
return Inline
x
node :: NodeType -> [Node] -> Node
node :: NodeType -> [Node] -> Node
node = Maybe PosInfo -> NodeType -> [Node] -> Node
Node Maybe PosInfo
forall a. Maybe a
Nothing
blocksToCommonMark :: PandocMonad m => WriterOptions -> [Block] -> m Text
blocksToCommonMark :: WriterOptions -> [Block] -> m Text
blocksToCommonMark WriterOptions
opts [Block]
bs = do
let cmarkOpts :: [CMarkOption]
cmarkOpts = [CMarkOption
optHardBreaks | Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_hard_line_breaks WriterOptions
opts]
colwidth :: Maybe Int
colwidth = if WriterOptions -> WrapOption
writerWrapText WriterOptions
opts WrapOption -> WrapOption -> Bool
forall a. Eq a => a -> a -> Bool
== WrapOption
WrapAuto
then Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ WriterOptions -> Int
writerColumns WriterOptions
opts
else Maybe Int
forall a. Maybe a
Nothing
[Node]
nodes <- WriterOptions -> [Block] -> m [Node]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> m [Node]
blocksToNodes WriterOptions
opts [Block]
bs
Text -> m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> m Text) -> Text -> m Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.stripEnd (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$
[CMarkOption] -> Maybe Int -> Node -> Text
nodeToCommonmark [CMarkOption]
cmarkOpts Maybe Int
colwidth (Node -> Text) -> Node -> Text
forall a b. (a -> b) -> a -> b
$
NodeType -> [Node] -> Node
node NodeType
DOCUMENT [Node]
nodes
inlinesToCommonMark :: PandocMonad m => WriterOptions -> [Inline] -> m Text
inlinesToCommonMark :: WriterOptions -> [Inline] -> m Text
inlinesToCommonMark WriterOptions
opts [Inline]
ils = Text -> m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> m Text) -> Text -> m Text
forall a b. (a -> b) -> a -> b
$
[CMarkOption] -> Maybe Int -> Node -> Text
nodeToCommonmark [CMarkOption]
cmarkOpts Maybe Int
colwidth (Node -> Text) -> Node -> Text
forall a b. (a -> b) -> a -> b
$
NodeType -> [Node] -> Node
node NodeType
PARAGRAPH (WriterOptions -> [Inline] -> [Node]
inlinesToNodes WriterOptions
opts [Inline]
ils)
where cmarkOpts :: [CMarkOption]
cmarkOpts = [CMarkOption
optHardBreaks | Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_hard_line_breaks WriterOptions
opts]
colwidth :: Maybe Int
colwidth = if WriterOptions -> WrapOption
writerWrapText WriterOptions
opts WrapOption -> WrapOption -> Bool
forall a. Eq a => a -> a -> Bool
== WrapOption
WrapAuto
then Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ WriterOptions -> Int
writerColumns WriterOptions
opts
else Maybe Int
forall a. Maybe a
Nothing
blocksToNodes :: PandocMonad m => WriterOptions -> [Block] -> m [Node]
blocksToNodes :: WriterOptions -> [Block] -> m [Node]
blocksToNodes WriterOptions
opts = (Block -> [Node] -> m [Node]) -> [Node] -> [Block] -> m [Node]
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> b -> m b) -> b -> t a -> m b
foldrM (WriterOptions -> Block -> [Node] -> m [Node]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> [Node] -> m [Node]
blockToNodes WriterOptions
opts) []
blockToNodes :: PandocMonad m => WriterOptions -> Block -> [Node] -> m [Node]
blockToNodes :: WriterOptions -> Block -> [Node] -> m [Node]
blockToNodes WriterOptions
opts (Plain [Inline]
xs) [Node]
ns =
[Node] -> m [Node]
forall (m :: * -> *) a. Monad m => a -> m a
return (NodeType -> [Node] -> Node
node NodeType
PARAGRAPH (WriterOptions -> [Inline] -> [Node]
inlinesToNodes WriterOptions
opts [Inline]
xs) Node -> [Node] -> [Node]
forall a. a -> [a] -> [a]
: [Node]
ns)
blockToNodes WriterOptions
opts (Para [Inline]
xs) [Node]
ns =
[Node] -> m [Node]
forall (m :: * -> *) a. Monad m => a -> m a
return (NodeType -> [Node] -> Node
node NodeType
PARAGRAPH (WriterOptions -> [Inline] -> [Node]
inlinesToNodes WriterOptions
opts [Inline]
xs) Node -> [Node] -> [Node]
forall a. a -> [a] -> [a]
: [Node]
ns)
blockToNodes WriterOptions
opts (LineBlock [[Inline]]
lns) [Node]
ns = WriterOptions -> Block -> [Node] -> m [Node]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> [Node] -> m [Node]
blockToNodes WriterOptions
opts ([[Inline]] -> Block
linesToPara [[Inline]]
lns) [Node]
ns
blockToNodes WriterOptions
_ (CodeBlock (Text
_,[Text]
classes,[(Text, Text)]
_) Text
xs) [Node]
ns = [Node] -> m [Node]
forall (m :: * -> *) a. Monad m => a -> m a
return
(NodeType -> [Node] -> Node
node (Text -> Text -> NodeType
CODE_BLOCK ([Text] -> Text
T.unwords [Text]
classes) Text
xs) [] Node -> [Node] -> [Node]
forall a. a -> [a] -> [a]
: [Node]
ns)
blockToNodes WriterOptions
opts (RawBlock (Format Text
f) Text
xs) [Node]
ns
| Text
f Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"html" Bool -> Bool -> Bool
&& Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_raw_html WriterOptions
opts
= [Node] -> m [Node]
forall (m :: * -> *) a. Monad m => a -> m a
return (NodeType -> [Node] -> Node
node (Text -> NodeType
HTML_BLOCK Text
xs) [] Node -> [Node] -> [Node]
forall a. a -> [a] -> [a]
: [Node]
ns)
| (Text
f Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"latex" Bool -> Bool -> Bool
|| Text
f Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"tex") Bool -> Bool -> Bool
&& Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_raw_tex WriterOptions
opts
= [Node] -> m [Node]
forall (m :: * -> *) a. Monad m => a -> m a
return (NodeType -> [Node] -> Node
node (Text -> Text -> NodeType
CUSTOM_BLOCK Text
xs Text
T.empty) [] Node -> [Node] -> [Node]
forall a. a -> [a] -> [a]
: [Node]
ns)
| Text
f Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"markdown"
= [Node] -> m [Node]
forall (m :: * -> *) a. Monad m => a -> m a
return (NodeType -> [Node] -> Node
node (Text -> Text -> NodeType
CUSTOM_BLOCK Text
xs Text
T.empty) [] Node -> [Node] -> [Node]
forall a. a -> [a] -> [a]
: [Node]
ns)
| Bool
otherwise = [Node] -> m [Node]
forall (m :: * -> *) a. Monad m => a -> m a
return [Node]
ns
blockToNodes WriterOptions
opts (BlockQuote [Block]
bs) [Node]
ns = do
[Node]
nodes <- WriterOptions -> [Block] -> m [Node]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> m [Node]
blocksToNodes WriterOptions
opts [Block]
bs
[Node] -> m [Node]
forall (m :: * -> *) a. Monad m => a -> m a
return (NodeType -> [Node] -> Node
node NodeType
BLOCK_QUOTE [Node]
nodes Node -> [Node] -> [Node]
forall a. a -> [a] -> [a]
: [Node]
ns)
blockToNodes WriterOptions
opts (BulletList [[Block]]
items) [Node]
ns = do
let exts :: Extensions
exts = WriterOptions -> Extensions
writerExtensions WriterOptions
opts
[[Node]]
nodes <- ([Block] -> m [Node]) -> [[Block]] -> m [[Node]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (WriterOptions -> [Block] -> m [Node]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> m [Node]
blocksToNodes WriterOptions
opts ([Block] -> m [Node])
-> ([Block] -> [Block]) -> [Block] -> m [Node]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Extensions -> [Block] -> [Block]
taskListItemToAscii Extensions
exts) [[Block]]
items
[Node] -> m [Node]
forall (m :: * -> *) a. Monad m => a -> m a
return (NodeType -> [Node] -> Node
node (ListAttributes -> NodeType
LIST ListAttributes :: ListType -> Bool -> Int -> DelimType -> ListAttributes
ListAttributes{
listType :: ListType
listType = ListType
BULLET_LIST,
listDelim :: DelimType
listDelim = DelimType
PERIOD_DELIM,
listTight :: Bool
listTight = [[Block]] -> Bool
isTightList [[Block]]
items,
listStart :: Int
listStart = Int
1 }) (([Node] -> Node) -> [[Node]] -> [Node]
forall a b. (a -> b) -> [a] -> [b]
map (NodeType -> [Node] -> Node
node NodeType
ITEM) [[Node]]
nodes) Node -> [Node] -> [Node]
forall a. a -> [a] -> [a]
: [Node]
ns)
blockToNodes WriterOptions
opts (OrderedList (Int
start, ListNumberStyle
_sty, ListNumberDelim
delim) [[Block]]
items) [Node]
ns = do
let exts :: Extensions
exts = WriterOptions -> Extensions
writerExtensions WriterOptions
opts
[[Node]]
nodes <- ([Block] -> m [Node]) -> [[Block]] -> m [[Node]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (WriterOptions -> [Block] -> m [Node]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> m [Node]
blocksToNodes WriterOptions
opts ([Block] -> m [Node])
-> ([Block] -> [Block]) -> [Block] -> m [Node]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Extensions -> [Block] -> [Block]
taskListItemToAscii Extensions
exts) [[Block]]
items
[Node] -> m [Node]
forall (m :: * -> *) a. Monad m => a -> m a
return (NodeType -> [Node] -> Node
node (ListAttributes -> NodeType
LIST ListAttributes :: ListType -> Bool -> Int -> DelimType -> ListAttributes
ListAttributes{
listType :: ListType
listType = ListType
ORDERED_LIST,
listDelim :: DelimType
listDelim = case ListNumberDelim
delim of
ListNumberDelim
OneParen -> DelimType
PAREN_DELIM
ListNumberDelim
TwoParens -> DelimType
PAREN_DELIM
ListNumberDelim
_ -> DelimType
PERIOD_DELIM,
listTight :: Bool
listTight = [[Block]] -> Bool
isTightList [[Block]]
items,
listStart :: Int
listStart = Int
start }) (([Node] -> Node) -> [[Node]] -> [Node]
forall a b. (a -> b) -> [a] -> [b]
map (NodeType -> [Node] -> Node
node NodeType
ITEM) [[Node]]
nodes) Node -> [Node] -> [Node]
forall a. a -> [a] -> [a]
: [Node]
ns)
blockToNodes WriterOptions
_ Block
HorizontalRule [Node]
ns = [Node] -> m [Node]
forall (m :: * -> *) a. Monad m => a -> m a
return (NodeType -> [Node] -> Node
node NodeType
THEMATIC_BREAK [] Node -> [Node] -> [Node]
forall a. a -> [a] -> [a]
: [Node]
ns)
blockToNodes WriterOptions
opts (Header Int
lev (Text, [Text], [(Text, Text)])
_ [Inline]
ils) [Node]
ns =
[Node] -> m [Node]
forall (m :: * -> *) a. Monad m => a -> m a
return (NodeType -> [Node] -> Node
node (Int -> NodeType
HEADING Int
lev) (WriterOptions -> [Inline] -> [Node]
inlinesToNodes WriterOptions
opts [Inline]
ils) Node -> [Node] -> [Node]
forall a. a -> [a] -> [a]
: [Node]
ns)
blockToNodes WriterOptions
opts (Div (Text, [Text], [(Text, Text)])
attr [Block]
bs) [Node]
ns = do
[Node]
nodes <- WriterOptions -> [Block] -> m [Node]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> m [Node]
blocksToNodes WriterOptions
opts [Block]
bs
let op :: Text
op = WriterOptions
-> Bool -> Bool -> Text -> (Text, [Text], [(Text, Text)]) -> Text
tagWithAttributes WriterOptions
opts Bool
True Bool
False Text
"div" (Text, [Text], [(Text, Text)])
attr
if Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_raw_html WriterOptions
opts
then [Node] -> m [Node]
forall (m :: * -> *) a. Monad m => a -> m a
return (NodeType -> [Node] -> Node
node (Text -> NodeType
HTML_BLOCK Text
op) [] Node -> [Node] -> [Node]
forall a. a -> [a] -> [a]
: [Node]
nodes [Node] -> [Node] -> [Node]
forall a. [a] -> [a] -> [a]
++
[NodeType -> [Node] -> Node
node (Text -> NodeType
HTML_BLOCK (String -> Text
T.pack String
"</div>")) []] [Node] -> [Node] -> [Node]
forall a. [a] -> [a] -> [a]
++ [Node]
ns)
else [Node] -> m [Node]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Node]
nodes [Node] -> [Node] -> [Node]
forall a. [a] -> [a] -> [a]
++ [Node]
ns)
blockToNodes WriterOptions
opts (DefinitionList [([Inline], [[Block]])]
items) [Node]
ns =
WriterOptions -> Block -> [Node] -> m [Node]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> [Node] -> m [Node]
blockToNodes WriterOptions
opts ([[Block]] -> Block
BulletList [[Block]]
items') [Node]
ns
where items' :: [[Block]]
items' = (([Inline], [[Block]]) -> [Block])
-> [([Inline], [[Block]])] -> [[Block]]
forall a b. (a -> b) -> [a] -> [b]
map ([Inline], [[Block]]) -> [Block]
dlToBullet [([Inline], [[Block]])]
items
dlToBullet :: ([Inline], [[Block]]) -> [Block]
dlToBullet ([Inline]
term, (Para [Inline]
xs : [Block]
ys) : [[Block]]
zs) =
[Inline] -> Block
Para ([Inline]
term [Inline] -> [Inline] -> [Inline]
forall a. [a] -> [a] -> [a]
++ [Inline
LineBreak] [Inline] -> [Inline] -> [Inline]
forall a. [a] -> [a] -> [a]
++ [Inline]
xs) Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
ys [Block] -> [Block] -> [Block]
forall a. [a] -> [a] -> [a]
++ [[Block]] -> [Block]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Block]]
zs
dlToBullet ([Inline]
term, (Plain [Inline]
xs : [Block]
ys) : [[Block]]
zs) =
[Inline] -> Block
Plain ([Inline]
term [Inline] -> [Inline] -> [Inline]
forall a. [a] -> [a] -> [a]
++ [Inline
LineBreak] [Inline] -> [Inline] -> [Inline]
forall a. [a] -> [a] -> [a]
++ [Inline]
xs) Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
ys [Block] -> [Block] -> [Block]
forall a. [a] -> [a] -> [a]
++ [[Block]] -> [Block]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Block]]
zs
dlToBullet ([Inline]
term, [[Block]]
xs) =
[Inline] -> Block
Para [Inline]
term Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [[Block]] -> [Block]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Block]]
xs
blockToNodes WriterOptions
opts t :: Block
t@(Table [Inline]
capt [Alignment]
aligns [Double]
_widths [[Block]]
headers [[[Block]]]
rows) [Node]
ns =
if Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_pipe_tables WriterOptions
opts Bool -> Bool -> Bool
&& [[[Block]]] -> Bool
onlySimpleTableCells ([[Block]]
headers[[Block]] -> [[[Block]]] -> [[[Block]]]
forall a. a -> [a] -> [a]
:[[[Block]]]
rows)
then do
let capt' :: Node
capt' = NodeType -> [Node] -> Node
node NodeType
PARAGRAPH (WriterOptions -> [Inline] -> [Node]
inlinesToNodes WriterOptions
opts [Inline]
capt)
let fixPipe :: Inline -> Inline
fixPipe (Code (Text, [Text], [(Text, Text)])
attr Text
xs) =
(Text, [Text], [(Text, Text)]) -> Text -> Inline
Code (Text, [Text], [(Text, Text)])
attr (Text -> Text -> Text -> Text
T.replace Text
"|" Text
"\\|" Text
xs)
fixPipe (RawInline Format
format Text
xs) =
Format -> Text -> Inline
RawInline Format
format (Text -> Text -> Text -> Text
T.replace Text
"|" Text
"\\|" Text
xs)
fixPipe Inline
x = Inline
x
let toCell :: [Block] -> Text
toCell [Plain [Inline]
ils] = Text -> Text
T.strip
(Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [CMarkOption] -> Maybe Int -> Node -> Text
nodeToCommonmark [] Maybe Int
forall a. Maybe a
Nothing
(Node -> Text) -> Node -> Text
forall a b. (a -> b) -> a -> b
$ NodeType -> [Node] -> Node
node (Text -> Text -> NodeType
CUSTOM_INLINE Text
forall a. Monoid a => a
mempty Text
forall a. Monoid a => a
mempty)
([Node] -> Node) -> [Node] -> Node
forall a b. (a -> b) -> a -> b
$ WriterOptions -> [Inline] -> [Node]
inlinesToNodes WriterOptions
opts
([Inline] -> [Node]) -> [Inline] -> [Node]
forall a b. (a -> b) -> a -> b
$ (Inline -> Inline) -> [Inline] -> [Inline]
forall a b. Walkable a b => (a -> a) -> b -> b
walk (Inline -> Inline
fixPipe (Inline -> Inline) -> (Inline -> Inline) -> Inline -> Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inline -> Inline
softBreakToSpace) [Inline]
ils
toCell [Para [Inline]
ils] = Text -> Text
T.strip
(Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [CMarkOption] -> Maybe Int -> Node -> Text
nodeToCommonmark [] Maybe Int
forall a. Maybe a
Nothing
(Node -> Text) -> Node -> Text
forall a b. (a -> b) -> a -> b
$ NodeType -> [Node] -> Node
node (Text -> Text -> NodeType
CUSTOM_INLINE Text
forall a. Monoid a => a
mempty Text
forall a. Monoid a => a
mempty)
([Node] -> Node) -> [Node] -> Node
forall a b. (a -> b) -> a -> b
$ WriterOptions -> [Inline] -> [Node]
inlinesToNodes WriterOptions
opts
([Inline] -> [Node]) -> [Inline] -> [Node]
forall a b. (a -> b) -> a -> b
$ (Inline -> Inline) -> [Inline] -> [Inline]
forall a b. Walkable a b => (a -> a) -> b -> b
walk (Inline -> Inline
fixPipe (Inline -> Inline) -> (Inline -> Inline) -> Inline -> Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inline -> Inline
softBreakToSpace) [Inline]
ils
toCell [] = Text
""
toCell [Block]
xs = String -> Text
forall a. HasCallStack => String -> a
error (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"toCell encountered " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Block] -> String
forall a. Show a => a -> String
show [Block]
xs
let separator :: Text
separator = Text
" | "
let starter :: Text
starter = Text
"| "
let ender :: Text
ender = Text
" |"
let rawheaders :: [Text]
rawheaders = ([Block] -> Text) -> [[Block]] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map [Block] -> Text
toCell [[Block]]
headers
let rawrows :: [[Text]]
rawrows = ([[Block]] -> [Text]) -> [[[Block]]] -> [[Text]]
forall a b. (a -> b) -> [a] -> [b]
map (([Block] -> Text) -> [[Block]] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map [Block] -> Text
toCell) [[[Block]]]
rows
let maximum' :: [p] -> p
maximum' [] = p
0
maximum' [p]
xs = [p] -> p
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [p]
xs
let colwidths :: [Int]
colwidths = ([Text] -> Int) -> [[Text]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ([Int] -> Int
forall p. (Num p, Ord p) => [p] -> p
maximum' ([Int] -> Int) -> ([Text] -> [Int]) -> [Text] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Int) -> [Text] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Int
T.length) ([[Text]] -> [Int]) -> [[Text]] -> [Int]
forall a b. (a -> b) -> a -> b
$
[[Text]] -> [[Text]]
forall a. [[a]] -> [[a]]
transpose ([Text]
rawheaders[Text] -> [[Text]] -> [[Text]]
forall a. a -> [a] -> [a]
:[[Text]]
rawrows)
let toHeaderLine :: Int -> Alignment -> Text
toHeaderLine Int
len Alignment
AlignDefault = Int -> Text -> Text
T.replicate Int
len Text
"-"
toHeaderLine Int
len Alignment
AlignLeft = Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Int -> Text -> Text
T.replicate (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int
1) Text
"-"
toHeaderLine Int
len Alignment
AlignRight =
Int -> Text -> Text
T.replicate (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int
1) Text
"-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":"
toHeaderLine Int
len Alignment
AlignCenter = Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Int -> Text -> Text
T.replicate (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2) Int
1) (String -> Text
T.pack String
"-") Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":"
let rawheaderlines :: [Text]
rawheaderlines = (Int -> Alignment -> Text) -> [Int] -> [Alignment] -> [Text]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> Alignment -> Text
toHeaderLine [Int]
colwidths [Alignment]
aligns
let headerlines :: Text
headerlines = Text
starter Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
separator [Text]
rawheaderlines Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text
ender
let padContent :: (Alignment, Int) -> Text -> Text
padContent (Alignment
align, Int
w) Text
t' =
let padding :: Int
padding = Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Text -> Int
T.length Text
t'
halfpadding :: Int
halfpadding = Int
padding Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
in case Alignment
align of
Alignment
AlignRight -> Int -> Text -> Text
T.replicate Int
padding Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t'
Alignment
AlignCenter -> Int -> Text -> Text
T.replicate Int
halfpadding Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Int -> Text -> Text
T.replicate (Int
padding Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
halfpadding) Text
" "
Alignment
_ -> Text
t' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.replicate Int
padding Text
" "
let toRow :: [Text] -> Text
toRow [Text]
xs = Text
starter Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
separator
(((Alignment, Int) -> Text -> Text)
-> [(Alignment, Int)] -> [Text] -> [Text]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Alignment, Int) -> Text -> Text
padContent ([Alignment] -> [Int] -> [(Alignment, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Alignment]
aligns [Int]
colwidths) [Text]
xs) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text
ender
let table' :: Text
table' = [Text] -> Text
toRow [Text]
rawheaders Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
headerlines Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text -> [Text] -> Text
T.intercalate Text
"\n" (([Text] -> Text) -> [[Text]] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map [Text] -> Text
toRow [[Text]]
rawrows)
[Node] -> m [Node]
forall (m :: * -> *) a. Monad m => a -> m a
return (NodeType -> [Node] -> Node
node (Text -> Text -> NodeType
CUSTOM_BLOCK Text
table' Text
forall a. Monoid a => a
mempty) [] Node -> [Node] -> [Node]
forall a. a -> [a] -> [a]
:
if [Inline] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
capt
then [Node]
ns
else Node
capt' Node -> [Node] -> [Node]
forall a. a -> [a] -> [a]
: [Node]
ns)
else do
Text
s <- WriterOptions -> Pandoc -> m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeHtml5String WriterOptions
forall a. Default a => a
def (Pandoc -> m Text) -> Pandoc -> m Text
forall a b. (a -> b) -> a -> b
$! Meta -> [Block] -> Pandoc
Pandoc Meta
nullMeta [Block
t]
[Node] -> m [Node]
forall (m :: * -> *) a. Monad m => a -> m a
return (NodeType -> [Node] -> Node
node (Text -> NodeType
HTML_BLOCK Text
s) [] Node -> [Node] -> [Node]
forall a. a -> [a] -> [a]
: [Node]
ns)
blockToNodes WriterOptions
_ Block
Null [Node]
ns = [Node] -> m [Node]
forall (m :: * -> *) a. Monad m => a -> m a
return [Node]
ns
inlinesToNodes :: WriterOptions -> [Inline] -> [Node]
inlinesToNodes :: WriterOptions -> [Inline] -> [Node]
inlinesToNodes WriterOptions
opts = (Inline -> [Node] -> [Node]) -> [Node] -> [Inline] -> [Node]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (WriterOptions -> Inline -> [Node] -> [Node]
inlineToNodes WriterOptions
opts) []
inlineToNodes :: WriterOptions -> Inline -> [Node] -> [Node]
inlineToNodes :: WriterOptions -> Inline -> [Node] -> [Node]
inlineToNodes WriterOptions
opts (Str Text
s) = WriterOptions -> Text -> [Node] -> [Node]
stringToNodes WriterOptions
opts Text
s'
where s' :: Text
s' = if Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_smart WriterOptions
opts
then WriterOptions -> Text -> Text
unsmartify WriterOptions
opts Text
s
else Text
s
inlineToNodes WriterOptions
_ Inline
Space = (NodeType -> [Node] -> Node
node (Text -> NodeType
TEXT (String -> Text
T.pack String
" ")) [] Node -> [Node] -> [Node]
forall a. a -> [a] -> [a]
:)
inlineToNodes WriterOptions
_ Inline
LineBreak = (NodeType -> [Node] -> Node
node NodeType
LINEBREAK [] Node -> [Node] -> [Node]
forall a. a -> [a] -> [a]
:)
inlineToNodes WriterOptions
opts Inline
SoftBreak
| Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_hard_line_breaks WriterOptions
opts = (NodeType -> [Node] -> Node
node (Text -> NodeType
TEXT Text
" ") [] Node -> [Node] -> [Node]
forall a. a -> [a] -> [a]
:)
| WriterOptions -> WrapOption
writerWrapText WriterOptions
opts WrapOption -> WrapOption -> Bool
forall a. Eq a => a -> a -> Bool
== WrapOption
WrapNone = (NodeType -> [Node] -> Node
node (Text -> NodeType
TEXT Text
" ") [] Node -> [Node] -> [Node]
forall a. a -> [a] -> [a]
:)
| Bool
otherwise = (NodeType -> [Node] -> Node
node NodeType
SOFTBREAK [] Node -> [Node] -> [Node]
forall a. a -> [a] -> [a]
:)
inlineToNodes WriterOptions
opts (Emph [Inline]
xs) = (NodeType -> [Node] -> Node
node NodeType
EMPH (WriterOptions -> [Inline] -> [Node]
inlinesToNodes WriterOptions
opts [Inline]
xs) Node -> [Node] -> [Node]
forall a. a -> [a] -> [a]
:)
inlineToNodes WriterOptions
opts (Strong [Inline]
xs) = (NodeType -> [Node] -> Node
node NodeType
STRONG (WriterOptions -> [Inline] -> [Node]
inlinesToNodes WriterOptions
opts [Inline]
xs) Node -> [Node] -> [Node]
forall a. a -> [a] -> [a]
:)
inlineToNodes WriterOptions
opts (Strikeout [Inline]
xs)
| Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_strikeout WriterOptions
opts = (NodeType -> [Node] -> Node
node (Text -> Text -> NodeType
CUSTOM_INLINE Text
"~~" Text
"~~") (WriterOptions -> [Inline] -> [Node]
inlinesToNodes WriterOptions
opts [Inline]
xs) Node -> [Node] -> [Node]
forall a. a -> [a] -> [a]
:)
| Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_raw_html WriterOptions
opts = ((NodeType -> [Node] -> Node
node (Text -> NodeType
HTML_INLINE (String -> Text
T.pack String
"<s>")) [] Node -> [Node] -> [Node]
forall a. a -> [a] -> [a]
: WriterOptions -> [Inline] -> [Node]
inlinesToNodes WriterOptions
opts [Inline]
xs [Node] -> [Node] -> [Node]
forall a. [a] -> [a] -> [a]
++
[NodeType -> [Node] -> Node
node (Text -> NodeType
HTML_INLINE (String -> Text
T.pack String
"</s>")) []]) [Node] -> [Node] -> [Node]
forall a. [a] -> [a] -> [a]
++ )
| Bool
otherwise = (WriterOptions -> [Inline] -> [Node]
inlinesToNodes WriterOptions
opts [Inline]
xs [Node] -> [Node] -> [Node]
forall a. [a] -> [a] -> [a]
++)
inlineToNodes WriterOptions
opts (Superscript [Inline]
xs) =
if Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_raw_html WriterOptions
opts
then ((NodeType -> [Node] -> Node
node (Text -> NodeType
HTML_INLINE (String -> Text
T.pack String
"<sup>")) [] Node -> [Node] -> [Node]
forall a. a -> [a] -> [a]
: WriterOptions -> [Inline] -> [Node]
inlinesToNodes WriterOptions
opts [Inline]
xs [Node] -> [Node] -> [Node]
forall a. [a] -> [a] -> [a]
++
[NodeType -> [Node] -> Node
node (Text -> NodeType
HTML_INLINE (String -> Text
T.pack String
"</sup>")) []]) [Node] -> [Node] -> [Node]
forall a. [a] -> [a] -> [a]
++ )
else case (Inline -> Maybe Inline) -> [Inline] -> Maybe [Inline]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Inline -> Maybe Inline
toSuperscriptInline [Inline]
xs of
Just [Inline]
xs' | Bool -> Bool
not (WriterOptions -> Bool
writerPreferAscii WriterOptions
opts)
-> (WriterOptions -> [Inline] -> [Node]
inlinesToNodes WriterOptions
opts [Inline]
xs' [Node] -> [Node] -> [Node]
forall a. [a] -> [a] -> [a]
++)
Maybe [Inline]
_ ->
((NodeType -> [Node] -> Node
node (Text -> NodeType
TEXT (String -> Text
T.pack String
"^(")) [] Node -> [Node] -> [Node]
forall a. a -> [a] -> [a]
: WriterOptions -> [Inline] -> [Node]
inlinesToNodes WriterOptions
opts [Inline]
xs [Node] -> [Node] -> [Node]
forall a. [a] -> [a] -> [a]
++
[NodeType -> [Node] -> Node
node (Text -> NodeType
TEXT (String -> Text
T.pack String
")")) []]) [Node] -> [Node] -> [Node]
forall a. [a] -> [a] -> [a]
++ )
inlineToNodes WriterOptions
opts (Subscript [Inline]
xs) =
if Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_raw_html WriterOptions
opts
then ((NodeType -> [Node] -> Node
node (Text -> NodeType
HTML_INLINE (String -> Text
T.pack String
"<sub>")) [] Node -> [Node] -> [Node]
forall a. a -> [a] -> [a]
: WriterOptions -> [Inline] -> [Node]
inlinesToNodes WriterOptions
opts [Inline]
xs [Node] -> [Node] -> [Node]
forall a. [a] -> [a] -> [a]
++
[NodeType -> [Node] -> Node
node (Text -> NodeType
HTML_INLINE (String -> Text
T.pack String
"</sub>")) []]) [Node] -> [Node] -> [Node]
forall a. [a] -> [a] -> [a]
++ )
else case (Inline -> Maybe Inline) -> [Inline] -> Maybe [Inline]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Inline -> Maybe Inline
toSubscriptInline [Inline]
xs of
Just [Inline]
xs' | Bool -> Bool
not (WriterOptions -> Bool
writerPreferAscii WriterOptions
opts)
-> (WriterOptions -> [Inline] -> [Node]
inlinesToNodes WriterOptions
opts [Inline]
xs' [Node] -> [Node] -> [Node]
forall a. [a] -> [a] -> [a]
++)
Maybe [Inline]
_ ->
((NodeType -> [Node] -> Node
node (Text -> NodeType
TEXT (String -> Text
T.pack String
"_(")) [] Node -> [Node] -> [Node]
forall a. a -> [a] -> [a]
: WriterOptions -> [Inline] -> [Node]
inlinesToNodes WriterOptions
opts [Inline]
xs [Node] -> [Node] -> [Node]
forall a. [a] -> [a] -> [a]
++
[NodeType -> [Node] -> Node
node (Text -> NodeType
TEXT (String -> Text
T.pack String
")")) []]) [Node] -> [Node] -> [Node]
forall a. [a] -> [a] -> [a]
++ )
inlineToNodes WriterOptions
opts (SmallCaps [Inline]
xs) =
if Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_raw_html WriterOptions
opts
then ((NodeType -> [Node] -> Node
node (Text -> NodeType
HTML_INLINE (String -> Text
T.pack String
"<span class=\"smallcaps\">")) []
Node -> [Node] -> [Node]
forall a. a -> [a] -> [a]
: WriterOptions -> [Inline] -> [Node]
inlinesToNodes WriterOptions
opts [Inline]
xs [Node] -> [Node] -> [Node]
forall a. [a] -> [a] -> [a]
++
[NodeType -> [Node] -> Node
node (Text -> NodeType
HTML_INLINE (String -> Text
T.pack String
"</span>")) []]) [Node] -> [Node] -> [Node]
forall a. [a] -> [a] -> [a]
++ )
else (WriterOptions -> [Inline] -> [Node]
inlinesToNodes WriterOptions
opts ([Inline] -> [Inline]
forall a. Walkable Inline a => a -> a
capitalize [Inline]
xs) [Node] -> [Node] -> [Node]
forall a. [a] -> [a] -> [a]
++)
inlineToNodes WriterOptions
opts (Link (Text, [Text], [(Text, Text)])
_ [Inline]
ils (Text
url,Text
tit)) =
(NodeType -> [Node] -> Node
node (Text -> Text -> NodeType
LINK Text
url Text
tit) (WriterOptions -> [Inline] -> [Node]
inlinesToNodes WriterOptions
opts [Inline]
ils) Node -> [Node] -> [Node]
forall a. a -> [a] -> [a]
:)
inlineToNodes WriterOptions
opts (Image (Text, [Text], [(Text, Text)])
alt [Inline]
ils (Text
url,Text -> Text -> Maybe Text
T.stripPrefix Text
"fig:" -> Just Text
tit)) =
WriterOptions -> Inline -> [Node] -> [Node]
inlineToNodes WriterOptions
opts ((Text, [Text], [(Text, Text)])
-> [Inline] -> (Text, Text) -> Inline
Image (Text, [Text], [(Text, Text)])
alt [Inline]
ils (Text
url,Text
tit))
inlineToNodes WriterOptions
opts (Image (Text, [Text], [(Text, Text)])
_ [Inline]
ils (Text
url,Text
tit)) =
(NodeType -> [Node] -> Node
node (Text -> Text -> NodeType
IMAGE Text
url Text
tit) (WriterOptions -> [Inline] -> [Node]
inlinesToNodes WriterOptions
opts [Inline]
ils) Node -> [Node] -> [Node]
forall a. a -> [a] -> [a]
:)
inlineToNodes WriterOptions
opts (RawInline (Format Text
f) Text
xs)
| Text
f Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"html" Bool -> Bool -> Bool
&& Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_raw_html WriterOptions
opts
= (NodeType -> [Node] -> Node
node (Text -> NodeType
HTML_INLINE Text
xs) [] Node -> [Node] -> [Node]
forall a. a -> [a] -> [a]
:)
| (Text
f Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"latex" Bool -> Bool -> Bool
|| Text
f Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"tex") Bool -> Bool -> Bool
&& Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_raw_tex WriterOptions
opts
= (NodeType -> [Node] -> Node
node (Text -> Text -> NodeType
CUSTOM_INLINE Text
xs Text
T.empty) [] Node -> [Node] -> [Node]
forall a. a -> [a] -> [a]
:)
| Text
f Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"markdown"
= (NodeType -> [Node] -> Node
node (Text -> Text -> NodeType
CUSTOM_INLINE Text
xs Text
T.empty) [] Node -> [Node] -> [Node]
forall a. a -> [a] -> [a]
:)
| Bool
otherwise = [Node] -> [Node]
forall a. a -> a
id
inlineToNodes WriterOptions
opts (Quoted QuoteType
qt [Inline]
ils) =
((NodeType -> [Node] -> Node
node (Text -> NodeType
HTML_INLINE Text
start) [] Node -> [Node] -> [Node]
forall a. a -> [a] -> [a]
:
WriterOptions -> [Inline] -> [Node]
inlinesToNodes WriterOptions
opts [Inline]
ils [Node] -> [Node] -> [Node]
forall a. [a] -> [a] -> [a]
++ [NodeType -> [Node] -> Node
node (Text -> NodeType
HTML_INLINE Text
end) []]) [Node] -> [Node] -> [Node]
forall a. [a] -> [a] -> [a]
++)
where (Text
start, Text
end) = case QuoteType
qt of
QuoteType
SingleQuote
| Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_smart WriterOptions
opts -> (Text
"'",Text
"'")
| WriterOptions -> Bool
writerPreferAscii WriterOptions
opts ->
(Text
"‘", Text
"’")
| Bool
otherwise -> (Text
"‘", Text
"’")
QuoteType
DoubleQuote
| Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_smart WriterOptions
opts -> (Text
"\"", Text
"\"")
| WriterOptions -> Bool
writerPreferAscii WriterOptions
opts ->
(Text
"“", Text
"”")
| Bool
otherwise -> (Text
"“", Text
"”")
inlineToNodes WriterOptions
_ (Code (Text, [Text], [(Text, Text)])
_ Text
str) = (NodeType -> [Node] -> Node
node (Text -> NodeType
CODE Text
str) [] Node -> [Node] -> [Node]
forall a. a -> [a] -> [a]
:)
inlineToNodes WriterOptions
opts (Math MathType
mt Text
str) =
case WriterOptions -> HTMLMathMethod
writerHTMLMathMethod WriterOptions
opts of
WebTeX Text
url ->
let core :: [Node] -> [Node]
core = WriterOptions -> Inline -> [Node] -> [Node]
inlineToNodes WriterOptions
opts
((Text, [Text], [(Text, Text)])
-> [Inline] -> (Text, Text) -> Inline
Image (Text, [Text], [(Text, Text)])
nullAttr [Text -> Inline
Str Text
str] (Text
url Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (String -> String
urlEncode (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
str), Text
str))
sep :: [Node] -> [Node]
sep = if MathType
mt MathType -> MathType -> Bool
forall a. Eq a => a -> a -> Bool
== MathType
DisplayMath
then (NodeType -> [Node] -> Node
node NodeType
LINEBREAK [] Node -> [Node] -> [Node]
forall a. a -> [a] -> [a]
:)
else [Node] -> [Node]
forall a. a -> a
id
in ([Node] -> [Node]
sep ([Node] -> [Node]) -> ([Node] -> [Node]) -> [Node] -> [Node]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Node] -> [Node]
core ([Node] -> [Node]) -> ([Node] -> [Node]) -> [Node] -> [Node]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Node] -> [Node]
sep)
HTMLMathMethod
_ ->
case MathType
mt of
MathType
InlineMath ->
(NodeType -> [Node] -> Node
node (Text -> NodeType
HTML_INLINE (Text
"\\(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
str Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\\)")) [] Node -> [Node] -> [Node]
forall a. a -> [a] -> [a]
:)
MathType
DisplayMath ->
(NodeType -> [Node] -> Node
node (Text -> NodeType
HTML_INLINE (Text
"\\[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
str Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\\]")) [] Node -> [Node] -> [Node]
forall a. a -> [a] -> [a]
:)
inlineToNodes 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 ->
(NodeType -> [Node] -> Node
node (Text -> NodeType
TEXT (Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
emojiname Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":")) [] Node -> [Node] -> [Node]
forall a. a -> [a] -> [a]
:)
Maybe Text
_ -> (NodeType -> [Node] -> Node
node (Text -> NodeType
TEXT Text
s) [] Node -> [Node] -> [Node]
forall a. a -> [a] -> [a]
:)
inlineToNodes WriterOptions
opts (Span (Text, [Text], [(Text, Text)])
attr [Inline]
ils) =
let nodes :: [Node]
nodes = WriterOptions -> [Inline] -> [Node]
inlinesToNodes WriterOptions
opts [Inline]
ils
op :: Text
op = WriterOptions
-> Bool -> Bool -> Text -> (Text, [Text], [(Text, Text)]) -> Text
tagWithAttributes WriterOptions
opts Bool
True Bool
False Text
"span" (Text, [Text], [(Text, Text)])
attr
in if Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_raw_html WriterOptions
opts
then ((NodeType -> [Node] -> Node
node (Text -> NodeType
HTML_INLINE Text
op) [] Node -> [Node] -> [Node]
forall a. a -> [a] -> [a]
: [Node]
nodes [Node] -> [Node] -> [Node]
forall a. [a] -> [a] -> [a]
++
[NodeType -> [Node] -> Node
node (Text -> NodeType
HTML_INLINE (String -> Text
T.pack String
"</span>")) []]) [Node] -> [Node] -> [Node]
forall a. [a] -> [a] -> [a]
++)
else ([Node]
nodes [Node] -> [Node] -> [Node]
forall a. [a] -> [a] -> [a]
++)
inlineToNodes WriterOptions
opts (Cite [Citation]
_ [Inline]
ils) = (WriterOptions -> [Inline] -> [Node]
inlinesToNodes WriterOptions
opts [Inline]
ils [Node] -> [Node] -> [Node]
forall a. [a] -> [a] -> [a]
++)
inlineToNodes WriterOptions
_ (Note [Block]
_) = [Node] -> [Node]
forall a. a -> a
id
stringToNodes :: WriterOptions -> Text -> [Node] -> [Node]
stringToNodes :: WriterOptions -> Text -> [Node] -> [Node]
stringToNodes WriterOptions
opts Text
s
| Bool -> Bool
not (WriterOptions -> Bool
writerPreferAscii WriterOptions
opts) = (NodeType -> [Node] -> Node
node (Text -> NodeType
TEXT Text
s) [] Node -> [Node] -> [Node]
forall a. a -> [a] -> [a]
:)
| Bool
otherwise = Text -> [Node] -> [Node]
step Text
s
where
step :: Text -> [Node] -> [Node]
step Text
input =
let (Text
ascii, Text
rest) = (Char -> Bool) -> Text -> (Text, Text)
T.span Char -> Bool
isAscii Text
input
this :: Node
this = NodeType -> [Node] -> Node
node (Text -> NodeType
TEXT Text
ascii) []
nodes :: [Node] -> [Node]
nodes = case Text -> Maybe (Char, Text)
T.uncons Text
rest of
Maybe (Char, Text)
Nothing -> [Node] -> [Node]
forall a. a -> a
id
Just (Char
nonAscii, Text
rest') ->
let escaped :: Text
escaped = Text -> Text
toHtml5Entities (Char -> Text
T.singleton Char
nonAscii)
in (NodeType -> [Node] -> Node
node (Text -> NodeType
HTML_INLINE Text
escaped) [] Node -> [Node] -> [Node]
forall a. a -> [a] -> [a]
:) ([Node] -> [Node]) -> ([Node] -> [Node]) -> [Node] -> [Node]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Node] -> [Node]
step Text
rest'
in (Node
this Node -> [Node] -> [Node]
forall a. a -> [a] -> [a]
:) ([Node] -> [Node]) -> ([Node] -> [Node]) -> [Node] -> [Node]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Node] -> [Node]
nodes
toSubscriptInline :: Inline -> Maybe Inline
toSubscriptInline :: Inline -> Maybe Inline
toSubscriptInline Inline
Space = Inline -> Maybe Inline
forall a. a -> Maybe a
Just Inline
Space
toSubscriptInline (Span (Text, [Text], [(Text, Text)])
attr [Inline]
ils) = (Text, [Text], [(Text, Text)]) -> [Inline] -> Inline
Span (Text, [Text], [(Text, Text)])
attr ([Inline] -> Inline) -> Maybe [Inline] -> Maybe Inline
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Inline -> Maybe Inline) -> [Inline] -> Maybe [Inline]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Inline -> Maybe Inline
toSubscriptInline [Inline]
ils
toSubscriptInline (Str Text
s) = Text -> Inline
Str (Text -> Inline) -> (String -> Text) -> String -> Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Inline) -> Maybe String -> Maybe Inline
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Maybe Char) -> String -> Maybe String
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Char -> Maybe Char
toSubscript (Text -> String
T.unpack Text
s)
toSubscriptInline Inline
LineBreak = Inline -> Maybe Inline
forall a. a -> Maybe a
Just Inline
LineBreak
toSubscriptInline Inline
SoftBreak = Inline -> Maybe Inline
forall a. a -> Maybe a
Just Inline
SoftBreak
toSubscriptInline Inline
_ = Maybe Inline
forall a. Maybe a
Nothing
toSuperscriptInline :: Inline -> Maybe Inline
toSuperscriptInline :: Inline -> Maybe Inline
toSuperscriptInline Inline
Space = Inline -> Maybe Inline
forall a. a -> Maybe a
Just Inline
Space
toSuperscriptInline (Span (Text, [Text], [(Text, Text)])
attr [Inline]
ils) = (Text, [Text], [(Text, Text)]) -> [Inline] -> Inline
Span (Text, [Text], [(Text, Text)])
attr ([Inline] -> Inline) -> Maybe [Inline] -> Maybe Inline
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Inline -> Maybe Inline) -> [Inline] -> Maybe [Inline]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Inline -> Maybe Inline
toSuperscriptInline [Inline]
ils
toSuperscriptInline (Str Text
s) = Text -> Inline
Str (Text -> Inline) -> (String -> Text) -> String -> Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Inline) -> Maybe String -> Maybe Inline
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Maybe Char) -> String -> Maybe String
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Char -> Maybe Char
toSuperscript (Text -> String
T.unpack Text
s)
toSuperscriptInline Inline
LineBreak = Inline -> Maybe Inline
forall a. a -> Maybe a
Just Inline
LineBreak
toSuperscriptInline Inline
SoftBreak = Inline -> Maybe Inline
forall a. a -> Maybe a
Just Inline
SoftBreak
toSuperscriptInline Inline
_ = Maybe Inline
forall a. Maybe a
Nothing