{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications  #-}
{- |
   Module      : Text.Pandoc.Lua.Module.Pandoc
   Copyright   : Copyright © 2017-2021 Albert Krewinkel
   License     : GNU GPL, version 2 or above

   Maintainer  : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
   Stability   : alpha

Pandoc module for lua.
-}
module Text.Pandoc.Lua.Module.Pandoc
  ( pushModule
  , documentedModule
  ) where

import Prelude hiding (read)
import Control.Applicative ((<|>))
import Control.Monad ((<$!>), forM_, when)
import Control.Monad.Catch (catch, throwM)
import Control.Monad.Except (throwError)
import Data.Data (Data, dataTypeConstrs, dataTypeOf, showConstr)
import Data.Default (Default (..))
import Data.Maybe (fromMaybe)
import Data.Proxy (Proxy (Proxy))
import Data.Text (Text)
import HsLua hiding (Div, pushModule)
import HsLua.Class.Peekable (PeekError)
import System.Exit (ExitCode (..))
import Text.Pandoc.Class.PandocIO (runIO)
import Text.Pandoc.Definition
import Text.Pandoc.Lua.Filter (SingletonsList (..), LuaFilter, peekLuaFilter,
                               walkInlines, walkInlineLists,
                               walkBlocks, walkBlockLists)
import Text.Pandoc.Lua.Marshaling ()
import Text.Pandoc.Lua.Marshaling.AST
import Text.Pandoc.Lua.Marshaling.Attr (mkAttr, mkAttributeList)
import Text.Pandoc.Lua.Marshaling.List (List (..))
import Text.Pandoc.Lua.Marshaling.ListAttributes ( mkListAttributes
                                                 , peekListAttributes)
import Text.Pandoc.Lua.Marshaling.ReaderOptions ( peekReaderOptions
                                                , pushReaderOptions)
import Text.Pandoc.Lua.Marshaling.SimpleTable (mkSimpleTable)
import Text.Pandoc.Lua.Module.Utils (sha1)
import Text.Pandoc.Lua.PandocLua (PandocLua, liftPandocLua,
                                  loadDefaultModule)
import Text.Pandoc.Options (ReaderOptions (readerExtensions))
import Text.Pandoc.Process (pipeProcess)
import Text.Pandoc.Readers (Reader (..), getReader)
import Text.Pandoc.Walk (Walkable)

import qualified HsLua as Lua
import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString.Lazy.Char8 as BSL
import qualified Data.Text as T
import qualified Text.Pandoc.Lua.Util as LuaUtil
import Text.Pandoc.Error

-- | Push the "pandoc" package to the Lua stack. Requires the `List`
-- module to be loadable.
pushModule :: PandocLua NumResults
pushModule :: PandocLua NumResults
pushModule = do
  LuaE PandocError () -> PandocLua ()
forall a. LuaE PandocError a -> PandocLua a
liftPandocLua (LuaE PandocError () -> PandocLua ())
-> LuaE PandocError () -> PandocLua ()
forall a b. (a -> b) -> a -> b
$ Module PandocError -> LuaE PandocError ()
forall e. LuaError e => Module e -> LuaE e ()
Lua.pushModule Module PandocError
documentedModule
  String -> PandocLua NumResults
loadDefaultModule String
"pandoc"
  let copyNext :: LuaE PandocError ()
copyNext = do
        Bool
hasNext <- StackIndex -> LuaE PandocError Bool
forall e. LuaError e => StackIndex -> LuaE e Bool
next (CInt -> StackIndex
nth CInt
2)
        if Bool -> Bool
not Bool
hasNext
          then () -> LuaE PandocError ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          else do
            StackIndex -> LuaE PandocError ()
forall e. StackIndex -> LuaE e ()
pushvalue (CInt -> StackIndex
nth CInt
2)
            StackIndex -> LuaE PandocError ()
forall e. StackIndex -> LuaE e ()
insert (CInt -> StackIndex
nth CInt
2)
            StackIndex -> LuaE PandocError ()
forall e. LuaError e => StackIndex -> LuaE e ()
rawset (CInt -> StackIndex
nth CInt
5) -- pandoc module
            LuaE PandocError ()
copyNext
  LuaE PandocError () -> PandocLua ()
forall a. LuaE PandocError a -> PandocLua a
liftPandocLua (LuaE PandocError () -> PandocLua ())
-> LuaE PandocError () -> PandocLua ()
forall a b. (a -> b) -> a -> b
$ do
    LuaE PandocError ()
forall e. LuaE e ()
pushnil  -- initial key
    LuaE PandocError ()
copyNext
    Int -> LuaE PandocError ()
forall e. Int -> LuaE e ()
pop Int
1

  NumResults -> PandocLua NumResults
forall (m :: * -> *) a. Monad m => a -> m a
return NumResults
1

documentedModule :: Module PandocError
documentedModule :: Module PandocError
documentedModule = Module :: forall e.
Name
-> Text
-> [Field e]
-> [DocumentedFunction e]
-> [(Operation, DocumentedFunction e)]
-> Module e
Module
  { moduleName :: Name
moduleName = Name
"pandoc"
  , moduleDescription :: Text
moduleDescription = [Text] -> Text
T.unlines
    [ Text
"Lua functions for pandoc scripts; includes constructors for"
    , Text
"document elements, functions to parse text in a given"
    , Text
"format, and functions to filter and modify a subtree."
    ]
  , moduleFields :: [Field PandocError]
moduleFields = [Field PandocError]
forall e. [Field e]
stringConstants [Field PandocError] -> [Field PandocError] -> [Field PandocError]
forall a. [a] -> [a] -> [a]
++ [Field PandocError
inlineField, Field PandocError
blockField]
  , moduleOperations :: [(Operation, DocumentedFunction PandocError)]
moduleOperations = []
  , moduleFunctions :: [DocumentedFunction PandocError]
moduleFunctions = [[DocumentedFunction PandocError]]
-> [DocumentedFunction PandocError]
forall a. Monoid a => [a] -> a
mconcat
      [ [DocumentedFunction PandocError]
functions
      , [DocumentedFunction PandocError]
forall e. LuaError e => [DocumentedFunction e]
otherConstructors
      , [DocumentedFunction PandocError]
forall e. LuaError e => [DocumentedFunction e]
blockConstructors
      , [DocumentedFunction PandocError]
forall e. LuaError e => [DocumentedFunction e]
inlineConstructors
      ]
  }

-- | Inline table field
inlineField :: Field PandocError
inlineField :: Field PandocError
inlineField = Field :: forall e. Text -> Text -> LuaE e () -> Field e
Field
  { fieldName :: Text
fieldName = Text
"Inline"
  , fieldDescription :: Text
fieldDescription = Text
"Inline constructors, nested under 'constructors'."
  -- the nesting happens for historical reasons and should probably be
  -- changed.
  , fieldPushValue :: LuaE PandocError ()
fieldPushValue = [DocumentedFunction PandocError] -> LuaE PandocError ()
pushWithConstructorsSubtable [DocumentedFunction PandocError]
forall e. LuaError e => [DocumentedFunction e]
inlineConstructors
  }

-- | @Block@ module field
blockField :: Field PandocError
blockField :: Field PandocError
blockField = Field :: forall e. Text -> Text -> LuaE e () -> Field e
Field
  { fieldName :: Text
fieldName = Text
"Block"
  , fieldDescription :: Text
fieldDescription = Text
"Inline constructors, nested under 'constructors'."
  -- the nesting happens for historical reasons and should probably be
  -- changed.
  , fieldPushValue :: LuaE PandocError ()
fieldPushValue = [DocumentedFunction PandocError] -> LuaE PandocError ()
pushWithConstructorsSubtable [DocumentedFunction PandocError]
forall e. LuaError e => [DocumentedFunction e]
blockConstructors
  }

pushWithConstructorsSubtable :: [DocumentedFunction PandocError]
                             -> LuaE PandocError ()
pushWithConstructorsSubtable :: [DocumentedFunction PandocError] -> LuaE PandocError ()
pushWithConstructorsSubtable [DocumentedFunction PandocError]
constructors = do
  LuaE PandocError ()
forall e. LuaE e ()
newtable -- Field table
  LuaE PandocError ()
forall e. LuaE e ()
newtable -- constructor table
  Name -> LuaE PandocError ()
forall e. Name -> LuaE e ()
pushName Name
"constructor" LuaE PandocError () -> LuaE PandocError () -> LuaE PandocError ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> StackIndex -> LuaE PandocError ()
forall e. StackIndex -> LuaE e ()
pushvalue (CInt -> StackIndex
nth CInt
2) LuaE PandocError () -> LuaE PandocError () -> LuaE PandocError ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> StackIndex -> LuaE PandocError ()
forall e. LuaError e => StackIndex -> LuaE e ()
rawset (CInt -> StackIndex
nth CInt
4)
  [DocumentedFunction PandocError]
-> (DocumentedFunction PandocError -> LuaE PandocError ())
-> LuaE PandocError ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [DocumentedFunction PandocError]
constructors ((DocumentedFunction PandocError -> LuaE PandocError ())
 -> LuaE PandocError ())
-> (DocumentedFunction PandocError -> LuaE PandocError ())
-> LuaE PandocError ()
forall a b. (a -> b) -> a -> b
$ \DocumentedFunction PandocError
fn -> do
    Name -> LuaE PandocError ()
forall e. Name -> LuaE e ()
pushName (DocumentedFunction PandocError -> Name
forall e. DocumentedFunction e -> Name
functionName DocumentedFunction PandocError
fn)
    DocumentedFunction PandocError -> LuaE PandocError ()
forall e. LuaError e => DocumentedFunction e -> LuaE e ()
pushDocumentedFunction DocumentedFunction PandocError
fn
    StackIndex -> LuaE PandocError ()
forall e. LuaError e => StackIndex -> LuaE e ()
rawset (CInt -> StackIndex
nth CInt
3)
  Int -> LuaE PandocError ()
forall e. Int -> LuaE e ()
pop Int
1 -- pop constructor table

inlineConstructors :: LuaError e =>  [DocumentedFunction e]
inlineConstructors :: [DocumentedFunction e]
inlineConstructors =
  [ Name
-> ([Inline] -> [Citation] -> LuaE e Inline)
-> HsFnPrecursor e ([Inline] -> [Citation] -> LuaE e Inline)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"Cite"
    ### liftPure2 (flip Cite)
    HsFnPrecursor e ([Inline] -> [Citation] -> LuaE e Inline)
-> Parameter e [Inline]
-> HsFnPrecursor e ([Citation] -> LuaE e Inline)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e [Inline] -> Text -> Text -> Text -> Parameter e [Inline]
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter Peeker e [Inline]
forall e. LuaError e => Peeker e [Inline]
peekInlinesFuzzy Text
"content" Text
"Inline" Text
"placeholder content"
    HsFnPrecursor e ([Citation] -> LuaE e Inline)
-> Parameter e [Citation] -> HsFnPrecursor e (LuaE e Inline)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e [Citation]
-> Text -> Text -> Text -> Parameter e [Citation]
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter (Peeker e Citation -> Peeker e [Citation]
forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList Peeker e Citation
forall e. LuaError e => Peeker e Citation
peekCitation) Text
"citations" Text
"list of Citations" Text
""
    HsFnPrecursor e (LuaE e Inline)
-> FunctionResults e Inline -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Pusher e Inline -> Text -> Text -> FunctionResults e Inline
forall e a. Pusher e a -> Text -> Text -> FunctionResults e a
functionResult Pusher e Inline
forall e. LuaError e => Inline -> LuaE e ()
pushInline Text
"Inline" Text
"cite element"
  , Name
-> (Text -> Maybe Attr -> LuaE e Inline)
-> HsFnPrecursor e (Text -> Maybe Attr -> LuaE e Inline)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"Code"
    ### liftPure2 (\text mattr -> Code (fromMaybe nullAttr mattr) text)
    HsFnPrecursor e (Text -> Maybe Attr -> LuaE e Inline)
-> Parameter e Text
-> HsFnPrecursor e (Maybe Attr -> LuaE e Inline)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e Text -> Text -> Text -> Text -> Parameter e Text
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter Peeker e Text
forall e. Peeker e Text
peekText Text
"code" Text
"string" Text
"code string"
    HsFnPrecursor e (Maybe Attr -> LuaE e Inline)
-> Parameter e (Maybe Attr) -> HsFnPrecursor e (LuaE e Inline)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e Attr -> Text -> Text -> Text -> Parameter e (Maybe Attr)
forall e a.
Peeker e a -> Text -> Text -> Text -> Parameter e (Maybe a)
optionalParameter Peeker e Attr
forall e. LuaError e => Peeker e Attr
peekAttr Text
"attr" Text
"Attr" Text
"additional attributes"
    HsFnPrecursor e (LuaE e Inline)
-> FunctionResults e Inline -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Pusher e Inline -> Text -> Text -> FunctionResults e Inline
forall e a. Pusher e a -> Text -> Text -> FunctionResults e a
functionResult Pusher e Inline
forall e. LuaError e => Inline -> LuaE e ()
pushInline Text
"Inline" Text
"code element"
  , Name -> ([Inline] -> Inline) -> DocumentedFunction e
forall e.
LuaError e =>
Name -> ([Inline] -> Inline) -> DocumentedFunction e
mkInlinesConstr Name
"Emph" [Inline] -> Inline
Emph
  , Name
-> ([Inline] -> Text -> Maybe Text -> Maybe Attr -> LuaE e Inline)
-> HsFnPrecursor
     e ([Inline] -> Text -> Maybe Text -> Maybe Attr -> LuaE e Inline)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"Image"
    ### liftPure4 (\caption src mtitle mattr ->
                     let attr = fromMaybe nullAttr mattr
                         title = fromMaybe mempty mtitle
                     in Image attr caption (src, title))
    HsFnPrecursor
  e ([Inline] -> Text -> Maybe Text -> Maybe Attr -> LuaE e Inline)
-> Parameter e [Inline]
-> HsFnPrecursor
     e (Text -> Maybe Text -> Maybe Attr -> LuaE e Inline)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e [Inline] -> Text -> Text -> Text -> Parameter e [Inline]
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter Peeker e [Inline]
forall e. LuaError e => Peeker e [Inline]
peekInlinesFuzzy Text
"Inlines" Text
"caption" Text
"image caption / alt"
    HsFnPrecursor e (Text -> Maybe Text -> Maybe Attr -> LuaE e Inline)
-> Parameter e Text
-> HsFnPrecursor e (Maybe Text -> Maybe Attr -> LuaE e Inline)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e Text -> Text -> Text -> Text -> Parameter e Text
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter Peeker e Text
forall e. Peeker e Text
peekText Text
"string" Text
"src" Text
"path/URL of the image file"
    HsFnPrecursor e (Maybe Text -> Maybe Attr -> LuaE e Inline)
-> Parameter e (Maybe Text)
-> HsFnPrecursor e (Maybe Attr -> LuaE e Inline)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e Text -> Text -> Text -> Text -> Parameter e (Maybe Text)
forall e a.
Peeker e a -> Text -> Text -> Text -> Parameter e (Maybe a)
optionalParameter Peeker e Text
forall e. Peeker e Text
peekText Text
"string" Text
"title" Text
"brief image description"
    HsFnPrecursor e (Maybe Attr -> LuaE e Inline)
-> Parameter e (Maybe Attr) -> HsFnPrecursor e (LuaE e Inline)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e Attr -> Text -> Text -> Text -> Parameter e (Maybe Attr)
forall e a.
Peeker e a -> Text -> Text -> Text -> Parameter e (Maybe a)
optionalParameter Peeker e Attr
forall e. LuaError e => Peeker e Attr
peekAttr Text
"Attr" Text
"attr" Text
"image attributes"
    HsFnPrecursor e (LuaE e Inline)
-> FunctionResults e Inline -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Pusher e Inline -> Text -> Text -> FunctionResults e Inline
forall e a. Pusher e a -> Text -> Text -> FunctionResults e a
functionResult Pusher e Inline
forall e. LuaError e => Inline -> LuaE e ()
pushInline Text
"Inline" Text
"image element"
  , Name -> LuaE e Inline -> HsFnPrecursor e (LuaE e Inline)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"LineBreak"
    ### return LineBreak
    HsFnPrecursor e (LuaE e Inline)
-> FunctionResults e Inline -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Pusher e Inline -> Text -> Text -> FunctionResults e Inline
forall e a. Pusher e a -> Text -> Text -> FunctionResults e a
functionResult Pusher e Inline
forall e. LuaError e => Inline -> LuaE e ()
pushInline Text
"Inline" Text
"line break"
  , Name
-> ([Inline] -> Text -> Maybe Text -> Maybe Attr -> LuaE e Inline)
-> HsFnPrecursor
     e ([Inline] -> Text -> Maybe Text -> Maybe Attr -> LuaE e Inline)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"Link"
    ### liftPure4 (\content target mtitle mattr ->
                     let attr = fromMaybe nullAttr mattr
                         title = fromMaybe mempty mtitle
                     in Link attr content (target, title))
    HsFnPrecursor
  e ([Inline] -> Text -> Maybe Text -> Maybe Attr -> LuaE e Inline)
