{-# LANGUAGE LambdaCase          #-}
{-# LANGUAGE OverloadedStrings   #-}
{- |
   Module      : Text.Pandoc.Lua.Writer.Scaffolding
   Copyright   : © 2022-2023 Albert Krewinkel
   License     : GPL-2.0-or-later
   Maintainer  : Albert Krewinkel <pandoc@tarleb.com>

Conversion of Pandoc documents using a custom Lua writer.
-}
module Text.Pandoc.Lua.Writer.Scaffolding
  ( pushWriterScaffolding
  ) where

import Control.Monad ((<$!>), void)
import Data.ByteString (ByteString)
import Data.Data (dataTypeConstrs, dataTypeOf, showConstr, toConstr)
import Data.Default (def)
import Data.List (intersperse)
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import Data.String (IsString (fromString))
import HsLua
import HsLua.Module.DocLayout (peekDoc, pushDoc)
import Text.DocLayout (Doc, blankline, render)
import Text.DocTemplates (Context)
import Text.Pandoc.Definition
import Text.Pandoc.Error (PandocError (..))
import Text.Pandoc.Options (WriterOptions (..), WrapOption(..))
import Text.Pandoc.Lua.PandocLua ()
import Text.Pandoc.Lua.Marshal.AST
import Text.Pandoc.Lua.Marshal.Context (peekContext)
import Text.Pandoc.Lua.Marshal.WriterOptions ( peekWriterOptions
                                             , pushWriterOptions)
import Text.Pandoc.Templates (renderTemplate)
import Text.Pandoc.Writers.Shared (metaToContext, setField)
import qualified Data.Text as T
import qualified Text.Pandoc.UTF8 as UTF8

-- | Convert Pandoc to custom markup.
pushWriterScaffolding :: LuaE PandocError NumResults
pushWriterScaffolding :: LuaE PandocError NumResults
pushWriterScaffolding = do
  forall e. LuaE e ()
newtable
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> LuaE PandocError ()
pushWriterMT forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e. StackIndex -> LuaE e ()
setmetatable (CInt -> StackIndex
nth CInt
2)
  WriterTable
writer <- forall e. LuaError e => StackIndex -> LuaE e WriterTable
toWriterTable StackIndex
top
  forall e a. LuaError e => Name -> LuaE e a -> LuaE e ()
addField Name
"Blocks"  forall a b. (a -> b) -> a -> b
$ forall e. LuaError e => DocumentedFunction e -> LuaE e ()
pushDocumentedFunction (WriterTable -> DocumentedFunction PandocError
blocksFn WriterTable
writer)
  forall e a. LuaError e => Name -> LuaE e a -> LuaE e ()
addField Name
"Inlines" forall a b. (a -> b) -> a -> b
$ forall e. LuaError e => DocumentedFunction e -> LuaE e ()
pushDocumentedFunction (WriterTable -> DocumentedFunction PandocError
inlinesFn WriterTable
writer)
  forall e a. LuaError e => Name -> LuaE e a -> LuaE e ()
addField Name
"Block"   forall a b. (a -> b) -> a -> b
$ forall e. LuaE e ()
newtable forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> WriterTable -> LuaE PandocError ()
pushBlockMT  WriterTable
writer forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e. StackIndex -> LuaE e ()
setmetatable (CInt -> StackIndex
nth CInt
2)
  forall e a. LuaError e => Name -> LuaE e a -> LuaE e ()
addField Name
"Inline"  forall a b. (a -> b) -> a -> b
$ forall e. LuaE e ()
newtable forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> WriterTable -> LuaE PandocError ()
pushInlineMT WriterTable
writer forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e. StackIndex -> LuaE e ()
setmetatable (CInt -> StackIndex
nth CInt
2)
  forall e a. LuaError e => Name -> LuaE e a -> LuaE e ()
addField Name
"Pandoc"  forall a b. (a -> b) -> a -> b
$ forall e. LuaError e => DocumentedFunction e -> LuaE e ()
pushDocumentedFunction forall a b. (a -> b) -> a -> b
$ forall a e. a -> HsFnPrecursor e a
lambda
    ### (\(Pandoc _ blks) -> do
            pushWriterTable writer
            getfield' top "Blocks"
            pushBlocks blks
            callTrace 1 1
            pure (NumResults 1))
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter forall e. LuaError e => Peeker e Pandoc
peekPandoc TypeSpec
"Pandoc" Text
"doc" Text
""
    forall e.
HsFnPrecursor e (LuaE e NumResults) -> Text -> DocumentedFunction e
=?> Text
"rendered doc"
  forall e. WriterTable -> LuaE e ()
freeWriter WriterTable
writer
  forall (m :: * -> *) a. Monad m => a -> m a
return NumResults
1
 where
  blocksFn :: WriterTable -> DocumentedFunction PandocError
blocksFn WriterTable
w = forall a e. a -> HsFnPrecursor e a
lambda
    ### (\blocks msep -> blockListToCustom w msep blocks)
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter forall e. LuaError e => Peeker e [Block]
peekBlocks TypeSpec
"Blocks" Text
"blocks" Text
""
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Parameter e a -> Parameter e (Maybe a)
opt (forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter forall e. LuaError e => Peeker e (Doc Text)
peekDocFuzzy TypeSpec
"Doc" Text
"sep" Text
"")
    forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult forall e. LuaError e => Pusher e (Doc Text)
pushDoc TypeSpec
"Doc" Text
""
  inlinesFn :: WriterTable -> DocumentedFunction PandocError
inlinesFn WriterTable
w = forall a e. a -> HsFnPrecursor e a
lambda
    ### inlineListToCustom w
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter forall e. LuaError e => Peeker e [Inline]
peekInlines TypeSpec
"Inlines" Text
"inlines" Text
""
    forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult forall e. LuaError e => Pusher e (Doc Text)
pushDoc TypeSpec
"Doc" Text
""
  pushBlockMT :: WriterTable -> LuaE PandocError ()
pushBlockMT WriterTable
writer = do
    forall e. LuaE e ()
newtable
    forall e a. LuaError e => Name -> LuaE e a -> LuaE e ()
addField Name
"__call" forall a b. (a -> b) -> a -> b
$ forall e. LuaError e => DocumentedFunction e -> LuaE e ()
pushDocumentedFunction forall a b. (a -> b) -> a -> b
$ forall a e. a -> HsFnPrecursor e a
lambda
      ### blockToCustom
      forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter forall e. LuaError e => Peeker e WriterTable
peekWriter TypeSpec
"table" Text
"writer" Text
""
      forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter forall e. LuaError e => Peeker e Block
peekBlockFuzzy TypeSpec
"Block" Text
"block" Text
""
      forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult forall e. LuaError e => Pusher e (Doc Text)
pushDoc TypeSpec
"Doc" Text
"rendered blocks"
    forall e a. LuaError e => Name -> LuaE e a -> LuaE e ()
addField Name
"__index" forall a b. (a -> b) -> a -> b
$
      -- lookup missing fields in the main Writer table
      forall e. LuaError e => Pusher e WriterTable
pushWriterTable WriterTable
writer
  pushInlineMT :: WriterTable -> LuaE PandocError ()
pushInlineMT WriterTable
writer = do
    forall e. LuaE e ()
newtable
    forall e a. LuaError e => Name -> LuaE e a -> LuaE e ()
addField Name
"__call" forall a b. (a -> b) -> a -> b
$ forall e. LuaError e => DocumentedFunction e -> LuaE e ()
pushDocumentedFunction forall a b. (a -> b) -> a -> b
$ forall a e. a -> HsFnPrecursor e a
lambda
      ### inlineToCustom
      forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter forall e. LuaError e => Peeker e WriterTable
peekWriter TypeSpec
"table" Text
"writer" Text
""
      forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter forall e. LuaError e => Peeker e Inline
peekInlineFuzzy TypeSpec
"Inline" Text
"inline" Text
""
      forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult forall e. LuaError e => Pusher e (Doc Text)
pushDoc TypeSpec
"Doc" Text
"rendered inline"
    forall e a. LuaError e => Name -> LuaE e a -> LuaE e ()
addField Name
"__index" forall a b. (a -> b) -> a -> b
$ do
      -- lookup missing fields in the main Writer table
      forall e. LuaError e => Pusher e WriterTable
pushWriterTable WriterTable
writer

pushWriterMT :: LuaE PandocError ()
pushWriterMT :: LuaE PandocError ()
pushWriterMT = do
  forall e. LuaE e ()
newtable
  forall e a. LuaError e => Name -> LuaE e a -> LuaE e ()
addField Name
"__call" forall a b. (a -> b) -> a -> b
$ forall e. LuaError e => DocumentedFunction e -> LuaE e ()
pushDocumentedFunction forall a b. (a -> b) -> a -> b
$ forall a e. a -> HsFnPrecursor e a
lambda
    ### (\writer doc mopts -> runWriter writer doc mopts)
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter forall e. LuaError e => Peeker e WriterTable
peekWriter TypeSpec
"table" Text
"writer" Text
""
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter forall e. LuaError e => Peeker e Pandoc
peekPandoc TypeSpec
"Pandoc" Text
"doc" Text
""
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Parameter e a -> Parameter e (Maybe a)
opt (forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter Peeker PandocError WriterOptions
peekWriterOptions TypeSpec
"WriterOptions" Text
"opts" Text
"")
    forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult forall e. Pusher e Text
pushText TypeSpec
"string" Text
"rendered document"
  forall e a. LuaError e => Name -> LuaE e a -> LuaE e ()
addField Name
"__index" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. LuaError e => DocumentedFunction e -> LuaE e ()
pushDocumentedFunction forall a b. (a -> b) -> a -> b
$ forall a e. a -> HsFnPrecursor e a
lambda
    ### (\_writer key -> handleMissingField key)
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter forall (f :: * -> *) a. Applicative f => a -> f a
pure TypeSpec
"table"  Text
"writer" Text
""
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter (forall e a. LuaE e a -> Peek e a
liftLua forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. LuaError e => StackIndex -> LuaE e ByteString
tostring') TypeSpec
"string" Text
"key" Text
""
    forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult (forall a b. a -> b -> a
const forall e. LuaE e ()
pushnil) TypeSpec
"string" Text
""


addField :: LuaError e => Name -> LuaE e a -> LuaE e ()
addField :: forall e a. LuaError e => Name -> LuaE e a -> LuaE e ()
addField Name
name LuaE e a
action = do
  forall e. Name -> LuaE e ()
pushName Name
name
  LuaE e a
action
  forall e. LuaError e => StackIndex -> LuaE e ()
rawset (CInt -> StackIndex
nth CInt
3)

getfield' :: LuaError e => StackIndex -> Name -> LuaE e HsLua.Type
getfield' :: forall e. LuaError e => StackIndex -> Name -> LuaE e Type
getfield' StackIndex
idx Name
name = do
  StackIndex
aidx <- forall e. StackIndex -> LuaE e StackIndex
absindex StackIndex
idx
  forall e. Name -> LuaE e ()
pushName Name
name
  forall e. LuaError e => StackIndex -> LuaE e Type
rawget StackIndex
aidx forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Type
TypeNil -> forall e. Int -> LuaE e ()
pop Int
1 forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e. LuaError e => StackIndex -> Name -> LuaE e Type
getfield StackIndex
aidx Name
name
    Type
ty      -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Type
ty

-- | A writer table is just an absolute stack index.
newtype WriterTable = WriterTable Reference

toWriterTable :: LuaError e => StackIndex -> LuaE e WriterTable
toWriterTable :: forall e. LuaError e => StackIndex -> LuaE e WriterTable
toWriterTable StackIndex
idx = Reference -> WriterTable
WriterTable forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> do
  forall e. StackIndex -> LuaE e ()
pushvalue StackIndex
idx
  forall e. StackIndex -> LuaE e Reference
ref StackIndex
registryindex

peekWriter :: LuaError e => Peeker e WriterTable
peekWriter :: forall e. LuaError e => Peeker e WriterTable
peekWriter = forall e a. LuaE e a -> Peek e a
liftLua forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. LuaError e => StackIndex -> LuaE e WriterTable
toWriterTable

pushWriterTable :: LuaError e => Pusher e WriterTable
pushWriterTable :: forall e. LuaError e => Pusher e WriterTable
pushWriterTable (WriterTable Reference
wref) = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall e. LuaError e => StackIndex -> Reference -> LuaE e Type
getref StackIndex
registryindex Reference
wref

writerOptionsField :: Name
writerOptionsField :: Name
writerOptionsField = Name
"Pandoc Writer WriterOptions"

freeWriter :: WriterTable -> LuaE e ()
freeWriter :: forall e. WriterTable -> LuaE e ()
freeWriter (WriterTable Reference
wref) = forall e. StackIndex -> Reference -> LuaE e ()
unref StackIndex
registryindex Reference
wref

pushOpts :: LuaE PandocError ()
pushOpts :: LuaE PandocError ()
pushOpts = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall e. LuaError e => StackIndex -> Name -> LuaE e Type
getfield' StackIndex
registryindex Name
writerOptionsField

runWriter :: WriterTable -> Pandoc -> Maybe WriterOptions
          -> LuaE PandocError Text
runWriter :: WriterTable
-> Pandoc -> Maybe WriterOptions -> LuaE PandocError Text
runWriter WriterTable
writer doc :: Pandoc
doc@(Pandoc Meta
meta [Block]
_blks) Maybe WriterOptions
mopts = do
  let opts :: WriterOptions
opts = forall a. a -> Maybe a -> a
fromMaybe forall a. Default a => a
def Maybe WriterOptions
mopts
  Pusher PandocError WriterOptions
pushWriterOptions WriterOptions
opts forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
    forall e. LuaError e => StackIndex -> Name -> LuaE e ()
setfield StackIndex
registryindex Name
writerOptionsField

  (Doc Text
body, Maybe (Context Text)
mcontext) <- forall e a. Peek e a -> LuaE e (Result a)
runPeek (WriterTable
-> Pandoc -> Peek PandocError (Doc Text, Maybe (Context Text))
pandocToCustom WriterTable
writer Pandoc
doc) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall e a. LuaError e => Result a -> LuaE e a
force forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
    Failure ByteString
msg [Name]
contexts -> forall a. ByteString -> [Name] -> Result a
Failure (ByteString -> ByteString
cleanupTrace ByteString
msg) [Name]
contexts
    Result (Doc Text, Maybe (Context Text))
s -> Result (Doc Text, Maybe (Context Text))
s

  -- convert metavalues to a template context (variables)
  Context Text
defaultContext <- forall (m :: * -> *) a.
(Monad m, TemplateTarget a) =>
WriterOptions
-> ([Block] -> m (Doc a))
-> ([Inline] -> m (Doc a))
-> Meta
-> m (Context a)
metaToContext WriterOptions
opts
                    (WriterTable
-> Maybe (Doc Text) -> [Block] -> LuaE PandocError (Doc Text)
blockListToCustom WriterTable
writer forall a. Maybe a
Nothing)
                    (WriterTable -> [Inline] -> LuaE PandocError (Doc Text)
inlineListToCustom WriterTable
writer)
                    Meta
meta
  let context :: Context Text
context = forall a b. ToContext a b => Text -> b -> Context a -> Context a
setField Text
"body" Doc Text
body
              forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe Context Text
defaultContext Maybe (Context Text)
mcontext

  let colwidth :: Maybe Int
colwidth = if WriterOptions -> WrapOption
writerWrapText WriterOptions
opts forall a. Eq a => a -> a -> Bool
== WrapOption
WrapAuto
                    then forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ WriterOptions -> Int
writerColumns WriterOptions
opts
                    else forall a. Maybe a
Nothing

  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. HasChars a => Maybe Int -> Doc a -> a
render Maybe Int
colwidth forall a b. (a -> b) -> a -> b
$
    case WriterOptions -> Maybe (Template Text)
writerTemplate WriterOptions
opts of
       Maybe (Template Text)
Nothing  -> Doc Text
body
       Just Template Text
tpl -> forall a b.
(TemplateTarget a, ToContext a b) =>
Template a -> b -> Doc a
renderTemplate Template Text
tpl Context Text
context

-- | Keep exactly one traceback and clean it up. This wouldn't be
-- necessary if the @pcallTrace@ function would do nothing whenever the
-- error already included a trace, but that would require some bigger
-- changes; removing the additional traces in this post-process step is
-- much easier (for now).
cleanupTrace :: ByteString -> ByteString
cleanupTrace :: ByteString -> ByteString
cleanupTrace ByteString
msg = Text -> ByteString
UTF8.fromText forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
T.intercalate Text
"\n" forall a b. (a -> b) -> a -> b
$
  let tmsg :: [Text]
tmsg = Text -> [Text]
T.lines forall a b. (a -> b) -> a -> b
$ ByteString -> Text
UTF8.toText ByteString
msg
      traceStart :: Text -> Bool
traceStart = (forall a. Eq a => a -> a -> Bool
== Text
"stack traceback:")
  in case forall a. (a -> Bool) -> [a] -> ([a], [a])
break Text -> Bool
traceStart [Text]
tmsg of
        ([Text]
x, Text
t:[Text]
traces) -> ([Text]
x forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
tforall a. a -> [a] -> [a]
:) forall a b. (a -> b) -> a -> b
$
                         let ([Text]
firstTrace, [Text]
rest) = forall a. (a -> Bool) -> [a] -> ([a], [a])
break Text -> Bool
traceStart [Text]
traces
                             isPeekContext :: Text -> Bool
isPeekContext = (Text
"\twhile " Text -> Text -> Bool
`T.isPrefixOf`)
                             isUnknownCFn :: Text -> Bool
isUnknownCFn = (forall a. Eq a => a -> a -> Bool
== Text
"\t[C]: in ?")
                         in forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
isUnknownCFn) [Text]
firstTrace forall a. Semigroup a => a -> a -> a
<>
                            forall a. (a -> Bool) -> [a] -> [a]
filter Text -> Bool
isPeekContext [Text]
rest
        ([Text], [Text])
_ -> [Text]
tmsg

-- | Pushes the field in the writer table.
getWriterField :: LuaError e
               => WriterTable -> Name -> LuaE e HsLua.Type
getWriterField :: forall e. LuaError e => WriterTable -> Name -> LuaE e Type
getWriterField WriterTable
writer Name
name = do
  forall e. LuaError e => Pusher e WriterTable
pushWriterTable WriterTable
writer
  forall e. LuaError e => StackIndex -> Name -> LuaE e Type
getfield' StackIndex
top Name
name forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall e. StackIndex -> LuaE e ()
remove (CInt -> StackIndex
nth CInt
2)

-- | Looks up @Writer.subtable.field@; tries @Writer.field@ as a fallback if the
-- subtable field is @nil@.
getNestedWriterField :: LuaError e
                     => WriterTable -> Name -> Name -> LuaE e HsLua.Type
getNestedWriterField :: forall e. LuaError e => WriterTable -> Name -> Name -> LuaE e Type
getNestedWriterField WriterTable
writer Name
subtable Name
field = do
  forall e. LuaError e => Pusher e WriterTable
pushWriterTable WriterTable
writer
  forall e. LuaError e => StackIndex -> Name -> LuaE e Type
getfield' StackIndex
top Name
subtable forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Type
TypeNil -> Type
TypeNil forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall e. StackIndex -> LuaE e ()
remove (CInt -> StackIndex
nth CInt
2) -- remove Writer table
    Type
_       -> forall e. LuaError e => StackIndex -> Name -> LuaE e Type
getfield' StackIndex
top Name
field
               -- remove Writer and subtable
               forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall e. StackIndex -> LuaE e ()
remove (CInt -> StackIndex
nth CInt
3) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall e. StackIndex -> LuaE e ()
remove (CInt -> StackIndex
nth CInt
2)

pandocToCustom :: WriterTable -> Pandoc
               -> Peek PandocError (Doc Text, Maybe (Context Text))
pandocToCustom :: WriterTable
-> Pandoc -> Peek PandocError (Doc Text, Maybe (Context Text))
pandocToCustom WriterTable
writer Pandoc
doc = forall e a. Name -> Peek e a -> Peek e a
withContext Name
"rendering Pandoc" forall a b. (a -> b) -> a -> b
$ do
  Status
callStatus <- forall e a. LuaE e a -> Peek e a
liftLua forall a b. (a -> b) -> a -> b
$ do
    forall e. LuaError e => WriterTable -> Name -> LuaE e Type
getWriterField WriterTable
writer Name
"Pandoc"
    forall e. LuaError e => Pusher e Pandoc
pushPandoc Pandoc
doc
    LuaE PandocError ()
pushOpts
    forall e. NumArgs -> NumResults -> LuaE e Status
pcallTrace NumArgs
2 NumResults
2
  case Status
callStatus of
    Status
OK -> ((,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e. LuaError e => Peeker e (Doc Text)
peekDocFuzzy (CInt -> StackIndex
nth CInt
2) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall e a. Peeker e a -> Peeker e (Maybe a)
orNil forall e. LuaError e => Peeker e (Context Text)
peekContext StackIndex
top)
          forall e a b. Peek e a -> LuaE e b -> Peek e a
`lastly` forall e. Int -> LuaE e ()
pop Int
2
    Status
_  -> forall a e. ByteString -> Peek e a
failPeek forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall e a. LuaE e a -> Peek e a
liftLua (forall e. LuaError e => StackIndex -> LuaE e ByteString
tostring' StackIndex
top)

blockToCustom :: WriterTable -> Block -> LuaE PandocError (Doc Text)
blockToCustom :: WriterTable -> Block -> LuaE PandocError (Doc Text)
blockToCustom WriterTable
writer Block
blk = forall e a. LuaError e => Peek e a -> LuaE e a
forcePeek forall a b. (a -> b) -> a -> b
$ WriterTable -> Block -> Peek PandocError (Doc Text)
renderBlock WriterTable
writer Block
blk

renderBlock :: WriterTable -> Block -> Peek PandocError (Doc Text)
renderBlock :: WriterTable -> Block -> Peek PandocError (Doc Text)
renderBlock WriterTable
writer Block
blk = do
  let constrName :: Name
constrName = forall a. IsString a => String -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Constr -> String
showConstr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Data a => a -> Constr
toConstr forall a b. (a -> b) -> a -> b
$ Block
blk
  forall e a. Name -> Peek e a -> Peek e a
withContext (Name
"rendering Block `" forall a. Semigroup a => a -> a -> a
<> Name
constrName forall a. Semigroup a => a -> a -> a
<> Name
"`") forall a b. (a -> b) -> a -> b
$
    forall e a. LuaE e a -> Peek e a
liftLua (forall e. LuaError e => WriterTable -> Name -> Name -> LuaE e Type
getNestedWriterField WriterTable
writer Name
"Block" Name
constrName) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Type
TypeNil -> forall a e. ByteString -> Peek e a
failPeek forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall e. Name -> StackIndex -> Peek e ByteString
typeMismatchMessage Name
"function or Doc" StackIndex
top
      Type
_       -> LuaE PandocError () -> Peek PandocError (Doc Text)
callOrDoc (forall e. LuaError e => Pusher e Block
pushBlock Block
blk)

inlineToCustom :: WriterTable -> Inline -> LuaE PandocError (Doc Text)
inlineToCustom :: WriterTable -> Inline -> LuaE PandocError (Doc Text)
inlineToCustom WriterTable
writer Inline
inln = forall e a. LuaError e => Peek e a -> LuaE e a
forcePeek forall a b. (a -> b) -> a -> b
$ WriterTable -> Inline -> Peek PandocError (Doc Text)
renderInline WriterTable
writer Inline
inln

renderInline :: WriterTable -> Inline -> Peek PandocError (Doc Text)
renderInline :: WriterTable -> Inline -> Peek PandocError (Doc Text)
renderInline WriterTable
writer Inline
inln = do
  let constrName :: Name
constrName = forall a. IsString a => String -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Constr -> String
showConstr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Data a => a -> Constr
toConstr forall a b. (a -> b) -> a -> b
$ Inline
inln
  forall e a. Name -> Peek e a -> Peek e a
withContext (Name
"rendering Inline `" forall a. Semigroup a => a -> a -> a
<> Name
constrName forall a. Semigroup a => a -> a -> a
<> Name
"`") forall a b. (a -> b) -> a -> b
$ do
    forall e a. LuaE e a -> Peek e a
liftLua (forall e. LuaError e => WriterTable -> Name -> Name -> LuaE e Type
getNestedWriterField WriterTable
writer Name
"Inline" Name
constrName) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Type
TypeNil -> forall a e. ByteString -> Peek e a
failPeek forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall e. Name -> StackIndex -> Peek e ByteString
typeMismatchMessage Name
"function or Doc" StackIndex
top
      Type
_       -> LuaE PandocError () -> Peek PandocError (Doc Text)
callOrDoc (forall e. LuaError e => Pusher e Inline
pushInline Inline
inln)

-- | If the value at the top of the stack can be called as a function,
-- then push the element and writer options to the stack and call it;
-- otherwise treat it as a plain Doc value
callOrDoc :: LuaE PandocError ()
          -> Peek PandocError (Doc Text)
callOrDoc :: LuaE PandocError () -> Peek PandocError (Doc Text)
callOrDoc LuaE PandocError ()
pushElement = do
  forall e a. LuaE e a -> Peek e a
liftLua (forall e. StackIndex -> LuaE e Type
ltype StackIndex
top) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Type
TypeFunction -> Peek PandocError (Doc Text)
peekCall
    Type
_            ->
      forall e a. LuaE e a -> Peek e a
liftLua (forall e. StackIndex -> Name -> LuaE e Type
getmetafield StackIndex
top Name
"__call") forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Type
TypeNil -> forall e. LuaError e => Peeker e (Doc Text)
peekDocFuzzy StackIndex
top
        Type
_       -> forall e a. LuaE e a -> Peek e a
liftLua (forall e. Int -> LuaE e ()
pop Int
1) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Peek PandocError (Doc Text)
peekCall
 where
   peekCall :: Peek PandocError (Doc Text)
   peekCall :: Peek PandocError (Doc Text)
peekCall =
     forall e a. LuaE e a -> Peek e a
liftLua (LuaE PandocError ()
pushElement forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> LuaE PandocError ()
pushOpts forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e. NumArgs -> NumResults -> LuaE e Status
pcallTrace NumArgs
2 NumResults
1) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
       Status
OK -> forall e. LuaError e => Peeker e (Doc Text)
peekDocFuzzy StackIndex
top
       Status
_  -> forall a e. ByteString -> Peek e a
failPeek forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall e a. LuaE e a -> Peek e a
liftLua (forall e. LuaError e => StackIndex -> LuaE e ByteString
tostring' StackIndex
top)

blockListToCustom :: WriterTable -> Maybe (Doc Text) -> [Block]
                  -> LuaE PandocError (Doc Text)
blockListToCustom :: WriterTable
-> Maybe (Doc Text) -> [Block] -> LuaE PandocError (Doc Text)
blockListToCustom WriterTable
writer Maybe (Doc Text)
msep [Block]
blocks = forall e a. LuaError e => Peek e a -> LuaE e a
forcePeek forall a b. (a -> b) -> a -> b
$
  WriterTable
-> Maybe (Doc Text) -> [Block] -> Peek PandocError (Doc Text)
renderBlockList WriterTable
writer Maybe (Doc Text)
msep [Block]
blocks

inlineListToCustom :: WriterTable -> [Inline] -> LuaE PandocError (Doc Text)
inlineListToCustom :: WriterTable -> [Inline] -> LuaE PandocError (Doc Text)
inlineListToCustom WriterTable
writer [Inline]
inlines = forall e a. LuaError e => Peek e a -> LuaE e a
forcePeek forall a b. (a -> b) -> a -> b
$
  WriterTable -> [Inline] -> Peek PandocError (Doc Text)
renderInlineList WriterTable
writer [Inline]
inlines

renderBlockList :: WriterTable -> Maybe (Doc Text) -> [Block]
                -> Peek PandocError (Doc Text)
renderBlockList :: WriterTable
-> Maybe (Doc Text) -> [Block] -> Peek PandocError (Doc Text)
renderBlockList WriterTable
writer Maybe (Doc Text)
msep [Block]
blocks = forall e a. Name -> Peek e a -> Peek e a
withContext Name
"rendering Blocks" forall a b. (a -> b) -> a -> b
$ do
  let addSeps :: [Doc Text] -> [Doc Text]
addSeps = forall a. a -> [a] -> [a]
intersperse forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe forall a. Doc a
blankline Maybe (Doc Text)
msep
  forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc Text] -> [Doc Text]
addSeps forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (WriterTable -> Block -> Peek PandocError (Doc Text)
renderBlock WriterTable
writer) [Block]
blocks

renderInlineList :: WriterTable -> [Inline] -> Peek PandocError (Doc Text)
renderInlineList :: WriterTable -> [Inline] -> Peek PandocError (Doc Text)
renderInlineList WriterTable
writer [Inline]
inlines = forall e a. Name -> Peek e a -> Peek e a
withContext Name
"rendering Inlines" forall a b. (a -> b) -> a -> b
$ do
  forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (WriterTable -> Inline -> Peek PandocError (Doc Text)
renderInline WriterTable
writer) [Inline]
inlines

orNil :: Peeker e a -> Peeker e (Maybe a)
orNil :: forall e a. Peeker e a -> Peeker e (Maybe a)
orNil Peeker e a
p StackIndex
idx = forall e a. LuaE e a -> Peek e a
liftLua (forall e. StackIndex -> LuaE e Type
ltype StackIndex
idx) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Type
TypeNil  -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
  Type
TypeNone -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
  Type
_        -> forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Peeker e a
p StackIndex
idx

peekDocFuzzy :: LuaError e => Peeker e (Doc Text)
peekDocFuzzy :: forall e. LuaError e => Peeker e (Doc Text)
peekDocFuzzy StackIndex
idx = forall e a. LuaE e a -> Peek e a
liftLua (forall e. StackIndex -> LuaE e Type
ltype StackIndex
idx) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Type
TypeTable -> forall a. Monoid a => [a] -> a
mconcat forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList forall e. LuaError e => Peeker e (Doc Text)
peekDoc StackIndex
idx
  Type
_         -> forall e. LuaError e => Peeker e (Doc Text)
peekDoc StackIndex
idx

handleMissingField :: LuaError e => ByteString -> LuaE e ()
handleMissingField :: forall e. LuaError e => ByteString -> LuaE e ()
handleMissingField ByteString
key' =
  let key :: String
key = ByteString -> String
UTF8.toString ByteString
key'
      blockNames :: [String]
blockNames  = forall a b. (a -> b) -> [a] -> [b]
map (forall a. IsString a => String -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) forall b c a. (b -> c) -> (a -> b) -> a -> c
. DataType -> [Constr]
dataTypeConstrs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Data a => a -> DataType
dataTypeOf
                      forall a b. (a -> b) -> a -> b
$ Block
HorizontalRule
      inlineNames :: [String]
inlineNames = forall a b. (a -> b) -> [a] -> [b]
map (forall a. IsString a => String -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) forall b c a. (b -> c) -> (a -> b) -> a -> c
. DataType -> [Constr]
dataTypeConstrs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Data a => a -> DataType
dataTypeOf
                      forall a b. (a -> b) -> a -> b
$ Inline
Space
      mtypeName :: Maybe String
mtypeName = case () of
       ()
_ | String
key forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
blockNames  -> forall a. a -> Maybe a
Just String
"Block"
       ()
_ | String
key forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
inlineNames -> forall a. a -> Maybe a
Just String
"Inline"
       ()
_                          -> forall a. Maybe a
Nothing
  in case Maybe String
mtypeName of
       Just String
typeName  -> forall e a. LuaError e => String -> LuaE e a
failLua forall a b. (a -> b) -> a -> b
$
                         String
"No render function for " forall a. Semigroup a => a -> a -> a
<> String
typeName forall a. Semigroup a => a -> a -> a
<> String
" value " forall a. Semigroup a => a -> a -> a
<>
                         String
"'" forall a. Semigroup a => a -> a -> a
<> String
key forall a. Semigroup a => a -> a -> a
<> String
"';\ndefine a function `Writer." forall a. Semigroup a => a -> a -> a
<>
                         String
typeName forall a. Semigroup a => a -> a -> a
<> String
"." forall a. Semigroup a => a -> a -> a
<> String
key forall a. Semigroup a => a -> a -> a
<> String
"` that returns " forall a. Semigroup a => a -> a -> a
<>
                         String
"a string or Doc."
       Maybe String
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()