{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns      #-}
{- |
   Module      : Text.Pandoc.Writers.CommonMark
   Copyright   : Copyright (C) 2015-2019 John MacFarlane
   License     : GNU GPL, version 2 or above

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

Conversion of 'Pandoc' documents to CommonMark.

CommonMark:  <http://commonmark.org>
-}
module Text.Pandoc.Writers.CommonMark (writeCommonMark) where

import Prelude
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)
import Text.Pandoc.Definition
import Text.Pandoc.Options
import Text.Pandoc.Shared (capitalize, isHeaderBlock, 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)

-- | Convert Pandoc to CommonMark.
writeCommonMark :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writeCommonMark :: WriterOptions -> Pandoc -> m Text
writeCommonMark opts :: WriterOptions
opts (Pandoc meta :: Meta
meta blocks :: [Block]
blocks) = do
  let headerBlocks :: [Block]
headerBlocks = (Block -> Bool) -> [Block] -> [Block]
forall a. (a -> Bool) -> [a] -> [a]
filter Block -> Bool
isHeaderBlock [Block]
blocks
  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]
headerBlocks ]
            else Text -> m Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
forall a. Monoid a => a
mempty
 
  let (blocks' :: [Block]
blocks', notes :: [[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' = if [[Block]] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Block]]
notes
               then []
               else [ListAttributes -> [[Block]] -> Block
OrderedList (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]
  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 =
          -- for backwards compatibility we populate toc
          -- with the contents of the toc, rather than a boolean:
          Text -> Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField "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 "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 "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
       Nothing  -> Text
main
       Just tpl :: 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 SoftBreak = Inline
Space
softBreakToSpace x :: Inline
x         = Inline
x

processNotes :: Inline -> State [[Block]] Inline
processNotes :: Inline -> StateT [[Block]] Identity Inline
processNotes (Note bs :: [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
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
<> "]"
processNotes x :: 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 opts :: WriterOptions
opts bs :: [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 opts :: WriterOptions
opts ils :: [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 opts :: 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 opts :: WriterOptions
opts (Plain xs :: [Inline]
xs) ns :: [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 opts :: WriterOptions
opts (Para xs :: [Inline]
xs) ns :: [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 opts :: WriterOptions
opts (LineBlock lns :: [[Inline]]
lns) ns :: [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 _ (CodeBlock (_,classes :: [Text]
classes,_) xs :: Text
xs) ns :: [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 opts :: WriterOptions
opts (RawBlock (Format f :: Text
f) xs :: Text
xs) ns :: [Node]
ns
  | Text
f Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== "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
== "latex" Bool -> Bool -> Bool
|| Text
f Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== "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
== "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 opts :: WriterOptions
opts (BlockQuote bs :: [Block]
bs) ns :: [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 opts :: WriterOptions
opts (BulletList items :: [[Block]]
items) ns :: [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 = 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 opts :: WriterOptions
opts (OrderedList (start :: Int
start, _sty :: ListNumberStyle
_sty, delim :: ListNumberDelim
delim) items :: [[Block]]
items) ns :: [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
                                 OneParen  -> DelimType
PAREN_DELIM
                                 TwoParens -> DelimType
PAREN_DELIM
                                 _         -> 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 _ HorizontalRule ns :: [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 opts :: WriterOptions
opts (Header lev :: Int
lev _ ils :: [Inline]
ils) ns :: [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 opts :: WriterOptions
opts (Div attr :: Attr
attr bs :: [Block]
bs) ns :: [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 -> Attr -> Text
tagWithAttributes WriterOptions
opts Bool
True Bool
False "div" Attr
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 "</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 opts :: WriterOptions
opts (DefinitionList items :: [([Inline], [[Block]])]
items) ns :: [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 (term :: [Inline]
term, (Para xs :: [Inline]
xs : ys :: [Block]
ys) : zs :: [[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 (term :: [Inline]
term, (Plain xs :: [Inline]
xs : ys :: [Block]
ys) : zs :: [[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 (term :: [Inline]
term, xs :: [[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 opts :: WriterOptions
opts t :: Block
t@(Table capt :: [Inline]
capt aligns :: [Alignment]
aligns _widths :: [Double]
_widths headers :: [[Block]]
headers rows :: [[[Block]]]
rows) ns :: [Node]
ns = do
  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
       -- We construct a table manually as a CUSTOM_BLOCK, for
       -- two reasons:  (1) cmark-gfm currently doesn't support
       -- rendering TABLE nodes; (2) we can align the column sides;
       -- (3) we can render the caption as a regular paragraph.
       let capt' :: Node
capt' = NodeType -> [Node] -> Node
node NodeType
PARAGRAPH (WriterOptions -> [Inline] -> [Node]
inlinesToNodes WriterOptions
opts [Inline]
capt)
       -- backslash | in code and raw:
       let fixPipe :: Inline -> Inline
fixPipe (Code attr :: Attr
attr xs :: Text
xs) =
             Attr -> Text -> Inline
Code Attr
attr (Text -> Text -> Text -> Text
T.replace "|" "\\|" Text
xs)
           fixPipe (RawInline format :: Format
format xs :: Text
xs) =
             Format -> Text -> Inline
RawInline Format
format (Text -> Text -> Text -> Text
T.replace "|" "\\|" Text
xs)
           fixPipe x :: Inline
x = Inline
x
       let toCell :: [Block] -> Text
toCell [Plain ils :: [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  ils :: [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 []          = ""
           toCell xs :: [Block]
xs          = String -> Text
forall a. HasCallStack => String -> a
error (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ "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 = " | "
       let starter :: Text
starter = "| "
       let ender :: Text
ender   = " |"
       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' [] = 0
           maximum' xs :: [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 len :: Int
len AlignDefault = Int -> Text -> Text
T.replicate Int
len "-"
           toHeaderLine len :: Int
len AlignLeft    = ":" 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
- 1) 1) "-"
           toHeaderLine len :: Int
len 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
- 1) 1) "-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ":"
           toHeaderLine len :: Int
len AlignCenter  = ":" 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
- 2) 1) (String -> Text
T.pack "-") Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ":"
       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 (align :: Alignment
align, w :: Int
w) t' :: 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` 2
             in  case Alignment
align of
                      AlignRight -> Int -> Text -> Text
T.replicate Int
padding " " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t'
                      AlignCenter -> Int -> Text -> Text
T.replicate Int
halfpadding " " 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
t' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.replicate Int
padding " "
       let toRow :: [Text] -> Text
toRow xs :: [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
<> "\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
headerlines Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                     Text -> [Text] -> Text
T.intercalate "\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 -- fall back to raw HTML
       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 _ Null ns :: [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 opts :: 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 opts :: WriterOptions
opts (Str s :: 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 _ Space   = (NodeType -> [Node] -> Node
node (Text -> NodeType
TEXT (String -> Text
T.pack " ")) [] Node -> [Node] -> [Node]
forall a. a -> [a] -> [a]
:)
inlineToNodes _ LineBreak = (NodeType -> [Node] -> Node
node NodeType
LINEBREAK [] Node -> [Node] -> [Node]
forall a. a -> [a] -> [a]
:)
inlineToNodes opts :: WriterOptions
opts 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 " ") [] 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 " ") [] 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 opts :: WriterOptions
opts (Emph xs :: [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 opts :: WriterOptions
opts (Strong xs :: [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 opts :: WriterOptions
opts (Strikeout xs :: [Inline]
xs) =
  if Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_strikeout WriterOptions
opts
     then (NodeType -> [Node] -> Node
node (Text -> Text -> NodeType
CUSTOM_INLINE "~~" "~~") (WriterOptions -> [Inline] -> [Node]
inlinesToNodes WriterOptions
opts [Inline]
xs) Node -> [Node] -> [Node]
forall a. a -> [a] -> [a]
:)
     else 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 "<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 "</s>")) []]) [Node] -> [Node] -> [Node]
forall a. [a] -> [a] -> [a]
++ )
            else (WriterOptions -> [Inline] -> [Node]
inlinesToNodes WriterOptions
opts [Inline]
xs [Node] -> [Node] -> [Node]
forall a. [a] -> [a] -> [a]
++)
inlineToNodes opts :: WriterOptions
opts (Superscript xs :: [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 "<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 "</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 xs' :: [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]
++)
      _ ->
        ((NodeType -> [Node] -> Node
node (Text -> NodeType
TEXT (String -> Text
T.pack "^(")) [] 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 ")")) []]) [Node] -> [Node] -> [Node]
forall a. [a] -> [a] -> [a]
++ )
inlineToNodes opts :: WriterOptions
opts (Subscript xs :: [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 "<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 "</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 xs' :: [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]
++)
      _ ->
        ((NodeType -> [Node] -> Node
node (Text -> NodeType
TEXT (String -> Text
T.pack "_(")) [] 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 ")")) []]) [Node] -> [Node] -> [Node]
forall a. [a] -> [a] -> [a]
++ )
inlineToNodes opts :: WriterOptions
opts (SmallCaps xs :: [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 "<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 "</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 opts :: WriterOptions
opts (Link _ ils :: [Inline]
ils (url :: Text
url,tit :: 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]
:)
-- title beginning with fig: indicates implicit figure
inlineToNodes opts :: WriterOptions
opts (Image alt :: Attr
alt ils :: [Inline]
ils (url :: Text
url,Text -> Text -> Maybe Text
T.stripPrefix "fig:" -> Just tit :: Text
tit)) =
  WriterOptions -> Inline -> [Node] -> [Node]
inlineToNodes WriterOptions
opts (Attr -> [Inline] -> Target -> Inline
Image Attr
alt [Inline]
ils (Text
url,Text
tit))
inlineToNodes opts :: WriterOptions
opts (Image _ ils :: [Inline]
ils (url :: Text
url,tit :: 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 opts :: WriterOptions
opts (RawInline (Format f :: Text
f) xs :: Text
xs)
  | Text
f Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== "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
== "latex" Bool -> Bool -> Bool
|| Text
f Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== "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
== "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 opts :: WriterOptions
opts (Quoted qt :: QuoteType
qt ils :: [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 (start :: Text
start, end :: Text
end) = case QuoteType
qt of
                          SingleQuote
                            | Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_smart WriterOptions
opts -> ("'","'")
                            | WriterOptions -> Bool
writerPreferAscii WriterOptions
opts ->
                                     ("&lsquo;", "&rsquo;")
                            | Bool
otherwise -> ("‘", "’")
                          DoubleQuote
                            | Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_smart WriterOptions
opts -> ("\"", "\"")
                            | WriterOptions -> Bool
writerPreferAscii WriterOptions
opts ->
                                     ("&ldquo;", "&rdquo;")
                            | Bool
otherwise -> ("“", "”")
inlineToNodes _ (Code _ str :: Text
str) = (NodeType -> [Node] -> Node
node (Text -> NodeType
CODE Text
str) [] Node -> [Node] -> [Node]
forall a. a -> [a] -> [a]
:)
inlineToNodes opts :: WriterOptions
opts (Math mt :: MathType
mt str :: Text
str) =
  case WriterOptions -> HTMLMathMethod
writerHTMLMathMethod WriterOptions
opts of
       WebTeX url :: Text
url ->
           let core :: [Node] -> [Node]
core = WriterOptions -> Inline -> [Node] -> [Node]
inlineToNodes WriterOptions
opts
                        (Attr -> [Inline] -> Target -> Inline
Image Attr
nullAttr [Text -> Inline
Str Text
str] (Text
url Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (String -> String
urlEncode (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
str), Text
str))
               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)
       _  ->
           case MathType
mt of
            InlineMath  ->
              (NodeType -> [Node] -> Node
node (Text -> NodeType
HTML_INLINE ("\\(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
str Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "\\)")) [] Node -> [Node] -> [Node]
forall a. a -> [a] -> [a]
:)
            DisplayMath ->
              (NodeType -> [Node] -> Node
node (Text -> NodeType
HTML_INLINE ("\\[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
str Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "\\]")) [] Node -> [Node] -> [Node]
forall a. a -> [a] -> [a]
:)
inlineToNodes opts :: WriterOptions
opts (Span ("",["emoji"],kvs :: [Target]
kvs) [Str s :: Text
s]) = do
  case Text -> [Target] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup "data-emoji" [Target]
kvs of
       Just emojiname :: Text
emojiname | Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_emoji WriterOptions
opts ->
            (NodeType -> [Node] -> Node
node (Text -> NodeType
TEXT (":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
emojiname Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ":")) [] Node -> [Node] -> [Node]
forall a. a -> [a] -> [a]
:)
       _ -> (NodeType -> [Node] -> Node
node (Text -> NodeType
TEXT Text
s) [] Node -> [Node] -> [Node]
forall a. a -> [a] -> [a]
:)
inlineToNodes opts :: WriterOptions
opts (Span attr :: Attr
attr ils :: [Inline]
ils) =
  let nodes :: [Node]
nodes = WriterOptions -> [Inline] -> [Node]
inlinesToNodes WriterOptions
opts [Inline]
ils
      op :: Text
op = WriterOptions -> Bool -> Bool -> Text -> Attr -> Text
tagWithAttributes WriterOptions
opts Bool
True Bool
False "span" Attr
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 "</span>")) []]) [Node] -> [Node] -> [Node]
forall a. [a] -> [a] -> [a]
++)
         else ([Node]
nodes [Node] -> [Node] -> [Node]
forall a. [a] -> [a] -> [a]
++)
inlineToNodes opts :: WriterOptions
opts (Cite _ ils :: [Inline]
ils) = (WriterOptions -> [Inline] -> [Node]
inlinesToNodes WriterOptions
opts [Inline]
ils [Node] -> [Node] -> [Node]
forall a. [a] -> [a] -> [a]
++)
inlineToNodes _ (Note _) = [Node] -> [Node]
forall a. a -> a
id -- should not occur
-- we remove Note elements in preprocessing

stringToNodes :: WriterOptions -> Text -> [Node] -> [Node]
stringToNodes :: WriterOptions -> Text -> [Node] -> [Node]
stringToNodes opts :: WriterOptions
opts s :: 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 input :: Text
input =
      let (ascii :: Text
ascii, rest :: Text
rest) = (Char -> Bool) -> Text -> Target
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
            Nothing -> [Node] -> [Node]
forall a. a -> a
id
            Just (nonAscii :: Char
nonAscii, rest' :: 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 Space = Inline -> Maybe Inline
forall a. a -> Maybe a
Just Inline
Space
toSubscriptInline (Span attr :: Attr
attr ils :: [Inline]
ils) = Attr -> [Inline] -> Inline
Span Attr
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 s :: 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 LineBreak = Inline -> Maybe Inline
forall a. a -> Maybe a
Just Inline
LineBreak
toSubscriptInline SoftBreak = Inline -> Maybe Inline
forall a. a -> Maybe a
Just Inline
SoftBreak
toSubscriptInline _ = Maybe Inline
forall a. Maybe a
Nothing

toSuperscriptInline :: Inline -> Maybe Inline
toSuperscriptInline :: Inline -> Maybe Inline
toSuperscriptInline Space = Inline -> Maybe Inline
forall a. a -> Maybe a
Just Inline
Space
toSuperscriptInline (Span attr :: Attr
attr ils :: [Inline]
ils) = Attr -> [Inline] -> Inline
Span Attr
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 s :: 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 LineBreak = Inline -> Maybe Inline
forall a. a -> Maybe a
Just Inline
LineBreak
toSuperscriptInline SoftBreak = Inline -> Maybe Inline
forall a. a -> Maybe a
Just Inline
SoftBreak
toSuperscriptInline _ = Maybe Inline
forall a. Maybe a
Nothing