-> Parameter e [Inline]
-> HsFnPrecursor
     e (Text -> Maybe Text -> Maybe Attr -> LuaE e Inline)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e [Inline] -> Text -> Text -> Text -> Parameter e [Inline]
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter Peeker e [Inline]
forall e. LuaError e => Peeker e [Inline]
peekInlinesFuzzy Text
"Inlines" Text
"content" Text
"text for this link"
    HsFnPrecursor e (Text -> Maybe Text -> Maybe Attr -> LuaE e Inline)
-> Parameter e Text
-> HsFnPrecursor e (Maybe Text -> Maybe Attr -> LuaE e Inline)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e Text -> Text -> Text -> Text -> Parameter e Text
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter Peeker e Text
forall e. Peeker e Text
peekText Text
"string" Text
"target" Text
"the link target"
    HsFnPrecursor e (Maybe Text -> Maybe Attr -> LuaE e Inline)
-> Parameter e (Maybe Text)
-> HsFnPrecursor e (Maybe Attr -> LuaE e Inline)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e Text -> Text -> Text -> Text -> Parameter e (Maybe Text)
forall e a.
Peeker e a -> Text -> Text -> Text -> Parameter e (Maybe a)
optionalParameter Peeker e Text
forall e. Peeker e Text
peekText Text
"string" Text
"title" Text
"brief link description"
    HsFnPrecursor e (Maybe Attr -> LuaE e Inline)
-> Parameter e (Maybe Attr) -> HsFnPrecursor e (LuaE e Inline)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e Attr -> Text -> Text -> Text -> Parameter e (Maybe Attr)
forall e a.
Peeker e a -> Text -> Text -> Text -> Parameter e (Maybe a)
optionalParameter Peeker e Attr
forall e. LuaError e => Peeker e Attr
peekAttr Text
"Attr" Text
"attr" Text
"link attributes"
    HsFnPrecursor e (LuaE e Inline)
-> FunctionResults e Inline -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Pusher e Inline -> Text -> Text -> FunctionResults e Inline
forall e a. Pusher e a -> Text -> Text -> FunctionResults e a
functionResult Pusher e Inline
forall e. LuaError e => Inline -> LuaE e ()
pushInline Text
"Inline" Text
"link element"
  , Name
