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

pushWriterMT :: LuaE PandocError ()
pushWriterMT :: LuaE PandocError ()
pushWriterMT = do
  LuaE PandocError ()
forall e. LuaE e ()
newtable
  Name -> LuaE PandocError () -> LuaE PandocError ()
forall e a. LuaError e => Name -> LuaE e a -> LuaE e ()
addField Name
"__call" (LuaE PandocError () -> LuaE PandocError ())
-> LuaE PandocError () -> LuaE PandocError ()
forall a b. (a -> b) -> a -> b
$ DocumentedFunction PandocError -> LuaE PandocError ()
forall e. LuaError e => DocumentedFunction e -> LuaE e ()
pushDocumentedFunction (DocumentedFunction PandocError -> LuaE PandocError ())
-> DocumentedFunction PandocError -> LuaE PandocError ()
forall a b. (a -> b) -> a -> b
$ (WriterTable
 -> Pandoc -> Maybe WriterOptions -> LuaE PandocError Text)
-> HsFnPrecursor
     PandocError
     (WriterTable
      -> Pandoc -> Maybe WriterOptions -> LuaE PandocError Text)
forall a e. a -> HsFnPrecursor e a
lambda
    ### (\writer doc mopts -> runWriter writer doc mopts)
    HsFnPrecursor
  PandocError
  (WriterTable
   -> Pandoc -> Maybe WriterOptions -> LuaE PandocError Text)
-> Parameter PandocError WriterTable
-> HsFnPrecursor
     PandocError
     (Pandoc -> Maybe WriterOptions -> LuaE PandocError Text)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker PandocError WriterTable
-> TypeSpec -> Text -> Text -> Parameter PandocError WriterTable
forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter Peeker PandocError WriterTable
forall e. LuaError e => Peeker e WriterTable
peekWriter TypeSpec
"table" Text
"writer" Text
""
    HsFnPrecursor
  PandocError
  (Pandoc -> Maybe WriterOptions -> LuaE PandocError Text)
-> Parameter PandocError Pandoc
-> HsFnPrecursor
     PandocError (Maybe WriterOptions -> LuaE PandocError Text)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker PandocError Pandoc
-> TypeSpec -> Text -> Text -> Parameter PandocError Pandoc
forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter Peeker PandocError Pandoc
forall e. LuaError e => Peeker e Pandoc
peekPandoc TypeSpec
"Pandoc" Text
"doc" Text
""
    HsFnPrecursor
  PandocError (Maybe WriterOptions -> LuaE PandocError Text)
-> Parameter PandocError (Maybe WriterOptions)
-> HsFnPrecursor PandocError (LuaE PandocError Text)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Parameter PandocError WriterOptions
-> Parameter PandocError (Maybe WriterOptions)
forall e a. Parameter e a -> Parameter e (Maybe a)
opt (Peeker PandocError WriterOptions
-> TypeSpec -> Text -> Text -> Parameter PandocError WriterOptions
forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter Peeker PandocError WriterOptions
peekWriterOptions TypeSpec
"WriterOptions" Text
"opts" Text
"")
    HsFnPrecursor PandocError (LuaE PandocError Text)
-> FunctionResults PandocError Text
-> DocumentedFunction PandocError
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Pusher PandocError Text
-> TypeSpec -> Text -> FunctionResults PandocError Text
forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult Pusher PandocError Text
forall e. Pusher e Text
pushText TypeSpec
"string" Text
"rendered document"
  Name -> LuaE PandocError () -> LuaE PandocError ()
forall e a. LuaError e => Name -> LuaE e a -> LuaE e ()
addField Name
"__index" (LuaE PandocError () -> LuaE PandocError ())
-> (DocumentedFunction PandocError -> LuaE PandocError ())
-> DocumentedFunction PandocError
-> LuaE PandocError ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DocumentedFunction PandocError -> LuaE PandocError ()
forall e. LuaError e => DocumentedFunction e -> LuaE e ()
pushDocumentedFunction (DocumentedFunction PandocError -> LuaE PandocError ())
-> DocumentedFunction PandocError -> LuaE PandocError ()
forall a b. (a -> b) -> a -> b
$ (StackIndex -> ByteString -> LuaE PandocError ())
-> HsFnPrecursor
     PandocError (StackIndex -> ByteString -> LuaE PandocError ())
