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

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

Pandoc's system Lua module.
-}
module Text.Pandoc.Lua.Module.System
  ( pushModule
  ) where

import HsLua hiding (pushModule)
import HsLua.Module.System
  (arch, env, getwd, os, with_env, with_tmpdir, with_wd)
import Text.Pandoc.Error (PandocError)
import Text.Pandoc.Lua.ErrorConversion ()

import qualified HsLua as Lua

-- | Push the pandoc.system module on the Lua stack.
pushModule :: LuaE PandocError NumResults
pushModule :: LuaE PandocError NumResults
pushModule = do
  Module PandocError -> LuaE PandocError ()
forall e. LuaError e => Module e -> LuaE e ()
Lua.pushModule (Module PandocError -> LuaE PandocError ())
-> Module PandocError -> LuaE PandocError ()
forall a b. (a -> b) -> a -> b
$ Module :: forall e.
Name
-> Text
-> [Field e]
-> [DocumentedFunction e]
-> [(Operation, DocumentedFunction e)]
-> Module e
Module
    { moduleName :: Name
moduleName = Name
"system"
    , moduleDescription :: Text
moduleDescription = Text
"system functions"
    , moduleFields :: [Field PandocError]
moduleFields =
        [ Field PandocError
forall e. Field e
arch
        , Field PandocError
forall e. Field e
os
        ]
    , moduleFunctions :: [DocumentedFunction PandocError]
moduleFunctions =
        [ Name
-> DocumentedFunction PandocError -> DocumentedFunction PandocError
forall e. Name -> DocumentedFunction e -> DocumentedFunction e
setName Name
"environment" DocumentedFunction PandocError
forall e. LuaError e => DocumentedFunction e
env
        , Name
-> DocumentedFunction PandocError -> DocumentedFunction PandocError
forall e. Name -> DocumentedFunction e -> DocumentedFunction e
setName Name
"get_working_directory" DocumentedFunction PandocError
forall e. LuaError e => DocumentedFunction e
getwd
        , Name
-> DocumentedFunction PandocError -> DocumentedFunction PandocError
forall e. Name -> DocumentedFunction e -> DocumentedFunction e
setName Name
"with_environment" DocumentedFunction PandocError
forall e. LuaError e => DocumentedFunction e
with_env
        , Name
-> DocumentedFunction PandocError -> DocumentedFunction PandocError
forall e. Name -> DocumentedFunction e -> DocumentedFunction e
setName Name
"with_temporary_directory" DocumentedFunction PandocError
forall e. LuaError e => DocumentedFunction e
with_tmpdir
        , Name
-> DocumentedFunction PandocError -> DocumentedFunction PandocError
forall e. Name -> DocumentedFunction e -> DocumentedFunction e
setName Name
"with_working_directory" DocumentedFunction PandocError
forall e. LuaError e => DocumentedFunction e
with_wd
        ]
    , moduleOperations :: [(Operation, DocumentedFunction PandocError)]
moduleOperations = []
    }
  NumResults -> LuaE PandocError NumResults
forall (m :: * -> *) a. Monad m => a -> m a
return NumResults
1