-> (MathType -> Text -> LuaE e Inline)
-> HsFnPrecursor e (MathType -> Text -> LuaE e Inline)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"Math"
    ### liftPure2 Math
    HsFnPrecursor e (MathType -> Text -> LuaE e Inline)
-> Parameter e MathType -> HsFnPrecursor e (Text -> LuaE e Inline)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e MathType -> Text -> Text -> Text -> Parameter e MathType
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter Peeker e MathType
forall e. LuaError e => Peeker e MathType
peekMathType Text
"quotetype" Text
"Math" Text
"rendering method"
    HsFnPrecursor e (Text -> LuaE e Inline)
-> Parameter e Text -> HsFnPrecursor e (LuaE e Inline)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e Text -> Text -> Text -> Text -> Parameter e Text
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter Peeker e Text
forall e. Peeker e Text
peekText Text
"text" Text
"string" Text
"math content"
    HsFnPrecursor e (LuaE e Inline)
-> FunctionResults e Inline -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Pusher e Inline -> Text -> Text -> FunctionResults e Inline
forall e a. Pusher e a -> Text -> Text -> FunctionResults e a
functionResult Pusher e Inline
forall e. LuaError e => Inline -> LuaE e ()
pushInline Text
"Inline" Text
"math element"
  , Name
-> ([Block] -> LuaE e Inline)
-> HsFnPrecursor e ([Block] -> LuaE e Inline)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"Note"
    ### liftPure Note
    HsFnPrecursor e ([Block] -> LuaE e Inline)
-> Parameter e [Block] -> HsFnPrecursor e (LuaE e Inline)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e [Block] -> Text -> Text -> Text -> Parameter e [Block]
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter Peeker e [Block]
forall e. LuaError e => Peeker e [Block]
peekBlocksFuzzy Text
"content" Text
"Blocks" Text
"note content"
    HsFnPrecursor e (LuaE e Inline)
-> FunctionResults e Inline -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Pusher e Inline -> Text -> Text -> FunctionResults e Inline
forall e a. Pusher e a -> Text -> Text -> FunctionResults e a
functionResult Pusher e Inline
forall e. LuaError e => Inline -> LuaE e ()
pushInline Text
"Inline" Text
"note"
  , Name
-> (QuoteType -> [Inline] -> LuaE e Inline)
-> HsFnPrecursor e (QuoteType -> [Inline] -> LuaE e Inline)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"Quoted"
    ### liftPure2 Quoted
    HsFnPrecursor e (QuoteType -> [Inline] -> LuaE e Inline)
-> Parameter e QuoteType
-> HsFnPrecursor e ([Inline] -> LuaE e Inline)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e QuoteType -> Text -> Text -> Text -> Parameter e QuoteType
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter Peeker e QuoteType
forall e. LuaError e => Peeker e QuoteType
peekQuoteType Text
"quotetype" Text
"QuoteType" Text
"type of quotes"
    HsFnPrecursor e ([Inline] -> LuaE e Inline)
-> Parameter e [Inline] -> HsFnPrecursor e (LuaE e Inline)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e [Inline] -> Text -> Text -> Text -> Parameter e [Inline]
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter Peeker e [Inline]
forall e. LuaError e => Peeker e [Inline]
peekInlinesFuzzy Text
"content" Text
"Inlines" Text
"inlines in quotes"
    HsFnPrecursor e (LuaE e Inline)
-> FunctionResults e Inline -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Pusher e Inline -> Text -> Text -> FunctionResults e Inline
forall e a. Pusher e a -> Text -> Text -> FunctionResults e a
functionResult Pusher e Inline
forall e. LuaError e => Inline -> LuaE e ()
pushInline Text
"Inline" Text
"quoted element"
  , Name
-> (Format -> Text -> LuaE e Inline)
-> HsFnPrecursor e (Format -> Text -> LuaE e Inline)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"RawInline"
    ### liftPure2 RawInline
    HsFnPrecursor e (Format -> Text -> LuaE e Inline)
-> Parameter e Format -> HsFnPrecursor e (Text -> LuaE e Inline)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e Format -> Text -> Text -> Text -> Parameter e Format
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter Peeker e Format
forall e. LuaError e => Peeker e Format
peekFormat Text
"format" Text
"Format" Text
"format of content"
    HsFnPrecursor e (Text -> LuaE e Inline)
-> Parameter e Text -> HsFnPrecursor e (LuaE e Inline)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e Text -> Text -> Text -> Text -> Parameter e Text
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter Peeker e Text
forall e. Peeker e Text
peekText Text
"text" Text
"string" Text
"string content"
    HsFnPrecursor e (LuaE e Inline)
-> FunctionResults e Inline -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Pusher e Inline -> Text -> Text -> FunctionResults e Inline
forall e a. Pusher e a -> Text -> Text -> FunctionResults e a
functionResult Pusher e Inline
forall e. LuaError e => Inline -> LuaE e ()
pushInline Text
"Inline" Text
"raw inline element"
  , Name -> ([Inline] -> Inline) -> DocumentedFunction e
forall e.
LuaError e =>
Name -> ([Inline] -> Inline) -> DocumentedFunction e
mkInlinesConstr Name
"SmallCaps" [Inline] -> Inline
SmallCaps
  , Name -> LuaE e Inline -> HsFnPrecursor e (LuaE e Inline)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"SoftBreak"
    ### return SoftBreak
    HsFnPrecursor e (LuaE e Inline)
-> FunctionResults e Inline -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Pusher e Inline -> Text -> Text -> FunctionResults e Inline
forall e a. Pusher e a -> Text -> Text -> FunctionResults e a
functionResult Pusher e Inline
forall e. LuaError e => Inline -> LuaE e ()
pushInline Text
"Inline" Text
"soft break"
  , Name -> LuaE e Inline -> HsFnPrecursor e (LuaE e Inline)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"Space"
    ### return Space
    HsFnPrecursor e (LuaE e Inline)
-> FunctionResults e Inline -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Pusher e Inline -> Text -> Text -> FunctionResults e Inline
forall e a. Pusher e a -> Text -> Text -> FunctionResults e a
functionResult Pusher e Inline
forall e. LuaError e => Inline -> LuaE e ()
pushInline Text
"Inline" Text
"new space"
  , Name
-> ([Inline] -> Maybe Attr -> LuaE e Inline)
-> HsFnPrecursor e ([Inline] -> Maybe Attr -> LuaE e Inline)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"Span"
    ### liftPure2 (\inlns mattr -> Span (fromMaybe nullAttr mattr) inlns)
    HsFnPrecursor e ([Inline] -> Maybe Attr -> LuaE e Inline)
-> Parameter e [Inline]
-> HsFnPrecursor e (Maybe Attr -> LuaE e Inline)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e [Inline] -> Text -> Text -> Text -> Parameter e [Inline]
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter Peeker e [Inline]
forall e. LuaError e => Peeker e [Inline]
peekInlinesFuzzy Text
"content" Text
"Inlines" Text
"inline content"
    HsFnPrecursor e (Maybe Attr -> LuaE e Inline)
-> Parameter e (Maybe Attr) -> HsFnPrecursor e (LuaE e Inline)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e Attr -> Text -> Text -> Text -> Parameter e (Maybe Attr)
forall e a.
Peeker e a -> Text -> Text -> Text -> Parameter e (Maybe a)
optionalParameter Peeker e Attr
forall e. LuaError e => Peeker e Attr
peekAttr Text
"attr" Text
"Attr" Text
"additional attributes"
    HsFnPrecursor e (LuaE e Inline)
-> FunctionResults e Inline -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Pusher e Inline -> Text -> Text -> FunctionResults e Inline
forall e a. Pusher e a -> Text -> Text -> FunctionResults e a
functionResult Pusher e Inline
forall e. LuaError e => Inline -> LuaE e ()
pushInline Text
"Inline" Text
"span element"
  , Name
-> (Text -> LuaE e Inline)
-> HsFnPrecursor e (Text -> LuaE e Inline)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"Str"
    ### liftPure Str
    HsFnPrecursor e (Text -> LuaE e Inline)
-> Parameter e Text -> HsFnPrecursor e (LuaE e Inline)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e Text -> Text -> Text -> Text -> Parameter e Text
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter Peeker e Text
forall e. Peeker e Text
peekText Text
"text" Text
"string" Text
""
    HsFnPrecursor e (LuaE e Inline)
-> FunctionResults e Inline -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Pusher e Inline -> Text -> Text -> FunctionResults e Inline
forall e a. Pusher e a -> Text -> Text -> FunctionResults e a
functionResult Pusher e Inline
forall e. LuaError e => Inline -> LuaE e ()
pushInline Text
"Inline" Text
"new Str object"
  , Name -> ([Inline] -> Inline) -> DocumentedFunction e
forall e.
LuaError e =>
Name -> ([Inline] -> Inline) -> DocumentedFunction e
mkInlinesConstr Name
"Strong" [Inline] -> Inline
Strong
  , Name -> ([Inline] -> Inline) -> DocumentedFunction e
forall e.
LuaError e =>
Name -> ([Inline] -> Inline) -> DocumentedFunction e
mkInlinesConstr Name
"Strikeout" [Inline] -> Inline
Strikeout
  , Name -> ([Inline] -> Inline) -> DocumentedFunction e
forall e.
LuaError e =>
Name -> ([Inline] -> Inline) -> DocumentedFunction e
mkInlinesConstr Name
"Subscript" [Inline] -> Inline
Subscript
  , Name -> ([Inline] -> Inline) -> DocumentedFunction e