forall a e. a -> HsFnPrecursor e a
lambda
    ### (\_writer key -> handleMissingField key)
    HsFnPrecursor
  PandocError (StackIndex -> ByteString -> LuaE PandocError ())
-> Parameter PandocError StackIndex
-> HsFnPrecursor PandocError (ByteString -> LuaE PandocError ())
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker PandocError StackIndex
-> TypeSpec -> Text -> Text -> Parameter PandocError StackIndex
forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter Peeker PandocError StackIndex
forall a. a -> Peek PandocError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TypeSpec
"table"  Text
"writer" Text
""
    HsFnPrecursor PandocError (ByteString -> LuaE PandocError ())
-> Parameter PandocError ByteString
-> HsFnPrecursor PandocError (LuaE PandocError ())
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker PandocError ByteString
-> TypeSpec -> Text -> Text -> Parameter PandocError ByteString
forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter (LuaE PandocError ByteString -> Peek PandocError ByteString
forall e a. LuaE e a -> Peek e a
liftLua (LuaE PandocError ByteString -> Peek PandocError ByteString)
-> (StackIndex -> LuaE PandocError ByteString)
-> Peeker PandocError ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackIndex -> LuaE PandocError ByteString
forall e. LuaError e => StackIndex -> LuaE e ByteString
tostring') TypeSpec
"string" Text
"key" Text
""
    HsFnPrecursor PandocError (LuaE PandocError ())
-> FunctionResults PandocError () -> DocumentedFunction PandocError
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Pusher PandocError ()
-> TypeSpec -> Text -> FunctionResults PandocError ()
forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult (LuaE PandocError () -> Pusher PandocError ()
forall a b. a -> b -> a
const LuaE PandocError ()
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
  Name -> LuaE e ()
forall e. Name -> LuaE e ()
pushName Name
name
  LuaE e a
action
  StackIndex -> LuaE e ()
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 <- StackIndex -> LuaE e StackIndex
forall e. StackIndex -> LuaE e StackIndex
absindex StackIndex
idx
  Name -> LuaE e ()
forall e. Name -> LuaE e ()
pushName Name
name
  StackIndex -> LuaE e Type
forall e. LuaError e => StackIndex -> LuaE e Type
rawget StackIndex
aidx LuaE e Type -> (Type -> LuaE e Type) -> LuaE e Type
forall a b. LuaE e a -> (a -> LuaE e b) -> LuaE e b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Type
TypeNil -> Int -> LuaE e ()
forall e. Int -> LuaE e ()
pop Int
1 LuaE e () -> LuaE e Type -> LuaE e Type
forall a b. LuaE e a -> LuaE e b -> LuaE e b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> StackIndex -> Name -> LuaE e Type
forall e. LuaError e => StackIndex -> Name -> LuaE e Type
getfield StackIndex
aidx Name
name
    Type
ty      -> Type -> LuaE e Type
forall a. a -> LuaE e a
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 (Reference -> WriterTable)
-> LuaE e Reference -> LuaE e WriterTable
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> do
  StackIndex -> LuaE e ()
forall e. StackIndex -> LuaE e ()
pushvalue StackIndex
idx
  StackIndex -> LuaE e Reference
forall e. StackIndex -> LuaE e Reference
ref StackIndex
registryindex

peekWriter :: LuaError e => Peeker e WriterTable
peekWriter :: forall e. LuaError e => Peeker e WriterTable
peekWriter = LuaE e WriterTable -> Peek e WriterTable
forall e a. LuaE e a -> Peek e a
liftLua (LuaE e WriterTable -> Peek e WriterTable)
-> (StackIndex -> LuaE e WriterTable)
-> StackIndex
-> Peek e WriterTable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackIndex -> LuaE e WriterTable
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) = LuaE e Type -> LuaE e ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (LuaE e Type -> LuaE e ()) -> LuaE e Type -> LuaE e ()
forall a b. (a -> b) -> a -> b
$ StackIndex -> Reference -> LuaE e Type
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) = StackIndex -> Reference -> LuaE e ()
forall e. StackIndex -> Reference -> LuaE e ()
unref StackIndex
registryindex Reference
wref

