{-# LANGUAGE OverloadedStrings #-}
module Text.Pandoc.Lua.Module.Format
( documentedModule
) where
import Data.Version (makeVersion)
import HsLua
import Text.Pandoc.Error (PandocError)
import Text.Pandoc.Extensions (getAllExtensions, getDefaultExtensions)
import Text.Pandoc.Format (formatFromFilePaths, formatName, getExtensionsConfig)
import Text.Pandoc.Lua.Marshal.Format (pushExtensions, pushExtensionsConfig)
import Text.Pandoc.Lua.PandocLua ()
import qualified Data.Text as T
documentedModule :: Module PandocError
documentedModule :: Module PandocError
documentedModule = Module :: forall e.
Name
-> Text
-> [Field e]
-> [DocumentedFunction e]
-> [(Operation, DocumentedFunction e)]
-> [LuaE e Name]
-> Module e
Module
{ moduleName :: Name
moduleName = Name
"pandoc.format"
, moduleDescription :: Text
moduleDescription = [Text] -> Text
T.unlines
[ Text
"Information about the formats supported by pandoc."
]
, moduleFields :: [Field PandocError]
moduleFields = []
, moduleOperations :: [(Operation, DocumentedFunction PandocError)]
moduleOperations = []
, moduleFunctions :: [DocumentedFunction PandocError]
moduleFunctions = [DocumentedFunction PandocError]
functions
, moduleTypeInitializers :: [LuaE PandocError Name]
moduleTypeInitializers = []
}
functions :: [DocumentedFunction PandocError]
functions :: [DocumentedFunction PandocError]
functions =
[ Name
-> (Text -> LuaE PandocError Extensions)
-> HsFnPrecursor PandocError (Text -> LuaE PandocError Extensions)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"all_extensions"
### liftPure getAllExtensions
HsFnPrecursor PandocError (Text -> LuaE PandocError Extensions)
-> Parameter PandocError Text
-> HsFnPrecursor PandocError (LuaE PandocError Extensions)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker PandocError Text
-> TypeSpec -> Text -> Text -> Parameter PandocError Text
forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter Peeker PandocError Text
forall e. Peeker e Text
peekText TypeSpec
"string" Text
"format" Text
"format name"
HsFnPrecursor PandocError (LuaE PandocError Extensions)
-> FunctionResults PandocError Extensions
-> DocumentedFunction PandocError
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Pusher PandocError Extensions
-> TypeSpec -> Text -> FunctionResults PandocError Extensions
forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult Pusher PandocError Extensions
forall e. LuaError e => Pusher e Extensions
pushExtensions TypeSpec
"FormatExtensions"
Text
"all extensions supported for `format`"
#? T.unlines
[ "Returns the list of all valid extensions for a format."
, "No distinction is made between input and output; an extension"
, "can have an effect when reading a format but not when"
, "writing it, or *vice versa*."
]
DocumentedFunction PandocError
-> Version -> DocumentedFunction PandocError
forall e. DocumentedFunction e -> Version -> DocumentedFunction e
`since` [Int] -> Version
makeVersion [Int
3,Int
0]
, Name
-> (Text -> LuaE PandocError Extensions)
-> HsFnPrecursor PandocError (Text -> LuaE PandocError Extensions)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"default_extensions"
### liftPure getDefaultExtensions
HsFnPrecursor PandocError (Text -> LuaE PandocError Extensions)
-> Parameter PandocError Text
-> HsFnPrecursor PandocError (LuaE PandocError Extensions)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker PandocError Text
-> TypeSpec -> Text -> Text -> Parameter PandocError Text
forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter Peeker PandocError Text
forall e. Peeker e Text
peekText TypeSpec
"string" Text
"format" Text
"format name"
HsFnPrecursor PandocError (LuaE PandocError Extensions)
-> FunctionResults PandocError Extensions
-> DocumentedFunction PandocError
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Pusher PandocError Extensions
-> TypeSpec -> Text -> FunctionResults PandocError Extensions
forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult Pusher PandocError Extensions
forall e. LuaError e => Pusher e Extensions
pushExtensions TypeSpec
"FormatExtensions"
Text
"default extensions enabled for `format`"
#? T.unlines
[ "Returns the list of default extensions of the given format; this"
, "function does not check if the format is supported, it will return"
, "a fallback list of extensions even for unknown formats."
]
DocumentedFunction PandocError
-> Version -> DocumentedFunction PandocError
forall e. DocumentedFunction e -> Version -> DocumentedFunction e
`since` [Int] -> Version
makeVersion [Int
3,Int
0]
, Name
-> (Text -> LuaE PandocError ExtensionsConfig)
-> HsFnPrecursor
PandocError (Text -> LuaE PandocError ExtensionsConfig)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"extensions"
### liftPure getExtensionsConfig
HsFnPrecursor
PandocError (Text -> LuaE PandocError ExtensionsConfig)
-> Parameter PandocError Text
-> HsFnPrecursor PandocError (LuaE PandocError ExtensionsConfig)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Text -> Text -> Parameter PandocError Text
forall e. Text -> Text -> Parameter e Text
textParam Text
"format" Text
"format identifier"
HsFnPrecursor PandocError (LuaE PandocError ExtensionsConfig)
-> FunctionResults PandocError ExtensionsConfig
-> DocumentedFunction PandocError
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Pusher PandocError ExtensionsConfig
-> TypeSpec -> Text -> FunctionResults PandocError ExtensionsConfig
forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult Pusher PandocError ExtensionsConfig
forall e. LuaError e => Pusher e ExtensionsConfig
pushExtensionsConfig TypeSpec
"table" Text
"extensions config"
#? T.unlines
[ "Returns the extension configuration for the given format."
, "The configuration is represented as a table with all supported"
, "extensions as keys and their default status as value, with"
, "`true` indicating that the extension is enabled by default,"
, "while `false` marks a supported extension that's disabled."
, ""
, "This function can be used to assign a value to the `Extensions`"
, "global in custom readers and writers."
]
DocumentedFunction PandocError
-> Version -> DocumentedFunction PandocError
forall e. DocumentedFunction e -> Version -> DocumentedFunction e
`since` [Int] -> Version
makeVersion [Int
3,Int
0]
, Name
-> ([FilePath] -> LuaE PandocError (Maybe FlavoredFormat))
-> HsFnPrecursor
PandocError ([FilePath] -> LuaE PandocError (Maybe FlavoredFormat))
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"from_path"
### liftPure formatFromFilePaths
HsFnPrecursor
PandocError ([FilePath] -> LuaE PandocError (Maybe FlavoredFormat))
-> Parameter PandocError [FilePath]
-> HsFnPrecursor
PandocError (LuaE PandocError (Maybe FlavoredFormat))
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker PandocError [FilePath]
-> TypeSpec -> Text -> Text -> Parameter PandocError [FilePath]
forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter ([Peeker PandocError [FilePath]] -> Peeker PandocError [FilePath]
forall e a. LuaError e => [Peeker e a] -> Peeker e a
choice [ (FilePath -> [FilePath])
-> Peek PandocError FilePath -> Peek PandocError [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:[]) (Peek PandocError FilePath -> Peek PandocError [FilePath])
-> (StackIndex -> Peek PandocError FilePath)
-> Peeker PandocError [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackIndex -> Peek PandocError FilePath
forall e. Peeker e FilePath
peekString, (StackIndex -> Peek PandocError FilePath)
-> Peeker PandocError [FilePath]
forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList StackIndex -> Peek PandocError FilePath
forall e. Peeker e FilePath
peekString])
TypeSpec
"string|{string,...}" Text
"path" Text
"file path, or list of paths"
HsFnPrecursor PandocError (LuaE PandocError (Maybe FlavoredFormat))
-> FunctionResults PandocError (Maybe FlavoredFormat)
-> DocumentedFunction PandocError
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Pusher PandocError (Maybe FlavoredFormat)
-> TypeSpec
-> Text
-> FunctionResults PandocError (Maybe FlavoredFormat)
forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult (LuaE PandocError ()
-> (FlavoredFormat -> LuaE PandocError ())
-> Pusher PandocError (Maybe FlavoredFormat)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe LuaE PandocError ()
forall e. LuaE e ()
pushnil (Pusher PandocError Text
forall e. Pusher e Text
pushText Pusher PandocError Text
-> (FlavoredFormat -> Text)
-> FlavoredFormat
-> LuaE PandocError ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FlavoredFormat -> Text
formatName))
TypeSpec
"string|nil"
Text
"format determined by heuristic"
DocumentedFunction PandocError
-> Version -> DocumentedFunction PandocError
forall e. DocumentedFunction e -> Version -> DocumentedFunction e
`since` [Int] -> Version
makeVersion [Int
3,Int
1,Int
2]
]