forall e.
LuaError e =>
Name -> ([Inline] -> Inline) -> DocumentedFunction e
mkInlinesConstr Name
"Superscript" [Inline] -> Inline
Superscript
  , Name -> ([Inline] -> Inline) -> DocumentedFunction e
forall e.
LuaError e =>
Name -> ([Inline] -> Inline) -> DocumentedFunction e
mkInlinesConstr Name
"Underline" [Inline] -> Inline
Underline
  ]

blockConstructors :: LuaError e => [DocumentedFunction e]
blockConstructors :: [DocumentedFunction e]
blockConstructors =
  [ Name
-> ([Block] -> LuaE e Block)
-> HsFnPrecursor e ([Block] -> LuaE e Block)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"BlockQuote"
    ### liftPure BlockQuote
    HsFnPrecursor e ([Block] -> LuaE e Block)
-> Parameter e [Block] -> HsFnPrecursor e (LuaE e Block)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Parameter e [Block]
blocksParam
    HsFnPrecursor e (LuaE e Block)
-> FunctionResults e Block -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Text -> FunctionResults e Block
blockResult Text
"BlockQuote element"

  , Name
-> ([[Block]] -> LuaE e Block)
-> HsFnPrecursor e ([[Block]] -> LuaE e Block)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"BulletList"
    ### liftPure BulletList
    HsFnPrecursor e ([[Block]] -> LuaE e Block)
-> Parameter e [[Block]] -> HsFnPrecursor e (LuaE e Block)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Text -> Parameter e [[Block]]
blockItemsParam Text
"list items"
    HsFnPrecursor e (LuaE e Block)
-> FunctionResults e Block -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Text -> FunctionResults e Block
blockResult Text
"BulletList element"

  , Name
-> (Text -> Maybe Attr -> LuaE e Block)
-> HsFnPrecursor e (Text -> Maybe Attr -> LuaE e Block)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"CodeBlock"
    ### liftPure2 (\code mattr -> CodeBlock (fromMaybe nullAttr mattr) code)
    HsFnPrecursor e (Text -> Maybe Attr -> LuaE e Block)
-> Parameter e Text -> HsFnPrecursor e (Maybe Attr -> LuaE e Block)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Text -> Text -> Parameter e Text
forall e. LuaError e => Text -> Text -> Parameter e Text
textParam Text
"text" Text
"code block content"
    HsFnPrecursor e (Maybe Attr -> LuaE e Block)
-> Parameter e (Maybe Attr) -> HsFnPrecursor e (LuaE e Block)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Parameter e (Maybe Attr)
forall e. LuaError e => Parameter e (Maybe Attr)
optAttrParam
    HsFnPrecursor e (LuaE e Block)
-> FunctionResults e Block -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Text -> FunctionResults e Block
blockResult Text
"CodeBlock element"

  , Name
-> ([([Inline], [[Block]])] -> LuaE e Block)
-> HsFnPrecursor e ([([Inline], [[Block]])] -> LuaE e Block)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"DefinitionList"
    ### liftPure DefinitionList
    HsFnPrecursor e ([([Inline], [[Block]])] -> LuaE e Block)
-> Parameter e [([Inline], [[Block]])]
-> HsFnPrecursor e (LuaE e Block)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e [([Inline], [[Block]])]
-> Text -> Text -> Text -> Parameter e [([Inline], [[Block]])]
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter ([Peeker e [([Inline], [[Block]])]]
-> Peeker e [([Inline], [[Block]])]
forall e a. LuaError e => [Peeker e a] -> Peeker e a
choice
                   [ Peeker e ([Inline], [[Block]]) -> Peeker e [([Inline], [[Block]])]
forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList Peeker e ([Inline], [[Block]])
forall e. LuaError e => Peeker e ([Inline], [[Block]])
peekDefinitionItem
                   , \StackIndex
idx -> (([Inline], [[Block]])
-> [([Inline], [[Block]])] -> [([Inline], [[Block]])]
forall a. a -> [a] -> [a]
:[]) (([Inline], [[Block]]) -> [([Inline], [[Block]])])
-> Peek e ([Inline], [[Block]]) -> Peek e [([Inline], [[Block]])]
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Peeker e ([Inline], [[Block]])
forall e. LuaError e => Peeker e ([Inline], [[Block]])
peekDefinitionItem StackIndex
idx
                   ])
                  Text
"{{Inlines, {Blocks,...}},...}"
                  Text
"content" Text
"definition items"
    HsFnPrecursor e (LuaE e Block)
-> FunctionResults e Block -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Text -> FunctionResults e Block
blockResult Text
"DefinitionList element"

  , Name
-> ([Block] -> Maybe Attr -> LuaE e Block)
-> HsFnPrecursor e ([Block] -> Maybe Attr -> LuaE e Block)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"Div"
    ### liftPure2 (\content mattr -> Div (fromMaybe nullAttr mattr) content)
    HsFnPrecursor e ([Block] -> Maybe Attr -> LuaE e Block)
-> Parameter e [Block]
-> HsFnPrecursor e (Maybe Attr -> LuaE e Block)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Parameter e [Block]
blocksParam
    HsFnPrecursor e (Maybe Attr -> LuaE e Block)
-> Parameter e (Maybe Attr) -> HsFnPrecursor e (LuaE e Block)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Parameter e (Maybe Attr)
forall e. LuaError e => Parameter e (Maybe Attr)
optAttrParam
    HsFnPrecursor e (LuaE e Block)
-> FunctionResults e Block -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Text -> FunctionResults e Block
blockResult Text
"Div element"

  , Name
-> (Int -> [Inline] -> Maybe Attr -> LuaE e Block)
-> HsFnPrecursor e (Int -> [Inline] -> Maybe Attr -> LuaE e Block)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"Header"
    ### liftPure3 (\lvl content mattr ->
                     Header lvl (fromMaybe nullAttr mattr) content)
    HsFnPrecursor e (Int -> [Inline] -> Maybe Attr -> LuaE e Block)
-> Parameter e Int
-> HsFnPrecursor e ([Inline] -> Maybe Attr -> LuaE e Block)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e Int -> Text -> Text -> Text -> Parameter e Int
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter Peeker e Int
forall a e. (Integral a, Read a) => Peeker e a
peekIntegral Text
"integer" Text
"level" Text
"heading level"
    HsFnPrecursor e ([Inline] -> Maybe Attr -> LuaE e Block)
-> Parameter e [Inline]
-> HsFnPrecursor e (Maybe Attr -> LuaE e Block)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e [Inline] -> Text -> Text -> Text -> Parameter e [Inline]
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter Peeker e [Inline]
forall e. LuaError e => Peeker e [Inline]
peekInlinesFuzzy Text
"Inlines" Text
"content" Text
"inline content"
    HsFnPrecursor e (Maybe Attr -> LuaE e Block)
-> Parameter e (Maybe Attr) -> HsFnPrecursor e (LuaE e Block)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Parameter e (Maybe Attr)
forall e. LuaError e => Parameter e (Maybe Attr)
optAttrParam
    HsFnPrecursor e (LuaE e Block)
-> FunctionResults e Block -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Text -> FunctionResults e Block
blockResult Text
"Header element"

  , Name -> LuaE e Block -> HsFnPrecursor e (LuaE e Block)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"HorizontalRule"
    ### return HorizontalRule
    HsFnPrecursor e (LuaE e Block)
-> FunctionResults e Block -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Text -> FunctionResults e Block
blockResult Text
"HorizontalRule element"

  , Name
-> ([[Inline]] -> LuaE e Block)
-> HsFnPrecursor e ([[Inline]] -> LuaE e Block)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"LineBlock"
    ### liftPure LineBlock
    HsFnPrecursor e ([[Inline]] -> LuaE e Block)
-> Parameter e [[Inline]] -> HsFnPrecursor e (LuaE e Block)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e [[Inline]]
-> Text -> Text -> Text -> Parameter e [[Inline]]
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter (Peeker e [Inline] -> Peeker e [[Inline]]
forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList Peeker e [Inline]
forall e. LuaError e => Peeker e [Inline]
peekInlinesFuzzy) Text
"{Inlines,...}" Text
"content" Text
"lines"
    HsFnPrecursor e (LuaE e Block)
-> FunctionResults e Block -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Text -> FunctionResults e Block
blockResult Text
"LineBlock element"

  , Name -> LuaE e Block -> HsFnPrecursor e (LuaE e Block)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"Null"
    ### return Null
    HsFnPrecursor e (LuaE e Block)
-> FunctionResults e Block -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Text -> FunctionResults e Block
blockResult Text
"Null element"

  , Name
-> ([[Block]]
    -> Maybe (Int, ListNumberStyle, ListNumberDelim) -> LuaE e Block)
-> HsFnPrecursor
     e
     ([[Block]]
      -> Maybe (Int, ListNumberStyle, ListNumberDelim) -> LuaE e Block)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"OrderedList"
    ### liftPure2 (\items mListAttrib ->
                     let defListAttrib = (1, DefaultStyle, DefaultDelim)
                     in OrderedList (fromMaybe defListAttrib mListAttrib) items)
    HsFnPrecursor
  e
  ([[Block]]
   -> Maybe (Int, ListNumberStyle, ListNumberDelim) -> LuaE e Block)
-> Parameter e [[Block]]
-> HsFnPrecursor
     e (Maybe (Int, ListNumberStyle, ListNumberDelim) -> LuaE e Block)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Text -> Parameter e [[Block]]
blockItemsParam Text
"ordered list items"
    HsFnPrecursor
  e (Maybe (Int, ListNumberStyle, ListNumberDelim) -> LuaE e Block)