pushOpts :: LuaE PandocError ()
pushOpts :: LuaE PandocError ()
pushOpts = LuaE PandocError Type -> LuaE PandocError ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (LuaE PandocError Type -> LuaE PandocError ())
-> LuaE PandocError Type -> LuaE PandocError ()
forall a b. (a -> b) -> a -> b
$ StackIndex -> Name -> LuaE PandocError Type
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 = WriterOptions -> Maybe WriterOptions -> WriterOptions
forall a. a -> Maybe a -> a
fromMaybe WriterOptions
forall a. Default a => a
def Maybe WriterOptions
mopts
  Pusher PandocError WriterOptions
pushWriterOptions WriterOptions
opts LuaE PandocError () -> LuaE PandocError () -> LuaE PandocError ()
forall a b.
LuaE PandocError a -> LuaE PandocError b -> LuaE PandocError b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
    StackIndex -> Name -> LuaE PandocError ()
forall e. LuaError e => StackIndex -> Name -> LuaE e ()
setfield StackIndex
registryindex Name
writerOptionsField

  (Doc Text
body, Maybe (Context Text)
mcontext) <- Peek PandocError (Doc Text, Maybe (Context Text))
-> LuaE PandocError (Result (Doc Text, Maybe (Context Text)))
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) LuaE PandocError (Result (Doc Text, Maybe (Context Text)))
-> (Result (Doc Text, Maybe (Context Text))
    -> LuaE PandocError (Doc Text, Maybe (Context Text)))
-> LuaE PandocError (Doc Text, Maybe (Context Text))
forall a b.
LuaE PandocError a
-> (a -> LuaE PandocError b) -> LuaE PandocError b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Result (Doc Text, Maybe (Context Text))
-> LuaE PandocError (Doc Text, Maybe (Context Text))
forall e a. LuaError e => Result a -> LuaE e a
force (Result (Doc Text, Maybe (Context Text))
 -> LuaE PandocError (Doc Text, Maybe (Context Text)))
-> (Result (Doc Text, Maybe (Context Text))
    -> Result (Doc Text, Maybe (Context Text)))
-> Result (Doc Text, Maybe (Context Text))
-> LuaE PandocError (Doc Text, Maybe (Context Text))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
    Failure ByteString
msg [Name]
contexts -> ByteString -> [Name] -> Result (Doc Text, Maybe (Context Text))
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 <- 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
                    (WriterTable
-> Maybe (Doc Text) -> [Block] -> LuaE PandocError (Doc Text)
blockListToCustom WriterTable
writer Maybe (Doc Text)
forall a. Maybe a
Nothing)
                    (WriterTable -> [Inline] -> LuaE PandocError (Doc Text)
inlineListToCustom WriterTable
writer)
                    Meta
meta
  let context :: Context Text
context = Text -> Doc Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
setField Text
"body" Doc Text
body
              (Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$ Context Text -> Maybe (Context Text) -> Context Text
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 WrapOption -> WrapOption -> Bool
forall a. Eq a => a -> a -> Bool
== WrapOption
WrapAuto
                    then Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ WriterOptions -> Int
writerColumns WriterOptions
opts
                    else Maybe Int
forall a. Maybe a
Nothing

  Text -> LuaE PandocError Text
forall a. a -> LuaE PandocError a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> LuaE PandocError Text) -> Text -> LuaE PandocError Text
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Doc Text -> Text
forall a. HasChars a => Maybe Int -> Doc a -> a
render Maybe Int
colwidth (Doc Text -> Text) -> Doc Text -> Text
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 -> Template Text -> Context Text -> Doc Text
forall a b.
(TemplateTarget a, ToContext a b) =>
Template a -> b -> Doc a
renderTemplate Template Text
tpl Context Text
context

-- | 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 (Text -> ByteString) -> ([Text] -> Text) -> [Text] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
T.intercalate Text
"\n" ([Text] -> ByteString) -> [Text] -> ByteString
forall a b. (a -> b) -> a -> b
$
  let tmsg :: [Text]
