{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
module Text.Pandoc.Writers.Custom ( writeCustom ) where
import Control.Arrow ((***))
import Control.Exception
import Control.Monad (when)
import Data.List (intersperse)
import qualified Data.Map as M
import qualified Data.Text as T
import Data.Text (Text, pack)
import HsLua as Lua hiding (Operation (Div), render)
import HsLua.Class.Peekable (PeekError)
import Text.DocLayout (render, literal)
import Control.Monad.IO.Class (MonadIO)
import Text.Pandoc.Definition
import Text.Pandoc.Lua (Global (..), runLua, setGlobals)
import Text.Pandoc.Lua.Util (addField, dofileWithTraceback)
import Text.Pandoc.Options
import Text.Pandoc.Class (PandocMonad)
import Text.Pandoc.Templates (renderTemplate)
import Text.Pandoc.Writers.Shared
attrToMap :: Attr -> M.Map T.Text T.Text
attrToMap :: Attr -> Map Text Text
attrToMap (Text
id',[Text]
classes,[(Text, Text)]
keyvals) = [(Text, Text)] -> Map Text Text
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
([(Text, Text)] -> Map Text Text)
-> [(Text, Text)] -> Map Text Text
forall a b. (a -> b) -> a -> b
$ (Text
"id", Text
id')
(Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
: (Text
"class", [Text] -> Text
T.unwords [Text]
classes)
(Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
: [(Text, Text)]
keyvals
newtype Stringify e a = Stringify a
instance Pushable (Stringify e Format) where
push :: Stringify e Format -> LuaE e ()
push (Stringify (Format Text
f)) = Text -> LuaE e ()
forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
Lua.push (Text -> Text
T.toLower Text
f)
instance PeekError e => Pushable (Stringify e [Inline]) where
push :: Stringify e [Inline] -> LuaE e ()
push (Stringify [Inline]
ils) = String -> LuaE e ()
forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
Lua.push (String -> LuaE e ()) -> LuaE e String -> LuaE e ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
LuaE e String -> LuaE e String
forall old new a. LuaE old a -> LuaE new a
changeErrorType (([Inline] -> LuaE e String
forall e. PeekError e => [Inline] -> LuaE e String
inlineListToCustom @e) [Inline]
ils)
instance PeekError e => Pushable (Stringify e [Block]) where
push :: Stringify e [Block] -> LuaE e ()
push (Stringify [Block]
blks) = String -> LuaE e ()
forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
Lua.push (String -> LuaE e ()) -> LuaE e String -> LuaE e ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
LuaE e String -> LuaE e String
forall old new a. LuaE old a -> LuaE new a
changeErrorType (([Block] -> LuaE e String
forall e. PeekError e => [Block] -> LuaE e String
blockListToCustom @e) [Block]
blks)
instance PeekError e => Pushable (Stringify e MetaValue) where
push :: Stringify e MetaValue -> LuaE e ()
push (Stringify (MetaMap Map Text MetaValue
m)) = Map Text (Stringify e MetaValue) -> LuaE e ()
forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
Lua.push ((MetaValue -> Stringify e MetaValue)
-> Map Text MetaValue -> Map Text (Stringify e MetaValue)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. a -> Stringify e a
forall e a. a -> Stringify e a
Stringify @e) Map Text MetaValue
m)
push (Stringify (MetaList [MetaValue]
xs)) = [Stringify e MetaValue] -> LuaE e ()
forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
Lua.push ((MetaValue -> Stringify e MetaValue)
-> [MetaValue] -> [Stringify e MetaValue]
forall a b. (a -> b) -> [a] -> [b]
map (forall a. a -> Stringify e a
forall e a. a -> Stringify e a
Stringify @e) [MetaValue]
xs)
push (Stringify (MetaBool Bool
x)) = Bool -> LuaE e ()
forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
Lua.push Bool
x
push (Stringify (MetaString Text
s)) = Text -> LuaE e ()
forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
Lua.push Text
s
push (Stringify (MetaInlines [Inline]
ils)) = Stringify e [Inline] -> LuaE e ()
forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
Lua.push ([Inline] -> Stringify e [Inline]
forall e a. a -> Stringify e a
Stringify @e [Inline]
ils)
push (Stringify (MetaBlocks [Block]
bs)) = Stringify e [Block] -> LuaE e ()
forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
Lua.push ([Block] -> Stringify e [Block]
forall e a. a -> Stringify e a
Stringify @e [Block]
bs)
instance PeekError e => Pushable (Stringify e Citation) where
push :: Stringify e Citation -> LuaE e ()
push (Stringify Citation
cit) = do
Int -> Int -> LuaE e ()
forall e. Int -> Int -> LuaE e ()
Lua.createtable Int
6 Int
0
String -> Text -> LuaE e ()
forall e a. (LuaError e, Pushable a) => String -> a -> LuaE e ()
addField String
"citationId" (Text -> LuaE e ()) -> Text -> LuaE e ()
forall a b. (a -> b) -> a -> b
$ Citation -> Text
citationId Citation
cit
String -> Stringify e [Inline] -> LuaE e ()
forall e a. (LuaError e, Pushable a) => String -> a -> LuaE e ()
addField String
"citationPrefix" (Stringify e [Inline] -> LuaE e ())
-> ([Inline] -> Stringify e [Inline]) -> [Inline] -> LuaE e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Stringify e a
forall e a. a -> Stringify e a
Stringify @e ([Inline] -> LuaE e ()) -> [Inline] -> LuaE e ()
forall a b. (a -> b) -> a -> b
$ Citation -> [Inline]
citationPrefix Citation
cit
String -> Stringify e [Inline] -> LuaE e ()
forall e a. (LuaError e, Pushable a) => String -> a -> LuaE e ()
addField String
"citationSuffix" (Stringify e [Inline] -> LuaE e ())
-> ([Inline] -> Stringify e [Inline]) -> [Inline] -> LuaE e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Stringify e a
forall e a. a -> Stringify e a
Stringify @e ([Inline] -> LuaE e ()) -> [Inline] -> LuaE e ()
forall a b. (a -> b) -> a -> b
$ Citation -> [Inline]
citationSuffix Citation
cit
String -> String -> LuaE e ()
forall e a. (LuaError e, Pushable a) => String -> a -> LuaE e ()
addField String
"citationMode" (String -> LuaE e ()) -> String -> LuaE e ()
forall a b. (a -> b) -> a -> b
$ CitationMode -> String
forall a. Show a => a -> String
show (Citation -> CitationMode
citationMode Citation
cit)
String -> Int -> LuaE e ()
forall e a. (LuaError e, Pushable a) => String -> a -> LuaE e ()
addField String
"citationNoteNum" (Int -> LuaE e ()) -> Int -> LuaE e ()
forall a b. (a -> b) -> a -> b
$ Citation -> Int
citationNoteNum Citation
cit
String -> Int -> LuaE e ()
forall e a. (LuaError e, Pushable a) => String -> a -> LuaE e ()
addField String
"citationHash" (Int -> LuaE e ()) -> Int -> LuaE e ()
forall a b. (a -> b) -> a -> b
$ Citation -> Int
citationHash Citation
cit
newtype KeyValue a b = KeyValue (a, b)
instance (Pushable a, Pushable b) => Pushable (KeyValue a b) where
push :: KeyValue a b -> LuaE e ()
push (KeyValue (a
k, b
v)) = do
LuaE e ()
forall e. LuaE e ()
Lua.newtable
a -> LuaE e ()
forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
Lua.push a
k
b -> LuaE e ()
forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
Lua.push b
v
StackIndex -> LuaE e ()
forall e. LuaError e => StackIndex -> LuaE e ()
Lua.rawset (CInt -> StackIndex
Lua.nth CInt
3)
writeCustom :: (PandocMonad m, MonadIO m)
=> FilePath -> WriterOptions -> Pandoc -> m Text
writeCustom :: String -> WriterOptions -> Pandoc -> m Text
writeCustom String
luaFile WriterOptions
opts doc :: Pandoc
doc@(Pandoc Meta
meta [Block]
_) = do
let globals :: [Global]
globals = [ Pandoc -> Global
PANDOC_DOCUMENT Pandoc
doc
, String -> Global
PANDOC_SCRIPT_FILE String
luaFile
]
Either PandocError (Text, Context Text)
res <- LuaE PandocError (Text, Context Text)
-> m (Either PandocError (Text, Context Text))
forall (m :: * -> *) a.
(PandocMonad m, MonadIO m) =>
LuaE PandocError a -> m (Either PandocError a)
runLua (LuaE PandocError (Text, Context Text)
-> m (Either PandocError (Text, Context Text)))
-> LuaE PandocError (Text, Context Text)
-> m (Either PandocError (Text, Context Text))
forall a b. (a -> b) -> a -> b
$ do
[Global] -> LuaE PandocError ()
setGlobals [Global]
globals
Status
stat <- String -> LuaE PandocError Status
forall e. LuaError e => String -> LuaE e Status
dofileWithTraceback String
luaFile
Bool -> LuaE PandocError () -> LuaE PandocError ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Status
stat Status -> Status -> Bool
forall a. Eq a => a -> a -> Bool
/= Status
Lua.OK)
LuaE PandocError ()
forall e a. LuaError e => LuaE e a
Lua.throwErrorAsException
String
rendered <- WriterOptions -> Pandoc -> LuaE PandocError String
forall e. PeekError e => WriterOptions -> Pandoc -> LuaE e String
docToCustom WriterOptions
opts Pandoc
doc
Context Text
context <- WriterOptions
-> ([Block] -> LuaE PandocError (Doc Text))
-> ([Inline] -> LuaE PandocError (Doc Text))
-> Meta
-> LuaE PandocError (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
((String -> Doc Text)
-> LuaE PandocError String -> LuaE PandocError (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) -> (String -> Text) -> String -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack) (LuaE PandocError String -> LuaE PandocError (Doc Text))
-> ([Block] -> LuaE PandocError String)
-> [Block]
-> LuaE PandocError (Doc Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Block] -> LuaE PandocError String
forall e. PeekError e => [Block] -> LuaE e String
blockListToCustom)
((String -> Doc Text)
-> LuaE PandocError String -> LuaE PandocError (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) -> (String -> Text) -> String -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack) (LuaE PandocError String -> LuaE PandocError (Doc Text))
-> ([Inline] -> LuaE PandocError String)
-> [Inline]
-> LuaE PandocError (Doc Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> LuaE PandocError String
forall e. PeekError e => [Inline] -> LuaE e String
inlineListToCustom)
Meta
meta
(Text, Context Text) -> LuaE PandocError (Text, Context Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Text
pack String
rendered, Context Text
context)
case Either PandocError (Text, Context Text)
res of
Left PandocError
msg -> PandocError -> m Text
forall a e. Exception e => e -> a
throw PandocError
msg
Right (Text
body, Context Text
context) -> 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
body
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 -> Doc Text) -> Context Text -> Doc 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
setField Text
"body" Text
body Context Text
context
docToCustom :: forall e. PeekError e
=> WriterOptions -> Pandoc -> LuaE e String
docToCustom :: WriterOptions -> Pandoc -> LuaE e String
docToCustom WriterOptions
opts (Pandoc (Meta Map Text MetaValue
metamap) [Block]
blocks) = do
String
body <- [Block] -> LuaE e String
forall e. PeekError e => [Block] -> LuaE e String
blockListToCustom [Block]
blocks
Name
-> String
-> Map Text (Stringify e MetaValue)
-> Context Text
-> LuaE e String
forall e a. Invokable e a => Name -> a
invoke @e Name
"Doc" String
body ((MetaValue -> Stringify e MetaValue)
-> Map Text MetaValue -> Map Text (Stringify e MetaValue)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. a -> Stringify e a
forall e a. a -> Stringify e a
Stringify @e) Map Text MetaValue
metamap) (WriterOptions -> Context Text
writerVariables WriterOptions
opts)
blockToCustom :: forall e. PeekError e
=> Block
-> LuaE e String
blockToCustom :: Block -> LuaE e String
blockToCustom Block
Null = String -> LuaE e String
forall (m :: * -> *) a. Monad m => a -> m a
return String
""
blockToCustom (Plain [Inline]
inlines) = Name -> Stringify e [Inline] -> LuaE e String
forall e a. Invokable e a => Name -> a
invoke @e Name
"Plain" ([Inline] -> Stringify e [Inline]
forall e a. a -> Stringify e a
Stringify @e [Inline]
inlines)
blockToCustom (Para [Image Attr
attr [Inline]
txt (Text
src,Text
tit)]) =
Name
-> Text
-> Text
-> Stringify e [Inline]
-> Map Text Text
-> LuaE e String
forall e a. Invokable e a => Name -> a
invoke @e Name
"CaptionedImage" Text
src Text
tit ([Inline] -> Stringify e [Inline]
forall e a. a -> Stringify e a
Stringify @e [Inline]
txt) (Attr -> Map Text Text
attrToMap Attr
attr)
blockToCustom (Para [Inline]
inlines) = Name -> Stringify e [Inline] -> LuaE e String
forall e a. Invokable e a => Name -> a
invoke @e Name
"Para" ([Inline] -> Stringify e [Inline]
forall e a. a -> Stringify e a
Stringify @e [Inline]
inlines)
blockToCustom (LineBlock [[Inline]]
linesList) =
Name -> [Stringify e [Inline]] -> LuaE e String
forall e a. Invokable e a => Name -> a
invoke @e Name
"LineBlock" (([Inline] -> Stringify e [Inline])
-> [[Inline]] -> [Stringify e [Inline]]
forall a b. (a -> b) -> [a] -> [b]
map (forall a. a -> Stringify e a
forall e a. a -> Stringify e a
Stringify @e) [[Inline]]
linesList)
blockToCustom (RawBlock Format
format Text
str) =
Name -> Stringify e Format -> Text -> LuaE e String
forall e a. Invokable e a => Name -> a
invoke @e Name
"RawBlock" (Format -> Stringify e Format
forall e a. a -> Stringify e a
Stringify @e Format
format) Text
str
blockToCustom Block
HorizontalRule = Name -> LuaE e String
forall e a. Invokable e a => Name -> a
invoke @e Name
"HorizontalRule"
blockToCustom (Header Int
level Attr
attr [Inline]
inlines) =
Name
-> Int -> Stringify e [Inline] -> Map Text Text -> LuaE e String
forall e a. Invokable e a => Name -> a
invoke @e Name
"Header" Int
level ([Inline] -> Stringify e [Inline]
forall e a. a -> Stringify e a
Stringify @e [Inline]
inlines) (Attr -> Map Text Text
attrToMap Attr
attr)
blockToCustom (CodeBlock Attr
attr Text
str) =
Name -> Text -> Map Text Text -> LuaE e String
forall e a. Invokable e a => Name -> a
invoke @e Name
"CodeBlock" Text
str (Attr -> Map Text Text
attrToMap Attr
attr)
blockToCustom (BlockQuote [Block]
blocks) =
Name -> Stringify e [Block] -> LuaE e String
forall e a. Invokable e a => Name -> a
invoke @e Name
"BlockQuote" ([Block] -> Stringify e [Block]
forall e a. a -> Stringify e a
Stringify @e [Block]
blocks)
blockToCustom (Table Attr
_ Caption
blkCapt [ColSpec]
specs TableHead
thead [TableBody]
tbody TableFoot
tfoot) =
let ([Inline]
capt, [Alignment]
aligns, [Double]
widths, [[Block]]
headers, [[[Block]]]
rows) = Caption
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> ([Inline], [Alignment], [Double], [[Block]], [[[Block]]])
toLegacyTable Caption
blkCapt [ColSpec]
specs TableHead
thead [TableBody]
tbody TableFoot
tfoot
aligns' :: [String]
aligns' = (Alignment -> String) -> [Alignment] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Alignment -> String
forall a. Show a => a -> String
show [Alignment]
aligns
capt' :: Stringify e [Inline]
capt' = [Inline] -> Stringify e [Inline]
forall e a. a -> Stringify e a
Stringify @e [Inline]
capt
headers' :: [Stringify e [Block]]
headers' = ([Block] -> Stringify e [Block])
-> [[Block]] -> [Stringify e [Block]]
forall a b. (a -> b) -> [a] -> [b]
map (forall a. a -> Stringify e a
forall e a. a -> Stringify e a
Stringify @e) [[Block]]
headers
rows' :: [[Stringify e [Block]]]
rows' = ([[Block]] -> [Stringify e [Block]])
-> [[[Block]]] -> [[Stringify e [Block]]]
forall a b. (a -> b) -> [a] -> [b]
map (([Block] -> Stringify e [Block])
-> [[Block]] -> [Stringify e [Block]]
forall a b. (a -> b) -> [a] -> [b]
map (forall a. a -> Stringify e a
forall e a. a -> Stringify e a
Stringify @e)) [[[Block]]]
rows
in Name
-> Stringify e [Inline]
-> [String]
-> [Double]
-> [Stringify e [Block]]
-> [[Stringify e [Block]]]
-> LuaE e String
forall e a. Invokable e a => Name -> a
invoke @e Name
"Table" Stringify e [Inline]
capt' [String]
aligns' [Double]
widths [Stringify e [Block]]
headers' [[Stringify e [Block]]]
rows'
blockToCustom (BulletList [[Block]]
items) =
Name -> [Stringify e [Block]] -> LuaE e String
forall e a. Invokable e a => Name -> a
invoke @e Name
"BulletList" (([Block] -> Stringify e [Block])
-> [[Block]] -> [Stringify e [Block]]
forall a b. (a -> b) -> [a] -> [b]
map (forall a. a -> Stringify e a
forall e a. a -> Stringify e a
Stringify @e) [[Block]]
items)
blockToCustom (OrderedList (Int
num,ListNumberStyle
sty,ListNumberDelim
delim) [[Block]]
items) =
Name
-> [Stringify e [Block]]
-> Int
-> String
-> String
-> LuaE e String
forall e a. Invokable e a => Name -> a
invoke @e Name
"OrderedList" (([Block] -> Stringify e [Block])
-> [[Block]] -> [Stringify e [Block]]
forall a b. (a -> b) -> [a] -> [b]
map (forall a. a -> Stringify e a
forall e a. a -> Stringify e a
Stringify @e) [[Block]]
items) Int
num (ListNumberStyle -> String
forall a. Show a => a -> String
show ListNumberStyle
sty) (ListNumberDelim -> String
forall a. Show a => a -> String
show ListNumberDelim
delim)
blockToCustom (DefinitionList [([Inline], [[Block]])]
items) =
Name
-> [KeyValue (Stringify e [Inline]) [Stringify e [Block]]]
-> LuaE e String
forall e a. Invokable e a => Name -> a
invoke @e Name
"DefinitionList"
((([Inline], [[Block]])
-> KeyValue (Stringify e [Inline]) [Stringify e [Block]])
-> [([Inline], [[Block]])]
-> [KeyValue (Stringify e [Inline]) [Stringify e [Block]]]
forall a b. (a -> b) -> [a] -> [b]
map ((Stringify e [Inline], [Stringify e [Block]])
-> KeyValue (Stringify e [Inline]) [Stringify e [Block]]
forall a b. (a, b) -> KeyValue a b
KeyValue ((Stringify e [Inline], [Stringify e [Block]])
-> KeyValue (Stringify e [Inline]) [Stringify e [Block]])
-> (([Inline], [[Block]])
-> (Stringify e [Inline], [Stringify e [Block]]))
-> ([Inline], [[Block]])
-> KeyValue (Stringify e [Inline]) [Stringify e [Block]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> Stringify e a
forall e a. a -> Stringify e a
Stringify @e ([Inline] -> Stringify e [Inline])
-> ([[Block]] -> [Stringify e [Block]])
-> ([Inline], [[Block]])
-> (Stringify e [Inline], [Stringify e [Block]])
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** ([Block] -> Stringify e [Block])
-> [[Block]] -> [Stringify e [Block]]
forall a b. (a -> b) -> [a] -> [b]
map (forall a. a -> Stringify e a
forall e a. a -> Stringify e a
Stringify @e))) [([Inline], [[Block]])]
items)
blockToCustom (Div Attr
attr [Block]
items) =
Name -> Stringify e [Block] -> Map Text Text -> LuaE e String
forall e a. Invokable e a => Name -> a
invoke @e Name
"Div" ([Block] -> Stringify e [Block]
forall e a. a -> Stringify e a
Stringify @e [Block]
items) (Attr -> Map Text Text
attrToMap Attr
attr)
blockListToCustom :: forall e. PeekError e
=> [Block]
-> LuaE e String
blockListToCustom :: [Block] -> LuaE e String
blockListToCustom [Block]
xs = do
String
blocksep <- Name -> LuaE e String
forall e a. Invokable e a => Name -> a
invoke @e Name
"Blocksep"
[String]
bs <- (Block -> LuaE e String) -> [Block] -> LuaE e [String]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Block -> LuaE e String
forall e. PeekError e => Block -> LuaE e String
blockToCustom [Block]
xs
String -> LuaE e String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> LuaE e String) -> String -> LuaE e String
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall a. Monoid a => [a] -> a
mconcat ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse String
blocksep [String]
bs
inlineListToCustom :: forall e. PeekError e => [Inline] -> LuaE e String
inlineListToCustom :: [Inline] -> LuaE e String
inlineListToCustom [Inline]
lst = do
[String]
xs <- (Inline -> LuaE e String) -> [Inline] -> LuaE e [String]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (PeekError e => Inline -> LuaE e String
forall e. PeekError e => Inline -> LuaE e String
inlineToCustom @e) [Inline]
lst
String -> LuaE e String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> LuaE e String) -> String -> LuaE e String
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall a. Monoid a => [a] -> a
mconcat [String]
xs
inlineToCustom :: forall e. PeekError e => Inline -> LuaE e String
inlineToCustom :: Inline -> LuaE e String
inlineToCustom (Str Text
str) = Name -> Text -> LuaE e String
forall e a. Invokable e a => Name -> a
invoke @e Name
"Str" Text
str
inlineToCustom Inline
Space = Name -> LuaE e String
forall e a. Invokable e a => Name -> a
invoke @e Name
"Space"
inlineToCustom Inline
SoftBreak = Name -> LuaE e String
forall e a. Invokable e a => Name -> a
invoke @e Name
"SoftBreak"
inlineToCustom (Emph [Inline]
lst) = Name -> Stringify e [Inline] -> LuaE e String
forall e a. Invokable e a => Name -> a
invoke @e Name
"Emph" ([Inline] -> Stringify e [Inline]
forall e a. a -> Stringify e a
Stringify @e [Inline]
lst)
inlineToCustom (Underline [Inline]
lst) = Name -> Stringify e [Inline] -> LuaE e String
forall e a. Invokable e a => Name -> a
invoke @e Name
"Underline" ([Inline] -> Stringify e [Inline]
forall e a. a -> Stringify e a
Stringify @e [Inline]
lst)
inlineToCustom (Strong [Inline]
lst) = Name -> Stringify e [Inline] -> LuaE e String
forall e a. Invokable e a => Name -> a
invoke @e Name
"Strong" ([Inline] -> Stringify e [Inline]
forall e a. a -> Stringify e a
Stringify @e [Inline]
lst)
inlineToCustom (Strikeout [Inline]
lst) = Name -> Stringify e [Inline] -> LuaE e String
forall e a. Invokable e a => Name -> a
invoke @e Name
"Strikeout" ([Inline] -> Stringify e [Inline]
forall e a. a -> Stringify e a
Stringify @e [Inline]
lst)
inlineToCustom (Superscript [Inline]
lst) = Name -> Stringify e [Inline] -> LuaE e String
forall e a. Invokable e a => Name -> a
invoke @e Name
"Superscript" ([Inline] -> Stringify e [Inline]
forall e a. a -> Stringify e a
Stringify @e [Inline]
lst)
inlineToCustom (Subscript [Inline]
lst) = Name -> Stringify e [Inline] -> LuaE e String
forall e a. Invokable e a => Name -> a
invoke @e Name
"Subscript" ([Inline] -> Stringify e [Inline]
forall e a. a -> Stringify e a
Stringify @e [Inline]
lst)
inlineToCustom (SmallCaps [Inline]
lst) = Name -> Stringify e [Inline] -> LuaE e String
forall e a. Invokable e a => Name -> a
invoke @e Name
"SmallCaps" ([Inline] -> Stringify e [Inline]
forall e a. a -> Stringify e a
Stringify @e [Inline]
lst)
inlineToCustom (Quoted QuoteType
SingleQuote [Inline]
lst) =
Name -> Stringify e [Inline] -> LuaE e String
forall e a. Invokable e a => Name -> a
invoke @e Name
"SingleQuoted" ([Inline] -> Stringify e [Inline]
forall e a. a -> Stringify e a
Stringify @e [Inline]
lst)
inlineToCustom (Quoted QuoteType
DoubleQuote [Inline]
lst) =
Name -> Stringify e [Inline] -> LuaE e String
forall e a. Invokable e a => Name -> a
invoke @e Name
"DoubleQuoted" ([Inline] -> Stringify e [Inline]
forall e a. a -> Stringify e a
Stringify @e [Inline]
lst)
inlineToCustom (Cite [Citation]
cs [Inline]
lst) =
Name
-> Stringify e [Inline] -> [Stringify e Citation] -> LuaE e String
forall e a. Invokable e a => Name -> a
invoke @e Name
"Cite" ([Inline] -> Stringify e [Inline]
forall e a. a -> Stringify e a
Stringify @e [Inline]
lst) ((Citation -> Stringify e Citation)
-> [Citation] -> [Stringify e Citation]
forall a b. (a -> b) -> [a] -> [b]
map (forall a. a -> Stringify e a
forall e a. a -> Stringify e a
Stringify @e) [Citation]
cs)
inlineToCustom (Code Attr
attr Text
str) =
Name -> Text -> Map Text Text -> LuaE e String
forall e a. Invokable e a => Name -> a
invoke @e Name
"Code" Text
str (Attr -> Map Text Text
attrToMap Attr
attr)
inlineToCustom (Math MathType
DisplayMath Text
str) =
Name -> Text -> LuaE e String
forall e a. Invokable e a => Name -> a
invoke @e Name
"DisplayMath" Text
str
inlineToCustom (Math MathType
InlineMath Text
str) =
Name -> Text -> LuaE e String
forall e a. Invokable e a => Name -> a
invoke @e Name
"InlineMath" Text
str
inlineToCustom (RawInline Format
format Text
str) =
Name -> Stringify e Format -> Text -> LuaE e String
forall e a. Invokable e a => Name -> a
invoke @e Name
"RawInline" (Format -> Stringify e Format
forall e a. a -> Stringify e a
Stringify @e Format
format) Text
str
inlineToCustom Inline
LineBreak = Name -> LuaE e String
forall e a. Invokable e a => Name -> a
invoke @e Name
"LineBreak"
inlineToCustom (Link Attr
attr [Inline]
txt (Text
src,Text
tit)) =
Name
-> Stringify e [Inline]
-> Text
-> Text
-> Map Text Text
-> LuaE e String
forall e a. Invokable e a => Name -> a
invoke @e Name
"Link" ([Inline] -> Stringify e [Inline]
forall e a. a -> Stringify e a
Stringify @e [Inline]
txt) Text
src Text
tit (Attr -> Map Text Text
attrToMap Attr
attr)
inlineToCustom (Image Attr
attr [Inline]
alt (Text
src,Text
tit)) =
Name
-> Stringify e [Inline]
-> Text
-> Text
-> Map Text Text
-> LuaE e String
forall e a. Invokable e a => Name -> a
invoke @e Name
"Image" ([Inline] -> Stringify e [Inline]
forall e a. a -> Stringify e a
Stringify @e [Inline]
alt) Text
src Text
tit (Attr -> Map Text Text
attrToMap Attr
attr)
inlineToCustom (Note [Block]
contents) = Name -> Stringify e [Block] -> LuaE e String
forall e a. Invokable e a => Name -> a
invoke @e Name
"Note" ([Block] -> Stringify e [Block]
forall e a. a -> Stringify e a
Stringify @e [Block]
contents)
inlineToCustom (Span Attr
attr [Inline]
items) =
Name -> Stringify e [Inline] -> Map Text Text -> LuaE e String
forall e a. Invokable e a => Name -> a
invoke @e Name
"Span" ([Inline] -> Stringify e [Inline]
forall e a. a -> Stringify e a
Stringify @e [Inline]
items) (Attr -> Map Text Text
attrToMap Attr
attr)