-> Parameter e (Maybe (Int, ListNumberStyle, ListNumberDelim))
-> HsFnPrecursor e (LuaE e Block)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e (Int, ListNumberStyle, ListNumberDelim)
-> Text
-> Text
-> Text
-> Parameter e (Maybe (Int, ListNumberStyle, ListNumberDelim))
forall e a.
Peeker e a -> Text -> Text -> Text -> Parameter e (Maybe a)
optionalParameter Peeker e (Int, ListNumberStyle, ListNumberDelim)
forall e.
LuaError e =>
Peeker e (Int, ListNumberStyle, ListNumberDelim)
peekListAttributes Text
"ListAttributes" Text
"listAttributes"
                          Text
"specifier for the list's numbering"
    HsFnPrecursor e (LuaE e Block)
-> FunctionResults e Block -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Text -> FunctionResults e Block
blockResult Text
"OrderedList element"

  , Name
-> ([Inline] -> LuaE e Block)
-> HsFnPrecursor e ([Inline] -> LuaE e Block)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"Para"
    ### liftPure Para
    HsFnPrecursor e ([Inline] -> LuaE e Block)
-> Parameter e [Inline] -> HsFnPrecursor e (LuaE e Block)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e [Inline] -> Text -> Text -> Text -> Parameter e [Inline]
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter Peeker e [Inline]
forall e. LuaError e => Peeker e [Inline]
peekInlinesFuzzy Text
"Inlines" Text
"content" Text
"paragraph content"
    HsFnPrecursor e (LuaE e Block)
-> FunctionResults e Block -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Text -> FunctionResults e Block
blockResult Text
"Para element"

  , Name
-> ([Inline] -> LuaE e Block)
-> HsFnPrecursor e ([Inline] -> LuaE e Block)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"Plain"
    ### liftPure Plain
    HsFnPrecursor e ([Inline] -> LuaE e Block)
-> Parameter e [Inline] -> HsFnPrecursor e (LuaE e Block)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e [Inline] -> Text -> Text -> Text -> Parameter e [Inline]
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter Peeker e [Inline]
forall e. LuaError e => Peeker e [Inline]
peekInlinesFuzzy Text
"Inlines" Text
"content" Text
"paragraph content"
    HsFnPrecursor e (LuaE e Block)
-> FunctionResults e Block -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Text -> FunctionResults e Block
blockResult Text
"Plain element"

  , Name
-> (Format -> Text -> LuaE e Block)
-> HsFnPrecursor e (Format -> Text -> LuaE e Block)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"RawBlock"
    ### liftPure2 RawBlock
    HsFnPrecursor e (Format -> Text -> LuaE e Block)
-> Parameter e Format -> HsFnPrecursor e (Text -> LuaE e Block)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e Format -> Text -> Text -> Text -> Parameter e Format
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter Peeker e Format
forall e. LuaError e => Peeker e Format
peekFormat Text
"Format" Text
"format" Text
"format of content"
    HsFnPrecursor e (Text -> LuaE e Block)
-> Parameter e Text -> HsFnPrecursor e (LuaE e Block)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e Text -> Text -> Text -> Text -> Parameter e Text
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter Peeker e Text
forall e. Peeker e Text
peekText Text
"string" Text
"text" Text
"raw content"
    HsFnPrecursor e (LuaE e Block)
-> FunctionResults e Block -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Text -> FunctionResults e Block
blockResult Text
"RawBlock element"

  , Name
-> (Caption
    -> [ColSpec]
    -> TableHead
    -> [TableBody]
    -> TableFoot
    -> Maybe Attr
    -> LuaE e Block)
-> HsFnPrecursor
     e
     (Caption
      -> [ColSpec]
      -> TableHead
      -> [TableBody]
      -> TableFoot
      -> Maybe Attr
      -> LuaE e Block)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"Table"
    ### (\capt colspecs thead tbodies tfoot mattr ->
           let attr = fromMaybe nullAttr mattr
           in return $! attr `seq` capt `seq` colspecs `seq` thead `seq` tbodies
              `seq` tfoot `seq` Table attr capt colspecs thead tbodies tfoot)
    HsFnPrecursor
  e
  (Caption
   -> [ColSpec]
   -> TableHead
   -> [TableBody]
   -> TableFoot
   -> Maybe Attr
   -> LuaE e Block)
-> Parameter e Caption
-> HsFnPrecursor
     e
     ([ColSpec]
      -> TableHead
      -> [TableBody]
      -> TableFoot
      -> Maybe Attr
      -> LuaE e Block)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e Caption -> Text -> Text -> Text -> Parameter e Caption
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter Peeker e Caption
forall e. LuaError e => Peeker e Caption
peekCaption Text
"Caption" Text
"caption" Text
"table caption"
    HsFnPrecursor
  e
  ([ColSpec]
   -> TableHead
   -> [TableBody]
   -> TableFoot
   -> Maybe Attr
   -> LuaE e Block)
-> Parameter e [ColSpec]
-> HsFnPrecursor
     e
     (TableHead
      -> [TableBody] -> TableFoot -> Maybe Attr -> LuaE e Block)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e [ColSpec] -> Text -> Text -> Text -> Parameter e [ColSpec]
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter (Peeker e ColSpec -> Peeker e [ColSpec]
forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList Peeker e ColSpec
forall e. LuaError e => Peeker e ColSpec
peekColSpec) Text
"{ColSpec,...}" Text
"colspecs"
                  Text
"column alignments and widths"
    HsFnPrecursor
  e
  (TableHead
   -> [TableBody] -> TableFoot -> Maybe Attr -> LuaE e Block)
-> Parameter e TableHead
-> HsFnPrecursor
     e ([TableBody] -> TableFoot -> Maybe Attr -> LuaE e Block)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e TableHead -> Text -> Text -> Text -> Parameter e TableHead
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter Peeker e TableHead
forall e. LuaError e => Peeker e TableHead
peekTableHead Text
"TableHead" Text
"head" Text
"table head"
    HsFnPrecursor
  e ([TableBody] -> TableFoot -> Maybe Attr -> LuaE e Block)
-> Parameter e [TableBody]
-> HsFnPrecursor e (TableFoot -> Maybe Attr -> LuaE e Block)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e [TableBody]
-> Text -> Text -> Text -> Parameter e [TableBody]
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter (Peeker e TableBody -> Peeker e [TableBody]
forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList Peeker e TableBody
forall e. LuaError e => Peeker e TableBody
peekTableBody) Text
"{TableBody,...}" Text
"bodies"
                  Text
"table bodies"
    HsFnPrecursor e (TableFoot -> Maybe Attr -> LuaE e Block)
-> Parameter e TableFoot
-> HsFnPrecursor e (Maybe Attr -> LuaE e Block)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e TableFoot -> Text -> Text -> Text -> Parameter e TableFoot
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter Peeker e TableFoot
forall e. LuaError e => Peeker e TableFoot
peekTableFoot Text
"TableFoot" Text
"foot" Text
"table foot"
    HsFnPrecursor e (Maybe Attr -> LuaE e Block)
-> Parameter e (Maybe Attr) -> HsFnPrecursor e (LuaE e Block)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Parameter e (Maybe Attr)
forall e. LuaError e => Parameter e (Maybe Attr)
optAttrParam
    HsFnPrecursor e (LuaE e Block)
-> FunctionResults e Block -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Text -> FunctionResults e Block
blockResult Text
"Table element"
  ]
 where
  blockResult :: Text -> FunctionResults e Block
blockResult = Pusher e Block -> Text -> Text -> FunctionResults e Block
forall e a. Pusher e a -> Text -> Text -> FunctionResults e a
functionResult Pusher e Block
forall e. LuaError e => Block -> LuaE e ()
pushBlock Text
"Block"
  blocksParam :: Parameter e [Block]
blocksParam = Peeker e [Block] -> Text -> Text -> Text -> Parameter e [Block]
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter Peeker e [Block]
forall e. LuaError e => Peeker e [Block]
peekBlocksFuzzy Text
"Blocks" Text
"content" Text
"block content"
  blockItemsParam :: Text -> Parameter e [[Block]]
blockItemsParam = Peeker e [[Block]] -> Text -> Text -> Text -> Parameter e [[Block]]
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter Peeker e [[Block]]
forall e. LuaError e => StackIndex -> Peek e [[Block]]
peekItemsFuzzy Text
"List of Blocks" Text
"content"
  peekItemsFuzzy :: StackIndex -> Peek e [[Block]]
peekItemsFuzzy StackIndex
idx = Peeker e [Block] -> StackIndex -> Peek e [[Block]]
forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList Peeker e [Block]
forall e. LuaError e => Peeker e [Block]
peekBlocksFuzzy StackIndex
idx
    Peek e [[Block]] -> Peek e [[Block]] -> Peek e [[Block]]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (([Block] -> [[Block]] -> [[Block]]
forall a. a -> [a] -> [a]
:[]) ([Block] -> [[Block]]) -> Peek e [Block] -> Peek e [[Block]]
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Peeker e [Block]
forall e. LuaError e => Peeker e [Block]
peekBlocksFuzzy StackIndex
idx)

textParam :: LuaError e => Text -> Text -> Parameter e Text
textParam :: Text -> Text -> Parameter e Text
textParam = Peeker e Text -> Text -> Text -> Text -> Parameter e Text
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter Peeker e Text
forall e. Peeker e Text
peekText Text
"string"

optAttrParam :: LuaError e => Parameter e (Maybe Attr)
optAttrParam :: Parameter e (Maybe Attr)
optAttrParam = Peeker e Attr -> Text -> Text -> Text -> Parameter e (Maybe Attr)
forall e a.
Peeker e a -> Text -> Text -> Text -> Parameter e (Maybe a)
optionalParameter Peeker e Attr
forall e. LuaError e => Peeker e Attr
peekAttr Text
"attr" Text
"Attr" Text
"additional attributes"

