{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
module Text.Pandoc.Lua.Writer.Classic
( runCustom
) where
import Control.Applicative (optional)
import Control.Arrow ((***))
import Data.List (intersperse)
import Data.Maybe (fromMaybe)
import qualified Data.Text as T
import Data.Text (Text, pack)
import HsLua as Lua hiding (Operation (Div))
#if !MIN_VERSION_hslua(2,2,0)
import HsLua.Aeson (peekViaJSON)
#endif
import Text.DocLayout (literal, render)
import Text.DocTemplates (Context)
import Text.Pandoc.Definition
import Text.Pandoc.Lua.Marshal.Attr (pushAttributeList)
import Text.Pandoc.Lua.Orphans ()
import Text.Pandoc.Options
import Text.Pandoc.Templates (renderTemplate)
import Text.Pandoc.Writers.Shared
newtype AttributeList = AttributeList [(Text, Text)]
instance Pushable AttributeList where
push :: forall e. LuaError e => AttributeList -> LuaE e ()
push (AttributeList [(Text, Text)]
kvs) = forall e. LuaError e => Pusher e [(Text, Text)]
pushAttributeList [(Text, Text)]
kvs
attrToMap :: Attr -> AttributeList
attrToMap :: Attr -> AttributeList
attrToMap (Text
id',[Text]
classes,[(Text, Text)]
keyvals) = [(Text, Text)] -> AttributeList
AttributeList
forall a b. (a -> b) -> a -> b
$ (Text
"id", Text
id')
forall a. a -> [a] -> [a]
: (Text
"class", [Text] -> Text
T.unwords [Text]
classes)
forall a. a -> [a] -> [a]
: [(Text, Text)]
keyvals
newtype Stringify a = Stringify a
instance Pushable (Stringify Format) where
push :: forall e. LuaError e => Stringify Format -> LuaE e ()
push (Stringify (Format Text
f)) = forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
Lua.push (Text -> Text
T.toLower Text
f)
instance Pushable (Stringify [Inline]) where
push :: forall e. LuaError e => Stringify [Inline] -> LuaE e ()
push (Stringify [Inline]
ils) = forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
Lua.push forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall e. LuaError e => [Inline] -> LuaE e String
inlineListToCustom [Inline]
ils
instance Pushable (Stringify [Block]) where
push :: forall e. LuaError e => Stringify [Block] -> LuaE e ()
push (Stringify [Block]
blks) = forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
Lua.push forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall e. LuaError e => [Block] -> LuaE e String
blockListToCustom [Block]
blks
instance Pushable (Stringify MetaValue) where
push :: forall e. LuaError e => Stringify MetaValue -> LuaE e ()
push (Stringify (MetaMap Map Text MetaValue
m)) = forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
Lua.push (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Stringify a
Stringify Map Text MetaValue
m)
push (Stringify (MetaList [MetaValue]
xs)) = forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
Lua.push (forall a b. (a -> b) -> [a] -> [b]
map forall a. a -> Stringify a
Stringify [MetaValue]
xs)
push (Stringify (MetaBool Bool
x)) = forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
Lua.push Bool
x
push (Stringify (MetaString Text
s)) = forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
Lua.push Text
s
push (Stringify (MetaInlines [Inline]
ils)) = forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
Lua.push (forall a. a -> Stringify a
Stringify [Inline]
ils)
push (Stringify (MetaBlocks [Block]
bs)) = forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
Lua.push (forall a. a -> Stringify a
Stringify [Block]
bs)
instance Pushable (Stringify Citation) where
push :: forall e. LuaError e => Stringify Citation -> LuaE e ()
push (Stringify Citation
cit) = forall e a.
LuaError e =>
[(Name, a -> LuaE e ())] -> a -> LuaE e ()
pushAsTable
[ (Name
"citationId", forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
push forall b c a. (b -> c) -> (a -> b) -> a -> c
. Citation -> Text
citationId)
, (Name
"citationPrefix", forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
push forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Stringify a
Stringify forall b c a. (b -> c) -> (a -> b) -> a -> c
. Citation -> [Inline]
citationPrefix)
, (Name
"citationSuffix", forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
push forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Stringify a
Stringify forall b c a. (b -> c) -> (a -> b) -> a -> c
. Citation -> [Inline]
citationSuffix)
, (Name
"citationMode", forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
push forall b c a. (b -> c) -> (a -> b) -> a -> c
. Citation -> CitationMode
citationMode)
, (Name
"citationNoteNum", forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
push forall b c a. (b -> c) -> (a -> b) -> a -> c
. Citation -> Int
citationNoteNum)
, (Name
"citationHash", forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
push forall b c a. (b -> c) -> (a -> b) -> a -> c
. Citation -> Int
citationHash)
]
Citation
cit
newtype KeyValue a b = KeyValue (a, b)
instance (Pushable a, Pushable b) => Pushable (KeyValue a b) where
push :: forall e. LuaError e => KeyValue a b -> LuaE e ()
push (KeyValue (a
k, b
v)) = do
forall e. LuaE e ()
Lua.newtable
forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
Lua.push a
k
forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
Lua.push b
v
forall e. LuaError e => StackIndex -> LuaE e ()
Lua.rawset (CInt -> StackIndex
Lua.nth CInt
3)
runCustom :: LuaError e
=> WriterOptions
-> Pandoc
-> LuaE e Text
runCustom :: forall e. LuaError e => WriterOptions -> Pandoc -> LuaE e Text
runCustom WriterOptions
opts doc :: Pandoc
doc@(Pandoc Meta
meta [Block]
_) = do
(Text
body, Context Text
context) <- forall e.
LuaError e =>
WriterOptions -> Pandoc -> LuaE e (Text, Context Text)
docToCustom WriterOptions
opts Pandoc
doc
Context Text
metaContext <- forall (m :: * -> *) a.
(Monad m, TemplateTarget a) =>
WriterOptions
-> ([Block] -> m (Doc a))
-> ([Inline] -> m (Doc a))
-> Meta
-> m (Context a)
metaToContext WriterOptions
opts
(forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. HasChars a => a -> Doc a
literal forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. LuaError e => [Block] -> LuaE e String
blockListToCustom)
(forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. HasChars a => a -> Doc a
literal forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. LuaError e => [Inline] -> LuaE e String
inlineListToCustom)
Meta
meta
let renderContext :: Context Text
renderContext = Context Text
context forall a. Semigroup a => a -> a -> a
<> Context Text
metaContext
forall (m :: * -> *) a. Monad m => a -> m a
return 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 -> forall a. HasChars a => Maybe Int -> Doc a -> a
render forall a. Maybe a
Nothing forall a b. (a -> b) -> a -> b
$
forall a b.
(TemplateTarget a, ToContext a b) =>
Template a -> b -> Doc a
renderTemplate Template Text
tpl forall a b. (a -> b) -> a -> b
$ forall a b. ToContext a b => Text -> b -> Context a -> Context a
setField Text
"body" Text
body Context Text
renderContext
docToCustom :: forall e. LuaError e
=> WriterOptions -> Pandoc -> LuaE e (Text, Context Text)
docToCustom :: forall e.
LuaError e =>
WriterOptions -> Pandoc -> LuaE e (Text, Context Text)
docToCustom WriterOptions
opts (Pandoc (Meta Map Text MetaValue
metamap) [Block]
blocks) = do
String
body <- forall e. LuaError e => [Block] -> LuaE e String
blockListToCustom [Block]
blocks
forall e. LuaError e => Name -> LuaE e Type
Lua.getglobal Name
"Doc"
forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
push String
body
forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
push (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Stringify a
Stringify Map Text MetaValue
metamap)
forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
push (WriterOptions -> Context Text
writerVariables WriterOptions
opts)
forall e. LuaError e => NumArgs -> NumResults -> LuaE e ()
call NumArgs
3 NumResults
2
Text
rendered <- forall a e. (LuaError e, Peekable a) => StackIndex -> LuaE e a
peek (CInt -> StackIndex
nth CInt
2)
Maybe (Context Text)
context <- forall e a. LuaError e => Peek e a -> LuaE e a
forcePeek forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall a b. (a -> b) -> a -> b
$ forall a e. (FromJSON a, LuaError e) => Peeker e a
peekViaJSON StackIndex
top
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
rendered, forall a. a -> Maybe a -> a
fromMaybe forall a. Monoid a => a
mempty Maybe (Context Text)
context)
blockToCustom :: forall e. LuaError e
=> Block
-> LuaE e String
blockToCustom :: forall e. LuaError e => Block -> LuaE e String
blockToCustom (Plain [Inline]
inlines) = forall a. Invokable a => Name -> a
invoke Name
"Plain" (forall a. a -> Stringify a
Stringify [Inline]
inlines)
blockToCustom (Para [Image Attr
attr [Inline]
txt (Text
src,Text
tit)]) =
forall a. Invokable a => Name -> a
invoke Name
"CaptionedImage" Text
src Text
tit (forall a. a -> Stringify a
Stringify [Inline]
txt) (Attr -> AttributeList
attrToMap Attr
attr)
blockToCustom (Para [Inline]
inlines) = forall a. Invokable a => Name -> a
invoke Name
"Para" (forall a. a -> Stringify a
Stringify [Inline]
inlines)
blockToCustom (LineBlock [[Inline]]
linesList) =
forall a. Invokable a => Name -> a
invoke Name
"LineBlock" (forall a b. (a -> b) -> [a] -> [b]
map (forall a. a -> Stringify a
Stringify) [[Inline]]
linesList)
blockToCustom (RawBlock Format
format Text
str) =
forall a. Invokable a => Name -> a
invoke Name
"RawBlock" (forall a. a -> Stringify a
Stringify Format
format) Text
str
blockToCustom Block
HorizontalRule = forall a. Invokable a => Name -> a
invoke Name
"HorizontalRule"
blockToCustom (Header Int
level Attr
attr [Inline]
inlines) =
forall a. Invokable a => Name -> a
invoke Name
"Header" Int
level (forall a. a -> Stringify a
Stringify [Inline]
inlines) (Attr -> AttributeList
attrToMap Attr
attr)
blockToCustom (CodeBlock Attr
attr Text
str) =
forall a. Invokable a => Name -> a
invoke Name
"CodeBlock" Text
str (Attr -> AttributeList
attrToMap Attr
attr)
blockToCustom (BlockQuote [Block]
blocks) =
forall a. Invokable a => Name -> a
invoke Name
"BlockQuote" (forall a. a -> Stringify a
Stringify [Block]
blocks)
blockToCustom (Figure Attr
attr (Caption Maybe [Inline]
_ [Block]
cbody) [Block]
content) =
forall a. Invokable a => Name -> a
invoke Name
"Figure"
(forall a. a -> Stringify a
Stringify [Block]
cbody)
(forall a. a -> Stringify a
Stringify [Block]
content)
(Attr -> AttributeList
attrToMap Attr
attr)
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' = forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> String
show [Alignment]
aligns
capt' :: Stringify [Inline]
capt' = forall a. a -> Stringify a
Stringify [Inline]
capt
headers' :: [Stringify [Block]]
headers' = forall a b. (a -> b) -> [a] -> [b]
map (forall a. a -> Stringify a
Stringify) [[Block]]
headers
rows' :: [[Stringify [Block]]]
rows' = forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a -> b) -> [a] -> [b]
map (forall a. a -> Stringify a
Stringify)) [[[Block]]]
rows
in forall a. Invokable a => Name -> a
invoke Name
"Table" Stringify [Inline]
capt' [String]
aligns' [Double]
widths [Stringify [Block]]
headers' [[Stringify [Block]]]
rows'
blockToCustom (BulletList [[Block]]
items) =
forall a. Invokable a => Name -> a
invoke Name
"BulletList" (forall a b. (a -> b) -> [a] -> [b]
map (forall a. a -> Stringify a
Stringify) [[Block]]
items)
blockToCustom (OrderedList (Int
num,ListNumberStyle
sty,ListNumberDelim
delim) [[Block]]
items) =
forall a. Invokable a => Name -> a
invoke Name
"OrderedList" (forall a b. (a -> b) -> [a] -> [b]
map (forall a. a -> Stringify a
Stringify) [[Block]]
items) Int
num (forall a. Show a => a -> String
show ListNumberStyle
sty) (forall a. Show a => a -> String
show ListNumberDelim
delim)
blockToCustom (DefinitionList [([Inline], [[Block]])]
items) =
forall a. Invokable a => Name -> a
invoke Name
"DefinitionList"
(forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a, b) -> KeyValue a b
KeyValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> Stringify a
Stringify forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** forall a b. (a -> b) -> [a] -> [b]
map (forall a. a -> Stringify a
Stringify))) [([Inline], [[Block]])]
items)
blockToCustom (Div Attr
attr [Block]
items) =
forall a. Invokable a => Name -> a
invoke Name
"Div" (forall a. a -> Stringify a
Stringify [Block]
items) (Attr -> AttributeList
attrToMap Attr
attr)
blockListToCustom :: forall e. LuaError e
=> [Block]
-> LuaE e String
blockListToCustom :: forall e. LuaError e => [Block] -> LuaE e String
blockListToCustom [Block]
xs = do
String
blocksep <- forall a. Invokable a => Name -> a
invoke Name
"Blocksep"
[String]
bs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall e. LuaError e => Block -> LuaE e String
blockToCustom [Block]
xs
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a. a -> [a] -> [a]
intersperse String
blocksep [String]
bs
inlineListToCustom :: forall e. LuaError e => [Inline] -> LuaE e String
inlineListToCustom :: forall e. LuaError e => [Inline] -> LuaE e String
inlineListToCustom [Inline]
lst = do
[String]
xs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall e. LuaError e => Inline -> LuaE e String
inlineToCustom @e) [Inline]
lst
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat [String]
xs
inlineToCustom :: forall e. LuaError e => Inline -> LuaE e String
inlineToCustom :: forall e. LuaError e => Inline -> LuaE e String
inlineToCustom (Str Text
str) = forall a. Invokable a => Name -> a
invoke Name
"Str" Text
str
inlineToCustom Inline
Space = forall a. Invokable a => Name -> a
invoke Name
"Space"
inlineToCustom Inline
SoftBreak = forall a. Invokable a => Name -> a
invoke Name
"SoftBreak"
inlineToCustom (Emph [Inline]
lst) = forall a. Invokable a => Name -> a
invoke Name
"Emph" (forall a. a -> Stringify a
Stringify [Inline]
lst)
inlineToCustom (Underline [Inline]
lst) = forall a. Invokable a => Name -> a
invoke Name
"Underline" (forall a. a -> Stringify a
Stringify [Inline]
lst)
inlineToCustom (Strong [Inline]
lst) = forall a. Invokable a => Name -> a
invoke Name
"Strong" (forall a. a -> Stringify a
Stringify [Inline]
lst)
inlineToCustom (Strikeout [Inline]
lst) = forall a. Invokable a => Name -> a
invoke Name
"Strikeout" (forall a. a -> Stringify a
Stringify [Inline]
lst)
inlineToCustom (Superscript [Inline]
lst) = forall a. Invokable a => Name -> a
invoke Name
"Superscript" (forall a. a -> Stringify a
Stringify [Inline]
lst)
inlineToCustom (Subscript [Inline]
lst) = forall a. Invokable a => Name -> a
invoke Name
"Subscript" (forall a. a -> Stringify a
Stringify [Inline]
lst)
inlineToCustom (SmallCaps [Inline]
lst) = forall a. Invokable a => Name -> a
invoke Name
"SmallCaps" (forall a. a -> Stringify a
Stringify [Inline]
lst)
inlineToCustom (Quoted QuoteType
SingleQuote [Inline]
lst) =
forall a. Invokable a => Name -> a
invoke Name
"SingleQuoted" (forall a. a -> Stringify a
Stringify [Inline]
lst)
inlineToCustom (Quoted QuoteType
DoubleQuote [Inline]
lst) =
forall a. Invokable a => Name -> a
invoke Name
"DoubleQuoted" (forall a. a -> Stringify a
Stringify [Inline]
lst)
inlineToCustom (Cite [Citation]
cs [Inline]
lst) =
forall a. Invokable a => Name -> a
invoke Name
"Cite" (forall a. a -> Stringify a
Stringify [Inline]
lst) (forall a b. (a -> b) -> [a] -> [b]
map (forall a. a -> Stringify a
Stringify) [Citation]
cs)
inlineToCustom (Code Attr
attr Text
str) =
forall a. Invokable a => Name -> a
invoke Name
"Code" Text
str (Attr -> AttributeList
attrToMap Attr
attr)
inlineToCustom (Math MathType
DisplayMath Text
str) =
forall a. Invokable a => Name -> a
invoke Name
"DisplayMath" Text
str
inlineToCustom (Math MathType
InlineMath Text
str) =
forall a. Invokable a => Name -> a
invoke Name
"InlineMath" Text
str
inlineToCustom (RawInline Format
format Text
str) =
forall a. Invokable a => Name -> a
invoke Name
"RawInline" (forall a. a -> Stringify a
Stringify Format
format) Text
str
inlineToCustom Inline
LineBreak = forall a. Invokable a => Name -> a
invoke Name
"LineBreak"
inlineToCustom (Link Attr
attr [Inline]
txt (Text
src,Text
tit)) =
forall a. Invokable a => Name -> a
invoke Name
"Link" (forall a. a -> Stringify a
Stringify [Inline]
txt) Text
src Text
tit (Attr -> AttributeList
attrToMap Attr
attr)
inlineToCustom (Image Attr
attr [Inline]
alt (Text
src,Text
tit)) =
forall a. Invokable a => Name -> a
invoke Name
"Image" (forall a. a -> Stringify a
Stringify [Inline]
alt) Text
src Text
tit (Attr -> AttributeList
attrToMap Attr
attr)
inlineToCustom (Note [Block]
contents) = forall a. Invokable a => Name -> a
invoke Name
"Note" (forall a. a -> Stringify a
Stringify [Block]
contents)
inlineToCustom (Span Attr
attr [Inline]
items) =
forall a. Invokable a => Name -> a
invoke Name
"Span" (forall a. a -> Stringify a
Stringify [Inline]
items) (Attr -> AttributeList
attrToMap Attr
attr)