{-|
Module : HsLua.Module.System
Copyright : © 2019-2024 Albert Krewinkel
License : MIT
Maintainer : Albert Krewinkel <tarleb@hslua.org>
Stability : alpha
Portability : Requires GHC 8 or later.
Provide a Lua module containing a selection of @'System'@ functions.
-}
module HsLua.Module.System (
-- * Module
documentedModule
-- ** Fields
, arch
, compiler_name
, compiler_version
, os
-- ** Functions
, cputime
, env
, getenv
, getwd
, ls
, mkdir
, rmdir
, setenv
, setwd
, tmpdirname
, with_env
, with_tmpdir
, with_wd
)
where
import Control.Monad (forM_)
import Control.Monad.Catch (bracket)
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import Data.Version (versionBranch)
import HsLua.Core
import HsLua.Marshalling
import HsLua.Packaging
import HsLua.Module.SystemUtils
import qualified Data.Text as T
import qualified System.CPUTime as CPUTime
import qualified System.Directory as Directory
import qualified System.Environment as Env
import qualified System.Info as Info
import qualified System.IO.Temp as Temp
-- | The "system" module.
documentedModule :: LuaError e => Module e
documentedModule = Module
{ moduleName = "system"
, moduleFields =
[ arch
, compiler_name
, compiler_version
, cputime_precision
, os
]
, moduleFunctions =
[ cputime
, env
, getenv
, getwd
, ls
, mkdir
, rmdir
, setenv
, setwd
, tmpdirname
, with_env
, with_tmpdir
, with_wd
]
, moduleOperations = []
, moduleTypeInitializers = []
, moduleDescription =
"Access to the system's information and file functionality."
}
--
-- Fields
--
-- | Module field containing the machine architecture on which the
-- program is running. Wraps @'Info.arch'@
arch :: Field e
arch = Field
{ fieldName = "arch"
, fieldType = "string"
, fieldDescription =
"The machine architecture on which the program is running."
, fieldPushValue = pushString Info.arch
}
-- | Module field containing the Haskell implementation with which the
-- host program was compiled. Wraps @'Info.compilerName'@.
compiler_name :: Field e
compiler_name = Field
{ fieldName = "compiler_name"
, fieldType = "string"
, fieldDescription = "The Haskell implementation with which the host "
`T.append` "program was compiled."
, fieldPushValue = pushString Info.compilerName
}
-- | Module field containing the version of `compiler_name` with which
-- the host program was compiled.
compiler_version :: LuaError e => Field e
compiler_version = Field
{ fieldName = "compiler_version"
, fieldType = "string"
, fieldDescription = T.unwords
[ "The Haskell implementation with which the host "
, "program was compiled." ]
, fieldPushValue = pushList pushIntegral $
versionBranch Info.compilerVersion
}
-- | Field containing the smallest measurable difference in CPU time.
cputime_precision :: Field e
cputime_precision = Field
{ fieldName = "cputime_precision"
, fieldType = "integer"
, fieldDescription = T.unlines
[ "The smallest measurable difference in CPU time that the"
, "implementation can record, and is given as an integral number of"
, "picoseconds."
]
, fieldPushValue = pushIntegral CPUTime.cpuTimePrecision
}
-- | Field containing the operating system on which the program is
-- running.
os :: Field e
os = Field
{ fieldName = "os"
, fieldType = "string"
, fieldDescription = "The operating system on which the program is running."
, fieldPushValue = pushString Info.os
}
--
-- Functions
--
-- | Access the CPU time, e.g. for benchmarking.
cputime :: LuaError e => DocumentedFunction e
cputime = defun "cputime"
### ioToLua CPUTime.getCPUTime
=#> functionResult pushIntegral "integer" "CPU time in picoseconds"
#? T.unlines
[ "Returns the number of picoseconds CPU time used by the current"
, "program. The precision of this result may vary in different"
, "versions and on different platforms."
]
-- | Retrieve the entire environment
env :: LuaError e => DocumentedFunction e
env = defun "env"
### ioToLua Env.getEnvironment
=#> functionResult (pushKeyValuePairs pushString pushString) "table"
"A table mapping environment variable names to their value."
#? "Retrieves the entire environment as a string-indexed table."
-- | Return the current working directory as an absolute path.
getwd :: LuaError e => DocumentedFunction e
getwd = defun "getwd"
### ioToLua Directory.getCurrentDirectory
=#> filepathResult "The current working directory."
#? "Obtain the current working directory as an absolute path."
-- | Returns the value of an environment variable
getenv :: LuaError e => DocumentedFunction e
getenv = defun "getenv"
### ioToLua . Env.lookupEnv
<#> parameter peekString "string" "var" "name of the environment"
=#> functionResult (maybe pushnil pushString) "string or nil"
"value of the variable, or nil if the variable is not defined."
#? T.unwords
[ "Return the value of the environment variable `var`, or `nil` "
, "if there is no such value." ]
-- | List the contents of a directory.
ls :: LuaError e => DocumentedFunction e
ls = defun "ls"
### ioToLua . Directory.listDirectory . fromMaybe "."
<#> opt (stringParam "directory"
("Path of the directory whose contents should be listed. "
`T.append` "Defaults to `.`."))
=#> functionResult (pushList pushString) "table"
("A table of all entries in `directory`, except for the "
`T.append` "special entries (`.` and `..`).")
#? "List the contents of a directory."
-- | Create a new directory which is initially empty, or as near to
-- empty as the operating system allows.
--
-- If the optional second parameter is `false`, then create the new
-- directory only if it doesn't exist yet. If the parameter is `true`,
-- then parent directories are created as necessary.
mkdir :: LuaError e => DocumentedFunction e
mkdir = defun "mkdir"
### (\fp createParent ->
if createParent == Just True
then ioToLua (Directory.createDirectoryIfMissing True fp)
else ioToLua (Directory.createDirectory fp))
<#> filepathParam "dirname" "name of the new directory"
<#> opt (boolParam "create_parent" "create parent directory if necessary")
=#> []
#? T.concat
[ "Create a new directory which is initially empty, or as near "
, "to empty as the operating system allows. The function throws "
, "an error if the directory cannot be created, e.g., if the "
, "parent directory does not exist or if a directory of the "
, "same name is already present.\n"
, "\n"
, "If the optional second parameter is provided and truthy, "
, "then all directories, including parent directories, are "
, "created as necessary.\n"
]
-- | Remove an existing directory.
rmdir :: LuaError e => DocumentedFunction e
rmdir = defun "rmdir"
### (\fp recursive ->
if recursive == Just True
then ioToLua (Directory.removeDirectoryRecursive fp)
else ioToLua (Directory.removeDirectory fp))
<#> filepathParam "dirname" "name of the directory to delete"
<#> opt (boolParam "recursive" "delete content recursively")
=#> []
#?("Remove an existing, empty directory. If `recursive` is given, "
`T.append` "then delete the directory and its contents recursively.")
-- | Set the specified environment variable to a new value.
setenv :: LuaError e => DocumentedFunction e
setenv = defun "setenv"
### (\name value -> ioToLua (Env.setEnv name value))
<#> parameter peekString "string" "name"
"name of the environment variable"
<#> parameter peekString "string" "value" "new value"
=#> []
#? "Set the specified environment variable to a new value."
-- | Change current working directory.
setwd :: LuaError e => DocumentedFunction e
setwd = defun "setwd"
### ioToLua . Directory.setCurrentDirectory
<#> filepathParam "directory" "Path of the new working directory"
=#> []
#? "Change the working directory to the given path."
-- | Get the current directory for temporary files.
tmpdirname :: LuaError e => DocumentedFunction e
tmpdirname = defun "tmpdirname"
### ioToLua Directory.getTemporaryDirectory
=#> functionResult pushString "string"
"The current directory for temporary files."
#? mconcat
[ "Returns the current directory for temporary files.\n"
, "\n"
, "On Unix, `tmpdirname()` returns the value of the `TMPDIR` "
, "environment variable or \"/tmp\" if the variable isn't defined. "
, "On Windows, the function checks for the existence of environment "
, "variables in the following order and uses the first path found:\n"
, "\n"
, "- TMP environment variable.\n"
, "- TEMP environment variable.\n"
, "- USERPROFILE environment variable.\n"
, "- The Windows directory\n"
, "\n"
, "The operation may fail if the operating system has no notion of "
, "temporary directory.\n"
, "\n"
, "The function doesn't verify whether the path exists.\n"
]
-- | Run an action in a different directory, then restore the old
-- working directory.
with_wd :: LuaError e => DocumentedFunction e
with_wd = defun "with_wd"
### (\fp callback ->
bracket (ioToLua Directory.getCurrentDirectory)
(ioToLua . Directory.setCurrentDirectory)
(\_ -> do
ioToLua (Directory.setCurrentDirectory fp)
callback `invokeWithFilePath` fp))
<#> filepathParam "directory"
"Directory in which the given `callback` should be executed"
<#> parameter peekCallback "function" "callback"
"Action to execute in the given directory"
=?> "The results of the call to `callback`."
#? T.unwords
[ "Run an action within a different directory. This function will"
, "change the working directory to `directory`, execute `callback`,"
, "then switch back to the original working directory, even if an"
, "error occurs while running the callback action."
]
-- | Run an action, then restore the old environment variable values.
with_env :: LuaError e => DocumentedFunction e
with_env = defun "with_env"
### (\environment callback ->
bracket (ioToLua Env.getEnvironment)
setEnvironment
(\_ -> setEnvironment environment *> invoke callback))
<#> parameter (peekKeyValuePairs peekString peekString) "table"
"environment"
("Environment variables and their values to be set before "
`T.append` "running `callback`")
<#> parameter peekCallback "function" "callback"
"Action to execute in the custom environment"
=?> "The results of the call to `callback`."
#? T.unwords
[ "Run an action within a custom environment. Only the environment"
, "variables given by `environment` will be set, when `callback` is"
, "called. The original environment is restored after this function"
, "finishes, even if an error occurs while running the callback"
, "action."
]
where
setEnvironment newEnv = ioToLua $ do
-- Crude, but fast enough: delete all entries in new environment,
-- then restore old environment one-by-one.
curEnv <- Env.getEnvironment
forM_ curEnv (Env.unsetEnv . fst)
forM_ newEnv (uncurry Env.setEnv)
with_tmpdir :: LuaError e => DocumentedFunction e
with_tmpdir = defun "with_tmpdir"
### (\mParentDir tmpl callback -> case mParentDir of
Nothing -> do
Temp.withSystemTempDirectory tmpl $
invokeWithFilePath callback
Just parentDir -> do
Temp.withTempDirectory parentDir tmpl $
invokeWithFilePath callback)
<#> parameter peekParentDir "string" "parent_dir"
(mconcat
[ "Parent directory to create the directory in. If this "
, "parameter is omitted, the system's canonical temporary "
, "directory is used."
])
<#> stringParam "templ" "Directory name template."
<#> parameter peekCallback "function" "callback"
("Function which takes the name of the temporary directory as "
`T.append` "its first argument.")
=?> "The results of the call to `callback`."
#? T.unlines
[ "Create and use a temporary directory inside the given directory."
, "The directory is deleted after the callback returns."
]
where
peekParentDir idx = do
args <- liftLua gettop
if args < 3
then liftLua $ do
pushnil
insert idx
return Nothing
else Just <$> peekString idx
--
-- Parameters
--
-- | Filepath function parameter.
filepathParam :: Text -- ^ name
-> Text -- ^ description
-> Parameter e FilePath
filepathParam = stringParam
-- | Result of a function returning a file path.
filepathResult :: Text -- ^ Description
-> [FunctionResult e FilePath]
filepathResult = functionResult pushString "string"