{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}
module Text.Pandoc.Readers.CommonMark (readCommonMark)
where
import CMarkGFM
import Control.Monad.State
import qualified Data.Set as Set
import Data.Text (Text)
import qualified Data.Text as T
import Text.Pandoc.Class.PandocMonad (PandocMonad)
import Text.Pandoc.Definition
import Text.Pandoc.Emoji (emojiToInline)
import Text.Pandoc.Options
import Text.Pandoc.Shared (uniqueIdent, taskListItemFromAscii)
import Text.Pandoc.Walk (walkM)
readCommonMark :: PandocMonad m => ReaderOptions -> Text -> m Pandoc
readCommonMark :: ReaderOptions -> Text -> m Pandoc
readCommonMark opts :: ReaderOptions
opts s :: Text
s = Pandoc -> m Pandoc
forall (m :: * -> *) a. Monad m => a -> m a
return (Pandoc -> m Pandoc) -> Pandoc -> m Pandoc
forall a b. (a -> b) -> a -> b
$
(if Extension -> ReaderOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_auto_identifiers ReaderOptions
opts
then ReaderOptions -> Pandoc -> Pandoc
addHeaderIdentifiers ReaderOptions
opts
else Pandoc -> Pandoc
forall a. a -> a
id) (Pandoc -> Pandoc) -> Pandoc -> Pandoc
forall a b. (a -> b) -> a -> b
$
ReaderOptions -> Node -> Pandoc
nodeToPandoc ReaderOptions
opts (Node -> Pandoc) -> Node -> Pandoc
forall a b. (a -> b) -> a -> b
$ [CMarkOption] -> [CMarkExtension] -> Text -> Node
commonmarkToNode [CMarkOption]
opts' [CMarkExtension]
exts Text
s
where opts' :: [CMarkOption]
opts' = [ CMarkOption
optSmart | Extension -> ReaderOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_smart ReaderOptions
opts ]
exts :: [CMarkExtension]
exts = [ CMarkExtension
extStrikethrough | Extension -> ReaderOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_strikeout ReaderOptions
opts ] [CMarkExtension] -> [CMarkExtension] -> [CMarkExtension]
forall a. [a] -> [a] -> [a]
++
[ CMarkExtension
extTable | Extension -> ReaderOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_pipe_tables ReaderOptions
opts ] [CMarkExtension] -> [CMarkExtension] -> [CMarkExtension]
forall a. [a] -> [a] -> [a]
++
[ CMarkExtension
extAutolink | Extension -> ReaderOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_autolink_bare_uris ReaderOptions
opts ]
convertEmojis :: Text -> [Inline]
convertEmojis :: Text -> [Inline]
convertEmojis s :: Text
s@(Text -> Maybe (Char, Text)
T.uncons -> Just (':',xs :: Text
xs)) =
case (Char -> Bool) -> Text -> (Text, Text)
T.break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==':') Text
xs of
(ys :: Text
ys, Text -> Maybe (Char, Text)
T.uncons -> Just (':',zs :: Text
zs)) ->
case Text -> Maybe Inline
emojiToInline Text
ys of
Just em :: Inline
em -> Inline
em Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Text -> [Inline]
convertEmojis Text
zs
Nothing -> Text -> Inline
Str (":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
ys) Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Text -> [Inline]
convertEmojis (":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
zs)
_ -> [Text -> Inline
Str Text
s]
convertEmojis s :: Text
s =
case (Char -> Bool) -> Text -> (Text, Text)
T.break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==':') Text
s of
("","") -> []
(_,"") -> [Text -> Inline
Str Text
s]
(xs :: Text
xs,ys :: Text
ys) -> Text -> Inline
Str Text
xs Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Text -> [Inline]
convertEmojis Text
ys
addHeaderIdentifiers :: ReaderOptions -> Pandoc -> Pandoc
opts :: ReaderOptions
opts doc :: Pandoc
doc = State (Set Text) Pandoc -> Set Text -> Pandoc
forall s a. State s a -> s -> a
evalState ((Block -> StateT (Set Text) Identity Block)
-> Pandoc -> State (Set Text) Pandoc
forall a b (m :: * -> *).
(Walkable a b, Monad m, Applicative m, Functor m) =>
(a -> m a) -> b -> m b
walkM (ReaderOptions -> Block -> StateT (Set Text) Identity Block
addHeaderId ReaderOptions
opts) Pandoc
doc) Set Text
forall a. Monoid a => a
mempty
addHeaderId :: ReaderOptions -> Block -> State (Set.Set Text) Block
opts :: ReaderOptions
opts (Header lev :: Int
lev (_,classes :: [Text]
classes,kvs :: [(Text, Text)]
kvs) ils :: [Inline]
ils) = do
Set Text
ids <- StateT (Set Text) Identity (Set Text)
forall s (m :: * -> *). MonadState s m => m s
get
let ident :: Text
ident = Extensions -> [Inline] -> Set Text -> Text
uniqueIdent (ReaderOptions -> Extensions
readerExtensions ReaderOptions
opts) [Inline]
ils Set Text
ids
(Set Text -> Set Text) -> StateT (Set Text) Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (Text -> Set Text -> Set Text
forall a. Ord a => a -> Set a -> Set a
Set.insert Text
ident)
Block -> StateT (Set Text) Identity Block
forall (m :: * -> *) a. Monad m => a -> m a
return (Block -> StateT (Set Text) Identity Block)
-> Block -> StateT (Set Text) Identity Block
forall a b. (a -> b) -> a -> b
$ Int -> Attr -> [Inline] -> Block
Header Int
lev (Text
ident,[Text]
classes,[(Text, Text)]
kvs) [Inline]
ils
addHeaderId _ x :: Block
x = Block -> StateT (Set Text) Identity Block
forall (m :: * -> *) a. Monad m => a -> m a
return Block
x
nodeToPandoc :: ReaderOptions -> Node -> Pandoc
nodeToPandoc :: ReaderOptions -> Node -> Pandoc
nodeToPandoc opts :: ReaderOptions
opts (Node _ DOCUMENT nodes :: [Node]
nodes) =
Meta -> [Block] -> Pandoc
Pandoc Meta
nullMeta ([Block] -> Pandoc) -> [Block] -> Pandoc
forall a b. (a -> b) -> a -> b
$ (Node -> [Block] -> [Block]) -> [Block] -> [Node] -> [Block]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (ReaderOptions -> Node -> [Block] -> [Block]
addBlock ReaderOptions
opts) [] [Node]
nodes
nodeToPandoc opts :: ReaderOptions
opts n :: Node
n =
Meta -> [Block] -> Pandoc
Pandoc Meta
nullMeta ([Block] -> Pandoc) -> [Block] -> Pandoc
forall a b. (a -> b) -> a -> b
$ (Node -> [Block] -> [Block]) -> [Block] -> [Node] -> [Block]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (ReaderOptions -> Node -> [Block] -> [Block]
addBlock ReaderOptions
opts) [] [Node
n]
addBlocks :: ReaderOptions -> [Node] -> [Block]
addBlocks :: ReaderOptions -> [Node] -> [Block]
addBlocks opts :: ReaderOptions
opts = (Node -> [Block] -> [Block]) -> [Block] -> [Node] -> [Block]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (ReaderOptions -> Node -> [Block] -> [Block]
addBlock ReaderOptions
opts) []
addBlock :: ReaderOptions -> Node -> [Block] -> [Block]
addBlock :: ReaderOptions -> Node -> [Block] -> [Block]
addBlock opts :: ReaderOptions
opts (Node _ PARAGRAPH nodes :: [Node]
nodes) =
([Inline] -> Block
Para (ReaderOptions -> [Node] -> [Inline]
addInlines ReaderOptions
opts [Node]
nodes) Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
:)
addBlock _ (Node _ THEMATIC_BREAK _) =
(Block
HorizontalRule Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
:)
addBlock opts :: ReaderOptions
opts (Node _ BLOCK_QUOTE nodes :: [Node]
nodes) =
([Block] -> Block
BlockQuote (ReaderOptions -> [Node] -> [Block]
addBlocks ReaderOptions
opts [Node]
nodes) Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
:)
addBlock opts :: ReaderOptions
opts (Node _ (HTML_BLOCK t :: Text
t) _)
| Extension -> ReaderOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_raw_html ReaderOptions
opts = (Format -> Text -> Block
RawBlock (Text -> Format
Format "html") Text
t Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
:)
| Bool
otherwise = [Block] -> [Block]
forall a. a -> a
id
addBlock _ (Node _ (CUSTOM_BLOCK _onEnter :: Text
_onEnter _onExit :: Text
_onExit) _nodes :: [Node]
_nodes) =
[Block] -> [Block]
forall a. a -> a
id
addBlock _ (Node _ (CODE_BLOCK info :: Text
info t :: Text
t) _) =
(Attr -> Text -> Block
CodeBlock ("", Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
take 1 (Text -> [Text]
T.words Text
info), []) Text
t Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
:)
addBlock opts :: ReaderOptions
opts (Node _ (HEADING lev :: Int
lev) nodes :: [Node]
nodes) =
(Int -> Attr -> [Inline] -> Block
Header Int
lev ("",[],[]) (ReaderOptions -> [Node] -> [Inline]
addInlines ReaderOptions
opts [Node]
nodes) Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
:)
addBlock opts :: ReaderOptions
opts (Node _ (LIST listAttrs :: ListAttributes
listAttrs) nodes :: [Node]
nodes) =
([[Block]] -> Block
constructor ((Node -> [Block]) -> [Node] -> [[Block]]
forall a b. (a -> b) -> [a] -> [b]
map Node -> [Block]
listItem [Node]
nodes) Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
:)
where constructor :: [[Block]] -> Block
constructor = case ListAttributes -> ListType
listType ListAttributes
listAttrs of
BULLET_LIST -> [[Block]] -> Block
BulletList
ORDERED_LIST -> ListAttributes -> [[Block]] -> Block
OrderedList
(Int
start, ListNumberStyle
DefaultStyle, ListNumberDelim
delim)
start :: Int
start = ListAttributes -> Int
listStart ListAttributes
listAttrs
listItem :: Node -> [Block]
listItem = Extensions -> [Block] -> [Block]
taskListItemFromAscii Extensions
exts ([Block] -> [Block]) -> (Node -> [Block]) -> Node -> [Block]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Block] -> [Block]
setTightness
([Block] -> [Block]) -> (Node -> [Block]) -> Node -> [Block]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderOptions -> [Node] -> [Block]
addBlocks ReaderOptions
opts ([Node] -> [Block]) -> (Node -> [Node]) -> Node -> [Block]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Node -> [Node]
children
setTightness :: [Block] -> [Block]
setTightness = if ListAttributes -> Bool
listTight ListAttributes
listAttrs
then (Block -> Block) -> [Block] -> [Block]
forall a b. (a -> b) -> [a] -> [b]
map Block -> Block
paraToPlain
else [Block] -> [Block]
forall a. a -> a
id
paraToPlain :: Block -> Block
paraToPlain (Para xs :: [Inline]
xs) = [Inline] -> Block
Plain [Inline]
xs
paraToPlain x :: Block
x = Block
x
delim :: ListNumberDelim
delim = case ListAttributes -> DelimType
listDelim ListAttributes
listAttrs of
PERIOD_DELIM -> ListNumberDelim
Period
PAREN_DELIM -> ListNumberDelim
OneParen
exts :: Extensions
exts = ReaderOptions -> Extensions
readerExtensions ReaderOptions
opts
addBlock opts :: ReaderOptions
opts (Node _ (TABLE alignments :: [TableCellAlignment]
alignments) nodes :: [Node]
nodes) =
([Inline]
-> [Alignment] -> [Double] -> [[Block]] -> [[[Block]]] -> Block
Table [] [Alignment]
aligns [Double]
widths [[Block]]
headers [[[Block]]]
rows Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
:)
where aligns :: [Alignment]
aligns = (TableCellAlignment -> Alignment)
-> [TableCellAlignment] -> [Alignment]
forall a b. (a -> b) -> [a] -> [b]
map TableCellAlignment -> Alignment
fromTableCellAlignment [TableCellAlignment]
alignments
fromTableCellAlignment :: TableCellAlignment -> Alignment
fromTableCellAlignment NoAlignment = Alignment
AlignDefault
fromTableCellAlignment LeftAligned = Alignment
AlignLeft
fromTableCellAlignment RightAligned = Alignment
AlignRight
fromTableCellAlignment CenterAligned = Alignment
AlignCenter
widths :: [Double]
widths = Int -> Double -> [Double]
forall a. Int -> a -> [a]
replicate Int
numcols 0.0
numcols :: Int
numcols = if [[[Block]]] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[[Block]]]
rows'
then 0
else [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ ([[Block]] -> Int) -> [[[Block]]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map [[Block]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[[Block]]]
rows'
rows' :: [[[Block]]]
rows' = (Node -> [[Block]]) -> [Node] -> [[[Block]]]
forall a b. (a -> b) -> [a] -> [b]
map Node -> [[Block]]
toRow ([Node] -> [[[Block]]]) -> [Node] -> [[[Block]]]
forall a b. (a -> b) -> a -> b
$ (Node -> Bool) -> [Node] -> [Node]
forall a. (a -> Bool) -> [a] -> [a]
filter Node -> Bool
isRow [Node]
nodes
(headers :: [[Block]]
headers, rows :: [[[Block]]]
rows) = case [[[Block]]]
rows' of
(h :: [[Block]]
h:rs :: [[[Block]]]
rs) -> ([[Block]]
h, [[[Block]]]
rs)
[] -> ([], [])
isRow :: Node -> Bool
isRow (Node _ TABLE_ROW _) = Bool
True
isRow _ = Bool
False
isCell :: Node -> Bool
isCell (Node _ TABLE_CELL _) = Bool
True
isCell _ = Bool
False
toRow :: Node -> [[Block]]
toRow (Node _ TABLE_ROW ns :: [Node]
ns) = (Node -> [Block]) -> [Node] -> [[Block]]
forall a b. (a -> b) -> [a] -> [b]
map Node -> [Block]
toCell ([Node] -> [[Block]]) -> [Node] -> [[Block]]
forall a b. (a -> b) -> a -> b
$ (Node -> Bool) -> [Node] -> [Node]
forall a. (a -> Bool) -> [a] -> [a]
filter Node -> Bool
isCell [Node]
ns
toRow (Node _ t :: NodeType
t _) = [Char] -> [[Block]]
forall a. HasCallStack => [Char] -> a
error ([Char] -> [[Block]]) -> [Char] -> [[Block]]
forall a b. (a -> b) -> a -> b
$ "toRow encountered non-row " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ NodeType -> [Char]
forall a. Show a => a -> [Char]
show NodeType
t
toCell :: Node -> [Block]
toCell (Node _ TABLE_CELL []) = []
toCell (Node _ TABLE_CELL (n :: Node
n:ns :: [Node]
ns))
| Node -> Bool
isBlockNode Node
n = ReaderOptions -> [Node] -> [Block]
addBlocks ReaderOptions
opts (Node
nNode -> [Node] -> [Node]
forall a. a -> [a] -> [a]
:[Node]
ns)
| Bool
otherwise = [[Inline] -> Block
Plain (ReaderOptions -> [Node] -> [Inline]
addInlines ReaderOptions
opts (Node
nNode -> [Node] -> [Node]
forall a. a -> [a] -> [a]
:[Node]
ns))]
toCell (Node _ t :: NodeType
t _) = [Char] -> [Block]
forall a. HasCallStack => [Char] -> a
error ([Char] -> [Block]) -> [Char] -> [Block]
forall a b. (a -> b) -> a -> b
$ "toCell encountered non-cell " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ NodeType -> [Char]
forall a. Show a => a -> [Char]
show NodeType
t
addBlock _ (Node _ TABLE_ROW _) = [Block] -> [Block]
forall a. a -> a
id
addBlock _ (Node _ TABLE_CELL _) = [Block] -> [Block]
forall a. a -> a
id
addBlock _ _ = [Block] -> [Block]
forall a. a -> a
id
isBlockNode :: Node -> Bool
isBlockNode :: Node -> Bool
isBlockNode (Node _ nodetype :: NodeType
nodetype _) =
case NodeType
nodetype of
DOCUMENT -> Bool
True
THEMATIC_BREAK -> Bool
True
PARAGRAPH -> Bool
True
BLOCK_QUOTE -> Bool
True
HTML_BLOCK _ -> Bool
True
CUSTOM_BLOCK _ _ -> Bool
True
CODE_BLOCK _ _ -> Bool
True
HEADING _ -> Bool
True
LIST _ -> Bool
True
ITEM -> Bool
True
TEXT _ -> Bool
False
SOFTBREAK -> Bool
False
LINEBREAK -> Bool
False
HTML_INLINE _ -> Bool
False
CUSTOM_INLINE _ _ -> Bool
False
CODE _ -> Bool
False
EMPH -> Bool
False
STRONG -> Bool
False
LINK _ _ -> Bool
False
IMAGE _ _ -> Bool
False
STRIKETHROUGH -> Bool
False
TABLE _ -> Bool
False
TABLE_ROW -> Bool
False
TABLE_CELL -> Bool
False
children :: Node -> [Node]
children :: Node -> [Node]
children (Node _ _ ns :: [Node]
ns) = [Node]
ns
addInlines :: ReaderOptions -> [Node] -> [Inline]
addInlines :: ReaderOptions -> [Node] -> [Inline]
addInlines opts :: ReaderOptions
opts = (Node -> [Inline] -> [Inline]) -> [Inline] -> [Node] -> [Inline]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (ReaderOptions -> Node -> [Inline] -> [Inline]
addInline ReaderOptions
opts) []
addInline :: ReaderOptions -> Node -> [Inline] -> [Inline]
addInline :: ReaderOptions -> Node -> [Inline] -> [Inline]
addInline opts :: ReaderOptions
opts (Node _ (TEXT t :: Text
t) _) = ((Text -> [Inline]) -> [Text] -> [Inline]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Text -> [Inline]
toinl [Text]
clumps [Inline] -> [Inline] -> [Inline]
forall a. [a] -> [a] -> [a]
++)
where clumps :: [Text]
clumps = (Char -> Char -> Bool) -> Text -> [Text]
T.groupBy Char -> Char -> Bool
samekind Text
t
samekind :: Char -> Char -> Bool
samekind ' ' ' ' = Bool
True
samekind ' ' _ = Bool
False
samekind _ ' ' = Bool
False
samekind _ _ = Bool
True
toinl :: Text -> [Inline]
toinl (Text -> Maybe (Char, Text)
T.uncons -> Just (' ', _)) = [Inline
Space]
toinl xs :: Text
xs = if Extension -> ReaderOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_emoji ReaderOptions
opts
then Text -> [Inline]
convertEmojis Text
xs
else [Text -> Inline
Str Text
xs]
addInline _ (Node _ LINEBREAK _) = (Inline
LineBreak Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
:)
addInline opts :: ReaderOptions
opts (Node _ SOFTBREAK _)
| Extension -> ReaderOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_hard_line_breaks ReaderOptions
opts = (Inline
LineBreak Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
:)
| Bool
otherwise = (Inline
SoftBreak Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
:)
addInline opts :: ReaderOptions
opts (Node _ (HTML_INLINE t :: Text
t) _)
| Extension -> ReaderOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_raw_html ReaderOptions
opts = (Format -> Text -> Inline
RawInline (Text -> Format
Format "html") Text
t Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
:)
| Bool
otherwise = [Inline] -> [Inline]
forall a. a -> a
id
addInline _ (Node _ (CUSTOM_INLINE _onEnter :: Text
_onEnter _onExit :: Text
_onExit) _nodes :: [Node]
_nodes) =
[Inline] -> [Inline]
forall a. a -> a
id
addInline _ (Node _ (CODE t :: Text
t) _) =
(Attr -> Text -> Inline
Code ("",[],[]) Text
t Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
:)
addInline opts :: ReaderOptions
opts (Node _ EMPH nodes :: [Node]
nodes) =
([Inline] -> Inline
Emph (ReaderOptions -> [Node] -> [Inline]
addInlines ReaderOptions
opts [Node]
nodes) Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
:)
addInline opts :: ReaderOptions
opts (Node _ STRONG nodes :: [Node]
nodes) =
([Inline] -> Inline
Strong (ReaderOptions -> [Node] -> [Inline]
addInlines ReaderOptions
opts [Node]
nodes) Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
:)
addInline opts :: ReaderOptions
opts (Node _ STRIKETHROUGH nodes :: [Node]
nodes) =
([Inline] -> Inline
Strikeout (ReaderOptions -> [Node] -> [Inline]
addInlines ReaderOptions
opts [Node]
nodes) Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
:)
addInline opts :: ReaderOptions
opts (Node _ (LINK url :: Text
url title :: Text
title) nodes :: [Node]
nodes) =
(Attr -> [Inline] -> (Text, Text) -> Inline
Link Attr
nullAttr (ReaderOptions -> [Node] -> [Inline]
addInlines ReaderOptions
opts [Node]
nodes) (Text
url, Text
title) Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
:)
addInline opts :: ReaderOptions
opts (Node _ (IMAGE url :: Text
url title :: Text
title) nodes :: [Node]
nodes) =
(Attr -> [Inline] -> (Text, Text) -> Inline
Image Attr
nullAttr (ReaderOptions -> [Node] -> [Inline]
addInlines ReaderOptions
opts [Node]
nodes) (Text
url, Text
title) Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
:)
addInline _ _ = [Inline] -> [Inline]
forall a. a -> a
id