{-# LANGUAGE OverloadedStrings #-}
module Text.Pandoc.Lua.Module.Scaffolding
( documentedModule
) where
import HsLua
import Text.Pandoc.Error (PandocError)
import Text.Pandoc.Lua.Writer.Scaffolding (pushWriterScaffolding)
import qualified Data.Text as T
documentedModule :: Module PandocError
documentedModule :: Module PandocError
documentedModule = Module
{ moduleName :: Name
moduleName = Name
"pandoc.scaffolding"
, moduleDescription :: Text
moduleDescription = [Text] -> Text
T.unlines
[ Text
"Scaffolding for custom writers."
]
, moduleFields :: [Field PandocError]
moduleFields = [Field PandocError
writerScaffolding]
, moduleOperations :: [(Operation, DocumentedFunction PandocError)]
moduleOperations = []
, moduleFunctions :: [DocumentedFunction PandocError]
moduleFunctions = []
, moduleTypeInitializers :: [LuaE PandocError Name]
moduleTypeInitializers = []
}
writerScaffolding :: Field PandocError
writerScaffolding :: Field PandocError
writerScaffolding = Field
{ fieldName :: Text
fieldName = Text
"Writer"
, fieldType :: TypeSpec
fieldType = TypeSpec
"table"
, fieldDescription :: Text
fieldDescription = [Text] -> Text
T.unlines
[ Text
"An object to be used as a `Writer` function; the construct handles"
, Text
"most of the boilerplate, expecting only render functions for all"
, Text
"AST elements"
]
, fieldPushValue :: LuaE PandocError ()
fieldPushValue = do
LuaE PandocError NumResults
pushWriterScaffolding
StackIndex -> Name -> LuaE PandocError Type
forall e. LuaError e => StackIndex -> Name -> LuaE e Type
getfield StackIndex
registryindex Name
loaded
StackIndex -> LuaE PandocError ()
forall e. StackIndex -> LuaE e ()
pushvalue (CInt -> StackIndex
nth CInt
2)
StackIndex -> Name -> LuaE PandocError ()
forall e. LuaError e => StackIndex -> Name -> LuaE e ()
setfield (CInt -> StackIndex
nth CInt
2) (Name -> Name
submod Name
"Writer")
StackIndex -> Name -> LuaE PandocError Type
forall e. LuaError e => StackIndex -> Name -> LuaE e Type
getfield (CInt -> StackIndex
nth CInt
2) Name
"Inline" LuaE PandocError Type -> 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 (CInt -> StackIndex
nth CInt
2) (Name -> Name
submod Name
"Writer.Inline")
StackIndex -> Name -> LuaE PandocError Type
forall e. LuaError e => StackIndex -> Name -> LuaE e Type
getfield (CInt -> StackIndex
nth CInt
2) Name
"Block" LuaE PandocError Type -> 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 (CInt -> StackIndex
nth CInt
2) (Name -> Name
submod Name
"Writer.Block")
Int -> LuaE PandocError ()
forall e. Int -> LuaE e ()
pop Int
1
}
where submod :: Name -> Name
submod Name
x = Module PandocError -> Name
forall e. Module e -> Name
moduleName Module PandocError
documentedModule Name -> Name -> Name
forall a. Semigroup a => a -> a -> a
<> Name
"." Name -> Name -> Name
forall a. Semigroup a => a -> a -> a
<> Name
x