tmsg = Text -> [Text]
T.lines (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
UTF8.toText ByteString
msg
      traceStart :: Text -> Bool
traceStart = (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"stack traceback:")
  in case (Text -> Bool) -> [Text] -> ([Text], [Text])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Text -> Bool
traceStart [Text]
tmsg of
        ([Text]
x, Text
t:[Text]
traces) -> ([Text]
x [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<>) ([Text] -> [Text]) -> ([Text] -> [Text]) -> [Text] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
tText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:) ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$
                         let ([Text]
firstTrace, [Text]
rest) = (Text -> Bool) -> [Text] -> ([Text], [Text])
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 = (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"\t[C]: in ?")
                         in (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
isUnknownCFn) [Text]
firstTrace [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<>
                            (Text -> Bool) -> [Text] -> [Text]
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
  Pusher e WriterTable
forall e. LuaError e => Pusher e WriterTable
pushWriterTable WriterTable
writer
  StackIndex -> Name -> LuaE e Type
forall e. LuaError e => StackIndex -> Name -> LuaE e Type
getfield' StackIndex
top Name
name LuaE e Type -> LuaE e () -> LuaE e Type
forall a b. LuaE e a -> LuaE e b -> LuaE e a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* StackIndex -> LuaE e ()
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
  Pusher e WriterTable
forall e. LuaError e => Pusher e WriterTable
pushWriterTable WriterTable
writer
  StackIndex -> Name -> LuaE e Type
forall e. LuaError e => StackIndex -> Name -> LuaE e Type
getfield' StackIndex
top Name
subtable LuaE e Type -> (Type -> LuaE e Type) -> LuaE e Type
forall a b. LuaE e a -> (a -> LuaE e b) -> LuaE e b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Type
TypeNil -> Type
TypeNil Type -> LuaE e () -> LuaE e Type
forall a b. a -> LuaE e b -> LuaE e a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ StackIndex -> LuaE e ()
forall e. StackIndex -> LuaE e ()
remove (CInt -> StackIndex
nth CInt
2) -- remove Writer table
    Type
_       -> StackIndex -> Name -> LuaE e Type
forall e. LuaError e => StackIndex -> Name -> LuaE e Type
getfield' StackIndex
top Name
field
               -- remove Writer and subtable
               LuaE e Type -> LuaE e () -> LuaE e Type
forall a b. LuaE e a -> LuaE e b -> LuaE e a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* StackIndex -> LuaE e ()
forall e. StackIndex -> LuaE e ()
remove (CInt -> StackIndex
nth CInt
3) LuaE e Type -> LuaE e () -> LuaE e Type
forall a b. LuaE e a -> LuaE e b -> LuaE e a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* StackIndex -> LuaE e ()
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 = Name
-> Peek PandocError (Doc Text, Maybe (Context Text))
-> Peek PandocError (Doc Text, Maybe (Context Text))
forall e a. Name -> Peek e a -> Peek e a
withContext Name
"rendering Pandoc" (Peek PandocError (Doc Text, Maybe (Context Text))
 -> Peek PandocError (Doc Text, Maybe (Context Text)))
-> Peek PandocError (Doc Text, Maybe (Context Text))
-> Peek PandocError (Doc Text, Maybe (Context Text))
forall a b. (a -> b) -> a -> b
$ do
  Status
callStatus <- LuaE PandocError Status -> Peek PandocError Status
forall e a. LuaE e a -> Peek e a
liftLua (LuaE PandocError Status -> Peek PandocError Status)
-> LuaE PandocError Status -> Peek PandocError Status
forall a b. (a -> b) -> a -> b
$ do
    WriterTable -> Name -> LuaE PandocError Type
forall e. LuaError e => WriterTable -> Name -> LuaE e Type
getWriterField WriterTable
writer Name
"Pandoc"
    Pusher PandocError Pandoc
forall e. LuaError e => Pusher e Pandoc
pushPandoc Pandoc
doc
    LuaE PandocError ()
pushOpts
    NumArgs -> NumResults -> LuaE PandocError Status
forall e. NumArgs -> NumResults -> LuaE e Status
pcallTrace NumArgs
2 NumResults
2
  case Status
callStatus of
    Status
OK -> ((,) (Doc Text
 -> Maybe (Context Text) -> (Doc Text, Maybe (Context Text)))
-> Peek PandocError (Doc Text)
-> Peek
     PandocError
     (Maybe (Context Text) -> (Doc Text, Maybe (Context Text)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Peeker PandocError (Doc Text)
forall e. LuaError e => Peeker e (Doc Text)
peekDocFuzzy (CInt -> StackIndex
nth CInt
2) Peek
  PandocError
  (Maybe (Context Text) -> (Doc Text, Maybe (Context Text)))
-> Peek PandocError (Maybe (Context Text))
-> Peek PandocError (Doc Text, Maybe (Context Text))
forall a b.
Peek PandocError (a -> b)
-> Peek PandocError a -> Peek PandocError b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Peeker PandocError (Context Text)
-> Peeker PandocError (Maybe (Context Text))
forall e a. Peeker e a -> Peeker e (Maybe a)
orNil Peeker PandocError (Context Text)
forall e. LuaError e => Peeker e (Context Text)
peekContext StackIndex
top)
          Peek PandocError (Doc Text, Maybe (Context Text))
-> LuaE PandocError ()
-> Peek PandocError (Doc Text, Maybe (Context Text))
forall e a b. Peek e a -> LuaE e b -> Peek e a
`lastly` Int -> LuaE PandocError ()
forall e. Int -> LuaE e ()
pop Int
2
    Status
_  -> ByteString -> Peek PandocError (Doc Text, Maybe (Context Text))
forall a e. ByteString -> Peek e a
failPeek (ByteString -> Peek PandocError (Doc Text, Maybe (Context Text)))
-> Peek PandocError ByteString
-> Peek PandocError (Doc Text, Maybe (Context Text))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< LuaE PandocError ByteString -> Peek PandocError ByteString
forall e a. LuaE e a -> Peek e a
liftLua (StackIndex -> LuaE PandocError ByteString
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 = Peek PandocError (Doc Text) -> LuaE PandocError (Doc Text)
forall e a. LuaError e => Peek e a -> LuaE e a
forcePeek (Peek PandocError (Doc Text) -> LuaE PandocError (Doc Text))
-> Peek PandocError (Doc Text) -> LuaE PandocError (Doc Text)
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 = String -> Name
forall a. IsString a => String -> a
fromString (String -> Name) -> (Block -> String) -> Block -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Constr -> String
showConstr (Constr -> String) -> (Block -> Constr) -> Block -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block -> Constr
forall a. Data a => a -> Constr
toConstr (Block -> Name) -> Block -> Name
forall a b. (a -> b) -> a -> b
$ Block
blk
  Name -> Peek PandocError (Doc Text) -> Peek PandocError (Doc Text)
forall e a. Name -> Peek e a -> Peek e a
withContext (Name
"rendering Block `" Name -> Name -> Name
forall a. Semigroup a => a -> a -> a
<> Name
constrName Name -> Name -> Name
forall a. Semigroup a => a -> a -> a
<> Name
"`") (Peek PandocError (Doc Text) -> Peek PandocError (Doc Text))
-> Peek PandocError (Doc Text) -> Peek PandocError (Doc Text)
forall a b. (a -> b) -> a -> b
$
    LuaE PandocError Type -> Peek PandocError Type
forall e a. LuaE e a -> Peek e a
liftLua (WriterTable -> Name -> Name -> LuaE PandocError Type
forall e. LuaError e => WriterTable -> Name -> Name -> LuaE e Type
getNestedWriterField WriterTable
writer Name
"Block" Name
constrName) Peek PandocError Type
-> (Type -> Peek PandocError (Doc Text))
-> Peek PandocError (Doc Text)
forall a b.
Peek PandocError a
-> (a -> Peek PandocError b) -> Peek PandocError b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Type
TypeNil -> ByteString -> Peek PandocError (Doc Text)
forall a e. ByteString -> Peek e a
failPeek (ByteString -> Peek PandocError (Doc Text))
-> Peek PandocError ByteString -> Peek PandocError (Doc Text)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Name -> Peeker PandocError ByteString
forall e. Name -> StackIndex -> Peek e ByteString
typeMismatchMessage Name
"function or Doc" StackIndex
top
      Type
_       -> LuaE PandocError () -> Peek PandocError (Doc Text)
callOrDoc (Pusher PandocError Block
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 = Peek PandocError (Doc Text) -> LuaE PandocError (Doc Text)
forall e a. LuaError e => Peek e a -> LuaE e a
forcePeek (Peek PandocError (Doc Text) -> LuaE PandocError (Doc Text))
-> Peek PandocError (Doc Text) -> LuaE PandocError (Doc Text)
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 = String -> Name
forall a. IsString a => String -> a
fromString (String -> Name) -> (Inline -> String) -> Inline -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Constr -> String
showConstr (Constr -> String) -> (Inline -> Constr) -> Inline -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inline -> Constr
forall a. Data a => a -> Constr
toConstr (Inline -> Name) -> Inline -> Name
forall a b. (a -> b) -> a -> b
$ Inline
inln
  Name -> Peek PandocError (Doc Text) -> Peek PandocError (Doc Text)
forall e a. Name -> Peek e a -> Peek e a
withContext (Name
"rendering Inline `" Name -> Name -> Name
forall a. Semigroup a => a -> a -> a
<> Name
constrName Name -> Name -> Name
forall a. Semigroup a => a -> a -> a
<> Name
"`") (Peek PandocError (Doc Text) -> Peek PandocError (Doc Text))
-> Peek PandocError (Doc Text) -> Peek PandocError (Doc Text)
forall a b. (a -> b) -> a -> b
$ do
    LuaE PandocError Type -> Peek PandocError Type
forall e a. LuaE e a -> Peek e a
liftLua (WriterTable -> Name -> Name -> LuaE PandocError Type
forall e. LuaError e => WriterTable -> Name -> Name -> LuaE e Type
getNestedWriterField WriterTable
writer Name
"Inline" Name
constrName) Peek PandocError Type
-> (Type -> Peek PandocError (Doc Text))
-> Peek PandocError (Doc Text)
forall a b.
Peek PandocError a
-> (a -> Peek PandocError b) -> Peek PandocError b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Type
TypeNil -> ByteString -> Peek PandocError (Doc Text)
forall a e. ByteString -> Peek e a
failPeek (ByteString -> Peek PandocError (Doc Text))
-> Peek PandocError ByteString -> Peek PandocError (Doc Text)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Name -> Peeker PandocError ByteString
forall e. Name -> StackIndex -> Peek e ByteString
typeMismatchMessage Name
"function or Doc" StackIndex
top
      Type
_       -> LuaE PandocError () -> Peek PandocError (Doc Text)
callOrDoc (Pusher PandocError Inline
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
  LuaE PandocError Type -> Peek PandocError Type
forall e a. LuaE e a -> Peek e a
liftLua (StackIndex -> LuaE PandocError Type
forall e. StackIndex -> LuaE e Type
ltype StackIndex
top) Peek PandocError Type
-> (Type -> Peek PandocError (Doc Text))
-> Peek PandocError (Doc Text)
forall a b.
Peek PandocError a
-> (a -> Peek PandocError b) -> Peek PandocError b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Type
TypeFunction -> Peek PandocError (Doc Text)
peekCall
    Type
_            ->
      LuaE PandocError Type -> Peek PandocError Type
forall e a. LuaE e a -> Peek e a
liftLua (StackIndex -> Name -> LuaE PandocError Type
forall e. StackIndex -> Name -> LuaE e Type
getmetafield StackIndex
top Name
"__call") Peek PandocError Type
-> (Type -> Peek PandocError (Doc Text))
-> Peek PandocError (Doc Text)
forall a b.
Peek PandocError a
-> (a -> Peek PandocError b) -> Peek PandocError b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Type
TypeNil -> Peeker PandocError (Doc Text)
forall e. LuaError e => Peeker e (Doc Text)
peekDocFuzzy StackIndex
top
        Type
_       -> LuaE PandocError () -> Peek PandocError ()
forall e a. LuaE e a -> Peek e a
liftLua (Int -> LuaE PandocError ()
forall e. Int -> LuaE e ()
pop Int
1) Peek PandocError ()
-> Peek PandocError (Doc Text) -> Peek PandocError (Doc Text)
forall a b.
Peek PandocError a -> Peek PandocError b -> Peek PandocError b
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 =
     LuaE PandocError Status -> Peek PandocError Status
forall e a. LuaE e a -> Peek e a
liftLua (LuaE PandocError ()
pushElement LuaE PandocError () -> LuaE PandocError () -> LuaE PandocError ()
forall a b.
LuaE PandocError a -> LuaE PandocError b -> LuaE PandocError b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> LuaE PandocError ()
pushOpts LuaE PandocError ()
-> LuaE PandocError Status -> LuaE PandocError Status
forall a b.
LuaE PandocError a -> LuaE PandocError b -> LuaE PandocError b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> NumArgs -> NumResults -> LuaE PandocError Status
forall e. NumArgs -> NumResults -> LuaE e Status
pcallTrace NumArgs
2 NumResults
1) Peek PandocError Status
-> (Status -> Peek PandocError (Doc Text))
-> Peek PandocError (Doc Text)
forall a b.
Peek PandocError a
-> (a -> Peek PandocError b) -> Peek PandocError b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
       Status
OK -> Peeker PandocError (Doc Text)
forall e. LuaError e => Peeker e (Doc Text)
peekDocFuzzy StackIndex
top
       Status
_  -> ByteString -> Peek PandocError (Doc Text)
forall a e. ByteString -> Peek e a
failPeek (ByteString -> Peek PandocError (Doc Text))
-> Peek PandocError ByteString -> Peek PandocError (Doc Text)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< LuaE PandocError ByteString -> Peek PandocError ByteString
forall e a. LuaE e a -> Peek e a
liftLua (StackIndex -> LuaE PandocError ByteString
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 = Peek PandocError (Doc Text) -> LuaE PandocError (Doc Text)
forall e a. LuaError e => Peek e a -> LuaE e a
forcePeek (Peek PandocError (Doc Text) -> LuaE PandocError (Doc Text))
-> Peek PandocError (Doc Text) -> LuaE PandocError (Doc Text)
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 = Peek PandocError (Doc Text) -> LuaE PandocError (Doc Text)
forall e a. LuaError e => Peek e a -> LuaE e a
forcePeek (Peek PandocError (Doc Text) -> LuaE PandocError (Doc Text))
-> Peek PandocError (Doc Text) -> LuaE PandocError (Doc Text)
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 = Name -> Peek PandocError (Doc Text) -> Peek PandocError (Doc Text)
forall e a. Name -> Peek e a -> Peek e a
withContext Name
"rendering Blocks" (Peek PandocError (Doc Text) -> Peek PandocError (Doc Text))
-> Peek PandocError (Doc Text) -> Peek PandocError (Doc Text)
forall a b. (a -> b) -> a -> b
$ do
  let addSeps :: [Doc Text] -> [Doc Text]
addSeps = Doc Text -> [Doc Text] -> [Doc Text]
forall a. a -> [a] -> [a]
intersperse (Doc Text -> [Doc Text] -> [Doc Text])
-> Doc Text -> [Doc Text] -> [Doc Text]
forall a b. (a -> b) -> a -> b
$ Doc Text -> Maybe (Doc Text) -> Doc Text
forall a. a -> Maybe a -> a
fromMaybe Doc Text
forall a. Doc a
blankline Maybe (Doc Text)
msep
  [Doc Text] -> Doc Text
forall a. Monoid a => [a] -> a
mconcat ([Doc Text] -> Doc Text)
-> ([Doc Text] -> [Doc Text]) -> [Doc Text] -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc Text] -> [Doc Text]
addSeps ([Doc Text] -> Doc Text)
-> Peek PandocError [Doc Text] -> Peek PandocError (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Block -> Peek PandocError (Doc Text))
-> [Block] -> Peek PandocError [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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 = Name -> Peek PandocError (Doc Text) -> Peek PandocError (Doc Text)
forall e a. Name -> Peek e a -> Peek e a
withContext Name
"rendering Inlines" (Peek PandocError (Doc Text) -> Peek PandocError (Doc Text))
-> Peek PandocError (Doc Text) -> Peek PandocError (Doc Text)
forall a b. (a -> b) -> a -> b
$ do
  [Doc Text] -> Doc Text
forall a. Monoid a => [a] -> a
mconcat ([Doc Text] -> Doc Text)
-> Peek PandocError [Doc Text] -> Peek PandocError (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Inline -> Peek PandocError (Doc Text))
-> [Inline] -> Peek PandocError [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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 = LuaE e Type -> Peek e Type
forall e a. LuaE e a -> Peek e a
liftLua (StackIndex -> LuaE e Type
forall e. StackIndex -> LuaE e Type
ltype StackIndex
idx) Peek e Type -> (Type -> Peek e (Maybe a)) -> Peek e (Maybe a)
forall a b. Peek e a -> (a -> Peek e b) -> Peek e b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Type
TypeNil  -> Maybe a -> Peek e (Maybe a)
forall a. a -> Peek e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
  Type
TypeNone -> Maybe a -> Peek e (Maybe a)
forall a. a -> Peek e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
  Type
_        -> a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> Peek e a -> Peek e (Maybe a)
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 = LuaE e Type -> Peek e Type
forall e a. LuaE e a -> Peek e a
liftLua (StackIndex -> LuaE e Type
forall e. StackIndex -> LuaE e Type
ltype StackIndex
idx) Peek e Type -> (Type -> Peek e (Doc Text)) -> Peek e (Doc Text)
forall a b. Peek e a -> (a -> Peek e b) -> Peek e b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Type
TypeTable -> [Doc Text] -> Doc Text
forall a. Monoid a => [a] -> a
mconcat ([Doc Text] -> Doc Text) -> Peek e [Doc Text] -> Peek e (Doc Text)
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Peeker e (Doc Text) -> Peeker e [Doc Text]
forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList Peeker e (Doc Text)
forall e. LuaError e => Peeker e (Doc Text)
peekDoc StackIndex
idx
  Type
_         -> Peeker e (Doc Text)
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  = (Constr -> String) -> [Constr] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> String
forall a. IsString a => String -> a
fromString (String -> String) -> (Constr -> String) -> Constr -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Constr -> String
forall a. Show a => a -> String
show) ([Constr] -> [String]) -> (Block -> [Constr]) -> Block -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DataType -> [Constr]
dataTypeConstrs (DataType -> [Constr]) -> (Block -> DataType) -> Block -> [Constr]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block -> DataType
forall a. Data a => a -> DataType
dataTypeOf
                      (Block -> [String]) -> Block -> [String]
forall a b. (a -> b) -> a -> b
$ Block
HorizontalRule
      inlineNames :: [String]
inlineNames = (Constr -> String) -> [Constr] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> String
forall a. IsString a => String -> a
fromString (String -> String) -> (Constr -> String) -> Constr -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Constr -> String
forall a. Show a => a -> String
show) ([Constr] -> [String])
-> (Inline -> [Constr]) -> Inline -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DataType -> [Constr]
dataTypeConstrs (DataType -> [Constr])
-> (Inline -> DataType) -> Inline -> [Constr]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inline -> DataType
forall a. Data a => a -> DataType
dataTypeOf
                      (Inline -> [String]) -> Inline -> [String]
forall a b. (a -> b) -> a -> b
$ Inline
Space
      mtypeName :: Maybe String
mtypeName = case () of
       ()
_ | String
key String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
blockNames  -> String -> Maybe String
forall a. a -> Maybe a
Just String
"Block"
       ()
_ | String
key String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
inlineNames -> String -> Maybe String
forall a. a -> Maybe a
Just String
"Inline"
       ()
_                          -> Maybe String
forall a. Maybe a
Nothing
  in case Maybe String
mtypeName of
       Just String
typeName  -> String -> LuaE e ()
forall e a. LuaError e => String -> LuaE e a
failLua (String -> LuaE e ()) -> String -> LuaE e ()
forall a b. (a -> b) -> a -> b
$
                         String
"No render function for " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
typeName String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" value " String -> String -> String
forall a. Semigroup a => a -> a -> a
<>
                         String
"'" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
key String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"';\ndefine a function `Writer." String -> String -> String
forall a. Semigroup a => a -> a -> a
<>
                         String
typeName String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"." String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
key String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"` that returns " String -> String -> String
forall a. Semigroup a => a -> a -> a
<>
                         String
"a string or Doc."
       Maybe String
_ -> () -> LuaE e ()
forall a. a -> LuaE e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()