mkInlinesConstr :: LuaError e
                => Name -> ([Inline] -> Inline) -> DocumentedFunction e
mkInlinesConstr :: Name -> ([Inline] -> Inline) -> DocumentedFunction e
mkInlinesConstr Name
name [Inline] -> Inline
constr = Name
-> ([Inline] -> LuaE e Inline)
-> HsFnPrecursor e ([Inline] -> LuaE e Inline)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
name
  ### liftPure (\x -> x `seq` constr x)
  HsFnPrecursor e ([Inline] -> LuaE e Inline)
-> Parameter e [Inline] -> HsFnPrecursor e (LuaE e Inline)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e [Inline] -> Text -> Text -> Text -> Parameter e [Inline]
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter Peeker e [Inline]
forall e. LuaError e => Peeker e [Inline]
peekInlinesFuzzy Text
"content" Text
"Inlines" Text
""
  HsFnPrecursor e (LuaE e Inline)
-> FunctionResults e Inline -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Pusher e Inline -> Text -> Text -> FunctionResults e Inline
forall e a. Pusher e a -> Text -> Text -> FunctionResults e a
functionResult Pusher e Inline
forall e. LuaError e => Inline -> LuaE e ()
pushInline Text
"Inline" Text
"new object"

otherConstructors :: LuaError e => [DocumentedFunction e]
otherConstructors :: [DocumentedFunction e]
otherConstructors =
  [ Name
-> ([Block] -> Maybe Meta -> LuaE e Pandoc)
-> HsFnPrecursor e ([Block] -> Maybe Meta -> LuaE e Pandoc)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"Pandoc"
    ### liftPure2 (\blocks mMeta -> Pandoc (fromMaybe nullMeta mMeta) blocks)
    HsFnPrecursor e ([Block] -> Maybe Meta -> LuaE e Pandoc)
-> Parameter e [Block]
-> HsFnPrecursor e (Maybe Meta -> LuaE e Pandoc)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e [Block] -> Text -> Text -> Text -> Parameter e [Block]
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter Peeker e [Block]
forall e. LuaError e => Peeker e [Block]
peekBlocksFuzzy Text
"Blocks" Text
"blocks" Text
"document contents"
    HsFnPrecursor e (Maybe Meta -> LuaE e Pandoc)
-> Parameter e (Maybe Meta) -> HsFnPrecursor e (LuaE e Pandoc)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e Meta -> Text -> Text -> Text -> Parameter e (Maybe Meta)
forall e a.
Peeker e a -> Text -> Text -> Text -> Parameter e (Maybe a)
optionalParameter Peeker e Meta
forall e. LuaError e => Peeker e Meta
peekMeta Text
"Meta" Text
"meta" Text
"document metadata"
    HsFnPrecursor e (LuaE e Pandoc)
-> FunctionResults e Pandoc -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Pusher e Pandoc -> Text -> Text -> FunctionResults e Pandoc
forall e a. Pusher e a -> Text -> Text -> FunctionResults e a
functionResult Pusher e Pandoc
forall e. LuaError e => Pusher e Pandoc
pushPandoc Text
"Pandoc" Text
"new Pandoc document"

  , Name
-> (Text
    -> CitationMode
    -> Maybe [Inline]
    -> Maybe [Inline]
    -> Maybe Int
    -> Maybe Int
    -> LuaE e Citation)
-> HsFnPrecursor
     e
     (Text
      -> CitationMode
      -> Maybe [Inline]
      -> Maybe [Inline]
      -> Maybe Int
      -> Maybe Int
      -> LuaE e Citation)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"Citation"
    ### (\cid mode mprefix msuffix mnote_num mhash ->
          cid `seq` mode `seq` mprefix `seq` msuffix `seq`
          mnote_num `seq` mhash `seq` return $! Citation
            { citationId = cid
            , citationMode = mode
            , citationPrefix = fromMaybe mempty mprefix
            , citationSuffix = fromMaybe mempty msuffix
            , citationNoteNum = fromMaybe 0 mnote_num
            , citationHash = fromMaybe 0 mhash
            })
    HsFnPrecursor
  e
  (Text
   -> CitationMode
   -> Maybe [Inline]
   -> Maybe [Inline]
   -> Maybe Int
   -> Maybe Int
   -> LuaE e Citation)
-> Parameter e Text
-> HsFnPrecursor
     e
     (CitationMode
      -> Maybe [Inline]
      -> Maybe [Inline]
      -> Maybe Int
      -> Maybe Int
      -> LuaE e Citation)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e Text -> Text -> Text -> Text -> Parameter e Text
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter Peeker e Text
forall e. Peeker e Text
peekText Text
"string" Text
"cid" Text
"citation ID (e.g. bibtex key)"
    HsFnPrecursor
  e
  (CitationMode
   -> Maybe [Inline]
   -> Maybe [Inline]
   -> Maybe Int
   -> Maybe Int
   -> LuaE e Citation)
-> Parameter e CitationMode
-> HsFnPrecursor
     e
     (Maybe [Inline]
      -> Maybe [Inline] -> Maybe Int -> Maybe Int -> LuaE e Citation)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e CitationMode
-> Text -> Text -> Text -> Parameter e CitationMode
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter Peeker e CitationMode
forall a e. Read a => Peeker e a
peekRead Text
"citation mode" Text
"mode" Text
"citation rendering mode"
    HsFnPrecursor
  e
  (Maybe [Inline]
   -> Maybe [Inline] -> Maybe Int -> Maybe Int -> LuaE e Citation)
-> Parameter e (Maybe [Inline])
-> HsFnPrecursor
     e (Maybe [Inline] -> Maybe Int -> Maybe Int -> LuaE e Citation)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e [Inline]
-> Text -> Text -> Text -> Parameter e (Maybe [Inline])
forall e a.
Peeker e a -> Text -> Text -> Text -> Parameter e (Maybe a)
optionalParameter Peeker e [Inline]
forall e. LuaError e => Peeker e [Inline]
peekInlinesFuzzy Text
"prefix" Text
"Inlines" Text
""
    HsFnPrecursor
  e (Maybe [Inline] -> Maybe Int -> Maybe Int -> LuaE e Citation)
-> Parameter e (Maybe [Inline])
-> HsFnPrecursor e (Maybe Int -> Maybe Int -> LuaE e Citation)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e [Inline]
-> Text -> Text -> Text -> Parameter e (Maybe [Inline])
forall e a.
Peeker e a -> Text -> Text -> Text -> Parameter e (Maybe a)
optionalParameter Peeker e [Inline]
forall e. LuaError e => Peeker e [Inline]
peekInlinesFuzzy Text
"suffix" Text
"Inlines" Text
""
    HsFnPrecursor e (Maybe Int -> Maybe Int -> LuaE e Citation)
-> Parameter e (Maybe Int)
-> HsFnPrecursor e (Maybe Int -> LuaE e Citation)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e Int -> Text -> Text -> Text -> Parameter e (Maybe Int)
forall e a.
Peeker e a -> Text -> Text -> Text -> Parameter e (Maybe a)
optionalParameter Peeker e Int
forall a e. (Integral a, Read a) => Peeker e a
peekIntegral Text
"note_num" Text
"integer" Text
"note number"
    HsFnPrecursor e (Maybe Int -> LuaE e Citation)
-> Parameter e (Maybe Int) -> HsFnPrecursor e (LuaE e Citation)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e Int -> Text -> Text -> Text -> Parameter e (Maybe Int)
forall e a.
Peeker e a -> Text -> Text -> Text -> Parameter e (Maybe a)
optionalParameter Peeker e Int
forall a e. (Integral a, Read a) => Peeker e a
peekIntegral Text
"hash" Text
"integer" Text
"hash number"
    HsFnPrecursor e (LuaE e Citation)
-> FunctionResults e Citation -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Pusher e Citation -> Text -> Text -> FunctionResults e Citation
forall e a. Pusher e a -> Text -> Text -> FunctionResults e a
functionResult Pusher e Citation
forall e. LuaError e => Pusher e Citation
pushCitation Text
"Citation" Text
"new citation object"
    #? "Creates a single citation."

  , DocumentedFunction e
forall e. LuaError e => DocumentedFunction e
mkAttr
  , DocumentedFunction e
forall e. LuaError e => DocumentedFunction e
mkAttributeList
  , DocumentedFunction e
forall e. LuaError e => DocumentedFunction e
mkListAttributes
  , DocumentedFunction e
forall e. LuaError e => DocumentedFunction e
mkSimpleTable

  , Name
-> (ReaderOptions -> LuaE e ReaderOptions)
-> HsFnPrecursor e (ReaderOptions -> LuaE e ReaderOptions)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"ReaderOptions"
    ### liftPure id
    HsFnPrecursor e (ReaderOptions -> LuaE e ReaderOptions)
-> Parameter e ReaderOptions
-> HsFnPrecursor e (LuaE e ReaderOptions)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e ReaderOptions
-> Text -> Text -> Text -> Parameter e ReaderOptions
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter Peeker e ReaderOptions
forall e. LuaError e => Peeker e ReaderOptions
peekReaderOptions Text
"ReaderOptions|table" Text
"opts" Text
"reader options"
    HsFnPrecursor e (LuaE e ReaderOptions)
-> FunctionResults e ReaderOptions -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Pusher e ReaderOptions
-> Text -> Text -> FunctionResults e ReaderOptions
forall e a. Pusher e a -> Text -> Text -> FunctionResults e a
functionResult Pusher e ReaderOptions
forall e. LuaError e => Pusher e ReaderOptions
pushReaderOptions Text
"ReaderOptions" Text
"new object"
    #? "Creates a new ReaderOptions value."
  ]

stringConstants :: [Field e]
stringConstants :: [Field e]
stringConstants =
  let constrs :: forall a. Data a => Proxy a -> [String]
      constrs :: Proxy a -> [String]
constrs Proxy a
_ = (Constr -> String) -> [Constr] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Constr -> String
showConstr ([Constr] -> [String]) -> (a -> [Constr]) -> a -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DataType -> [Constr]
dataTypeConstrs (DataType -> [Constr]) -> (a -> DataType) -> a -> [Constr]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Data a => a -> DataType
forall a. Data a => a -> DataType
dataTypeOf @a (a -> [String]) -> a -> [String]
forall a b. (a -> b) -> a -> b
$ a
forall a. HasCallStack => a
undefined
      nullaryConstructors :: [String]
nullaryConstructors = [[String]] -> [String]
forall a. Monoid a => [a] -> a
mconcat
        [ Proxy ListNumberStyle -> [String]
forall a. Data a => Proxy a -> [String]
constrs (Proxy ListNumberStyle
forall k (t :: k). Proxy t
Proxy @ListNumberStyle)
        , Proxy ListNumberDelim -> [String]
forall a. Data a => Proxy a -> [String]
constrs (Proxy ListNumberDelim
forall k (t :: k). Proxy t
Proxy @ListNumberDelim)
        , Proxy QuoteType -> [String]
forall a. Data a => Proxy a -> [String]
constrs (Proxy QuoteType
forall k (t :: k). Proxy t
Proxy @QuoteType)
        , Proxy MathType -> [String]
forall a. Data a => Proxy a -> [String]
constrs (Proxy MathType
forall k (t :: k). Proxy t
Proxy @MathType)
        , Proxy Alignment -> [String]
forall a. Data a => Proxy a -> [String]
constrs (Proxy Alignment
forall k (t :: k). Proxy t
Proxy @Alignment)
        , Proxy CitationMode -> [String]
forall a. Data a => Proxy a -> [String]
constrs (Proxy CitationMode
forall k (t :: k). Proxy t
Proxy @CitationMode)
        ]
      toField :: String -> Field e
toField String
s = Field :: forall e. Text -> Text -> LuaE e () -> Field e
Field
        { fieldName :: Text
fieldName = String -> Text
T.pack String
s
        , fieldDescription :: Text
fieldDescription = String -> Text
T.pack String
s
        , fieldPushValue :: LuaE e ()
fieldPushValue = String -> LuaE e ()
forall e. String -> LuaE e ()
pushString String
s
        }
  in (String -> Field e) -> [String] -> [Field e]
forall a b. (a -> b) -> [a] -> [b]
map String -> Field e
forall e. String -> Field e
toField [String]
nullaryConstructors

walkElement :: (Walkable (SingletonsList Inline) a,
                Walkable (SingletonsList Block) a,
                Walkable (List Inline) a,
                Walkable (List Block) a)
            => a -> LuaFilter -> LuaE PandocError a
walkElement :: a -> LuaFilter -> LuaE PandocError a
walkElement a
x LuaFilter
f = LuaFilter -> a -> LuaE PandocError a
forall a.
Walkable (SingletonsList Inline) a =>
LuaFilter -> a -> LuaE PandocError a
walkInlines LuaFilter
f a
x
              LuaE PandocError a
-> (a -> LuaE PandocError a) -> LuaE PandocError a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= LuaFilter -> a -> LuaE PandocError a
forall a.
Walkable (List Inline) a =>
LuaFilter -> a -> LuaE PandocError a
walkInlineLists LuaFilter
f
              LuaE PandocError a
-> (a -> LuaE PandocError a) -> LuaE PandocError a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= LuaFilter -> a -> LuaE PandocError a
forall a.
Walkable (SingletonsList Block) a =>
LuaFilter -> a -> LuaE PandocError a
walkBlocks LuaFilter
f
              LuaE PandocError a
-> (a -> LuaE PandocError a) -> LuaE PandocError a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= LuaFilter -> a -> LuaE PandocError a
forall a.
Walkable (List Block) a =>
LuaFilter -> a -> LuaE PandocError a
walkBlockLists LuaFilter
f

functions :: [DocumentedFunction PandocError]
functions :: [DocumentedFunction PandocError]
functions =
  [ Name
-> (String
    -> [String] -> ByteString -> LuaE PandocError NumResults)
-> HsFnPrecursor
     PandocError
     (String -> [String] -> ByteString -> LuaE PandocError NumResults)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"pipe"
    ### (\command args input -> do
            (ec, output) <- Lua.liftIO $ pipeProcess Nothing command args input
                            `catch` (throwM . PandocIOError "pipe")
            case ec of
              ExitSuccess -> 1 <$ Lua.pushLazyByteString output
              ExitFailure n -> do
                pushPipeError (PipeError (T.pack command) n output)
                Lua.error)
    HsFnPrecursor
  PandocError
  (String -> [String] -> ByteString -> LuaE PandocError NumResults)
-> Parameter PandocError String
-> HsFnPrecursor
     PandocError ([String] -> ByteString -> LuaE PandocError NumResults)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker PandocError String
-> Text -> Text -> Text -> Parameter PandocError String
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter Peeker PandocError String
forall e. Peeker e String
peekString Text
"string" Text
"command" Text
"path to executable"
    HsFnPrecursor
  PandocError ([String] -> ByteString -> LuaE PandocError NumResults)
-> Parameter PandocError [String]
-> HsFnPrecursor
     PandocError (ByteString -> LuaE PandocError NumResults)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker PandocError [String]
-> Text -> Text -> Text -> Parameter PandocError [String]
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter (Peeker PandocError String -> Peeker PandocError [String]
forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList Peeker PandocError String
forall e. Peeker e String
peekString) Text
"{string,...}" Text
"args"
          Text
"list of arguments"
    HsFnPrecursor
  PandocError (ByteString -> LuaE PandocError NumResults)
-> Parameter PandocError ByteString
-> HsFnPrecursor PandocError (LuaE PandocError NumResults)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker PandocError ByteString
-> Text -> Text -> Text -> Parameter PandocError ByteString
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter Peeker PandocError ByteString
forall e. Peeker e ByteString
peekLazyByteString Text
"string" Text
"input"
          Text
"input passed to process via stdin"
    HsFnPrecursor PandocError (LuaE PandocError NumResults)
-> Text -> DocumentedFunction PandocError
forall e.
HsFnPrecursor e (LuaE e NumResults) -> Text -> DocumentedFunction e
=?> Text
"output string, or error triple"

  , Name
-> (Text
    -> Maybe Text -> Maybe ReaderOptions -> LuaE PandocError Pandoc)
-> HsFnPrecursor
     PandocError
     (Text
      -> Maybe Text -> Maybe ReaderOptions -> LuaE PandocError Pandoc)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"read"
    ### (\content mformatspec mreaderOptions -> do
            let formatSpec = fromMaybe "markdown" mformatspec
                readerOptions = fromMaybe def mreaderOptions
            res <- Lua.liftIO . runIO $ getReader formatSpec >>= \case
              (TextReader r, es) -> r readerOptions{ readerExtensions = es }
                                      content
              _ -> throwError $ PandocSomeError
                   "Only textual formats are supported"
            case res of
              Right pd -> return pd -- success, got a Pandoc document
              Left  (PandocUnknownReaderError f) ->
                Lua.failLua . T.unpack $ "Unknown reader: " <> f
              Left  (PandocUnsupportedExtensionError e f) ->
                Lua.failLua . T.unpack $
                "Extension " <> e <> " not supported for " <> f
              Left e ->
                throwM e)
    HsFnPrecursor
  PandocError
  (Text
   -> Maybe Text -> Maybe ReaderOptions -> LuaE PandocError Pandoc)
-> Parameter PandocError Text
-> HsFnPrecursor
     PandocError
     (Maybe Text -> Maybe ReaderOptions -> LuaE PandocError Pandoc)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker PandocError Text
-> Text -> Text -> Text -> Parameter PandocError Text
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter Peeker PandocError Text
forall e. Peeker e Text
peekText Text
"string" Text
"content" Text
"text to parse"
    HsFnPrecursor
  PandocError
  (Maybe Text -> Maybe ReaderOptions -> LuaE PandocError Pandoc)
-> Parameter PandocError (Maybe Text)
-> HsFnPrecursor
     PandocError (Maybe ReaderOptions -> LuaE PandocError Pandoc)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker PandocError Text
-> Text -> Text -> Text -> Parameter PandocError (Maybe Text)
forall e a.
Peeker e a -> Text -> Text -> Text -> Parameter e (Maybe a)
optionalParameter Peeker PandocError Text
forall e. Peeker e Text
peekText Text
"string" Text
"formatspec" Text
"format and extensions"
    HsFnPrecursor
  PandocError (Maybe ReaderOptions -> LuaE PandocError Pandoc)
-> Parameter PandocError (Maybe ReaderOptions)
-> HsFnPrecursor PandocError (LuaE PandocError Pandoc)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker PandocError ReaderOptions
-> Text
-> Text
-> Text
-> Parameter PandocError (Maybe ReaderOptions)
forall e a.
Peeker e a -> Text -> Text -> Text -> Parameter e (Maybe a)
optionalParameter Peeker PandocError ReaderOptions
forall e. LuaError e => Peeker e ReaderOptions
peekReaderOptions Text
"ReaderOptions" Text
"reader_options"
          Text
"reader options"
    HsFnPrecursor PandocError (LuaE PandocError Pandoc)
-> FunctionResults PandocError Pandoc
-> DocumentedFunction PandocError
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Pusher PandocError Pandoc
-> Text -> Text -> FunctionResults PandocError Pandoc
forall e a. Pusher e a -> Text -> Text -> FunctionResults e a
functionResult Pusher PandocError Pandoc
forall e. LuaError e => Pusher e Pandoc
pushPandoc Text
"Pandoc" Text
"result document"

  , DocumentedFunction PandocError
forall e. DocumentedFunction e
sha1

  , Name
-> (Block -> LuaFilter -> LuaE PandocError Block)
-> HsFnPrecursor
     PandocError (Block -> LuaFilter -> LuaE PandocError Block)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"walk_block"
    ### walkElement
    HsFnPrecursor
  PandocError (Block -> LuaFilter -> LuaE PandocError Block)
-> Parameter PandocError Block
-> HsFnPrecursor PandocError (LuaFilter -> LuaE PandocError Block)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker PandocError Block
-> Text -> Text -> Text -> Parameter PandocError Block
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter Peeker PandocError Block
forall e. LuaError e => Peeker e Block
peekBlockFuzzy Text
"Block" Text
"block" Text
"element to traverse"
    HsFnPrecursor PandocError (LuaFilter -> LuaE PandocError Block)
-> Parameter PandocError LuaFilter
-> HsFnPrecursor PandocError (LuaE PandocError Block)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker PandocError LuaFilter
-> Text -> Text -> Text -> Parameter PandocError LuaFilter
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter Peeker PandocError LuaFilter
forall e. LuaError e => Peeker e LuaFilter
peekLuaFilter Text
"LuaFilter" Text
"filter" Text
"filter functions"
    HsFnPrecursor PandocError (LuaE PandocError Block)
-> FunctionResults PandocError Block
-> DocumentedFunction PandocError
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Pusher PandocError Block
-> Text -> Text -> FunctionResults PandocError Block
forall e a. Pusher e a -> Text -> Text -> FunctionResults e a
functionResult Pusher PandocError Block
forall e. LuaError e => Block -> LuaE e ()
pushBlock Text
"Block" Text
"modified Block"

  , Name
-> (Inline -> LuaFilter -> LuaE PandocError Inline)
-> HsFnPrecursor
     PandocError (Inline -> LuaFilter -> LuaE PandocError Inline)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"walk_inline"
    ### walkElement
    HsFnPrecursor
  PandocError (Inline -> LuaFilter -> LuaE PandocError Inline)
-> Parameter PandocError Inline
-> HsFnPrecursor PandocError (LuaFilter -> LuaE PandocError Inline)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker PandocError Inline
-> Text -> Text -> Text -> Parameter PandocError Inline
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter Peeker PandocError Inline
forall e. LuaError e => Peeker e Inline
peekInlineFuzzy Text
"Inline" Text
"inline" Text
"element to traverse"
    HsFnPrecursor PandocError (LuaFilter -> LuaE PandocError Inline)
-> Parameter PandocError LuaFilter
-> HsFnPrecursor PandocError (LuaE PandocError Inline)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker PandocError LuaFilter
-> Text -> Text -> Text -> Parameter PandocError LuaFilter
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter Peeker PandocError LuaFilter
forall e. LuaError e => Peeker e LuaFilter
peekLuaFilter Text
"LuaFilter" Text
"filter" Text
"filter functions"
    HsFnPrecursor PandocError (LuaE PandocError Inline)
-> FunctionResults PandocError Inline
-> DocumentedFunction PandocError
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Pusher PandocError Inline
-> Text -> Text -> FunctionResults PandocError Inline
forall e a. Pusher e a -> Text -> Text -> FunctionResults e a
functionResult Pusher PandocError Inline
forall e. LuaError e => Inline -> LuaE e ()
pushInline Text
"Inline" Text
"modified Inline"
  ]

data PipeError = PipeError
  { PipeError -> Text
pipeErrorCommand :: T.Text
  , PipeError -> Int
pipeErrorCode :: Int
  , PipeError -> ByteString
pipeErrorOutput :: BL.ByteString
  }

peekPipeError :: PeekError e => StackIndex -> LuaE e PipeError
peekPipeError :: StackIndex -> LuaE e PipeError
peekPipeError StackIndex
idx =
  Text -> Int -> ByteString -> PipeError
PipeError
  (Text -> Int -> ByteString -> PipeError)
-> LuaE e Text -> LuaE e (Int -> ByteString -> PipeError)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (StackIndex -> Name -> LuaE e Type
forall e. LuaError e => StackIndex -> Name -> LuaE e Type
Lua.getfield StackIndex
idx Name
"command"    LuaE e Type -> LuaE e Text -> LuaE e Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> StackIndex -> LuaE e Text
forall a e. (Peekable a, PeekError e) => StackIndex -> LuaE e a
Lua.peek (-StackIndex
1) LuaE e Text -> LuaE e () -> LuaE e Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Int -> LuaE e ()
forall e. Int -> LuaE e ()
Lua.pop Int
1)
  LuaE e (Int -> ByteString -> PipeError)
-> LuaE e Int -> LuaE e (ByteString -> PipeError)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (StackIndex -> Name -> LuaE e Type
forall e. LuaError e => StackIndex -> Name -> LuaE e Type
Lua.getfield StackIndex
idx Name
"error_code" LuaE e Type -> LuaE e Int -> LuaE e Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> StackIndex -> LuaE e Int
forall a e. (Peekable a, PeekError e) => StackIndex -> LuaE e a
Lua.peek (-StackIndex
1) LuaE e Int -> LuaE e () -> LuaE e Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Int -> LuaE e ()
forall e. Int -> LuaE e ()
Lua.pop Int
1)
  LuaE e (ByteString -> PipeError)
-> LuaE e ByteString -> LuaE e PipeError
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (StackIndex -> Name -> LuaE e Type
forall e. LuaError e => StackIndex -> Name -> LuaE e Type
Lua.getfield StackIndex
idx Name
"output"     LuaE e Type -> LuaE e ByteString -> LuaE e ByteString
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> StackIndex -> LuaE e ByteString
forall a e. (Peekable a, PeekError e) => StackIndex -> LuaE e a
Lua.peek (-StackIndex
1) LuaE e ByteString -> LuaE e () -> LuaE e ByteString
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Int -> LuaE e ()
forall e. Int -> LuaE e ()
Lua.pop Int
1)

pushPipeError :: PeekError e => Pusher e PipeError
pushPipeError :: Pusher e PipeError
pushPipeError PipeError
pipeErr = do
  LuaE e ()
forall e. LuaE e ()
Lua.newtable
  String -> Text -> LuaE e ()
forall e a. (LuaError e, Pushable a) => String -> a -> LuaE e ()
LuaUtil.addField String
"command" (PipeError -> Text
pipeErrorCommand PipeError
pipeErr)
  String -> Int -> LuaE e ()
forall e a. (LuaError e, Pushable a) => String -> a -> LuaE e ()
LuaUtil.addField String
"error_code" (PipeError -> Int
pipeErrorCode PipeError
pipeErr)
  String -> ByteString -> LuaE e ()
forall e a. (LuaError e, Pushable a) => String -> a -> LuaE e ()
LuaUtil.addField String
"output" (PipeError -> ByteString
pipeErrorOutput PipeError
pipeErr)
  LuaE e ()
forall e. PeekError e => LuaE e ()
pushPipeErrorMetaTable
  StackIndex -> LuaE e ()
forall e. StackIndex -> LuaE e ()
Lua.setmetatable (-StackIndex
2)
    where
      pushPipeErrorMetaTable :: PeekError e => LuaE e ()
      pushPipeErrorMetaTable :: LuaE e ()
pushPipeErrorMetaTable = do
        Bool
v <- Name -> LuaE e Bool
forall e. Name -> LuaE e Bool
Lua.newmetatable Name
"pandoc pipe error"
        Bool -> LuaE e () -> LuaE e ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
v (LuaE e () -> LuaE e ()) -> LuaE e () -> LuaE e ()
forall a b. (a -> b) -> a -> b
$ do
          Name -> LuaE e ()
forall e. Name -> LuaE e ()
pushName Name
"__tostring"
          HaskellFunction e -> LuaE e ()
forall e. LuaError e => HaskellFunction e -> LuaE e ()
pushHaskellFunction HaskellFunction e
forall e. PeekError e => LuaE e NumResults
pipeErrorMessage
          StackIndex -> LuaE e ()
forall e. LuaError e => StackIndex -> LuaE e ()
rawset (CInt -> StackIndex
nth CInt
3)

      pipeErrorMessage :: PeekError e => LuaE e NumResults
      pipeErrorMessage :: LuaE e NumResults
pipeErrorMessage = do
        (PipeError Text
cmd Int
errorCode ByteString
output) <- StackIndex -> LuaE e PipeError
forall e. PeekError e => StackIndex -> LuaE e PipeError
peekPipeError (CInt -> StackIndex
nthBottom CInt
1)
        Pusher e ByteString
forall e. Pusher e ByteString
pushByteString Pusher e ByteString
-> ([ByteString] -> ByteString) -> [ByteString] -> LuaE e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BSL.toStrict (ByteString -> ByteString)
-> ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
BSL.concat ([ByteString] -> LuaE e ()) -> [ByteString] -> LuaE e ()
forall a b. (a -> b) -> a -> b
$
          [ String -> ByteString
BSL.pack String
"Error running "
          , String -> ByteString
BSL.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
cmd
          , String -> ByteString
BSL.pack String
" (error code "
          , String -> ByteString
BSL.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
errorCode
          , String -> ByteString
BSL.pack String
"): "
          , if ByteString
output ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
forall a. Monoid a => a
mempty then String -> ByteString
BSL.pack String
"<no output>" else ByteString
output
          ]
        NumResults -> LuaE e NumResults
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt -> NumResults
NumResults CInt
1)