module HsLua.Module.System (
documentedModule
, arch
, compiler_name
, compiler_version
, os
, 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 HsLua.Core as Lua
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
documentedModule :: LuaError e => Module e
documentedModule :: forall e. LuaError e => Module e
documentedModule = Module
{ moduleName :: Name
moduleName = Name
"system"
, moduleFields :: [Field e]
moduleFields =
[ forall e. Field e
arch
, forall e. Field e
compiler_name
, forall e. LuaError e => Field e
compiler_version
, forall e. Field e
cputime_precision
, forall e. Field e
os
]
, moduleFunctions :: [DocumentedFunction e]
moduleFunctions =
[ forall e. LuaError e => DocumentedFunction e
cputime
, forall e. LuaError e => DocumentedFunction e
env
, forall e. LuaError e => DocumentedFunction e
getenv
, forall e. LuaError e => DocumentedFunction e
getwd
, forall e. LuaError e => DocumentedFunction e
ls
, forall e. LuaError e => DocumentedFunction e
mkdir
, forall e. LuaError e => DocumentedFunction e
rmdir
, forall e. LuaError e => DocumentedFunction e
setenv
, forall e. LuaError e => DocumentedFunction e
setwd
, forall e. LuaError e => DocumentedFunction e
tmpdirname
, forall e. LuaError e => DocumentedFunction e
with_env
, forall e. LuaError e => DocumentedFunction e
with_tmpdir
, forall e. LuaError e => DocumentedFunction e
with_wd
]
, moduleOperations :: [(Operation, DocumentedFunction e)]
moduleOperations = []
, moduleTypeInitializers :: [LuaE e Name]
moduleTypeInitializers = []
, moduleDescription :: Text
moduleDescription =
Text
"Access to the system's information and file functionality."
}
arch :: Field e
arch :: forall e. Field e
arch = Field
{ fieldName :: Text
fieldName = Text
"arch"
, fieldType :: TypeSpec
fieldType = TypeSpec
"string"
, fieldDescription :: Text
fieldDescription =
Text
"The machine architecture on which the program is running."
, fieldPushValue :: LuaE e ()
fieldPushValue = forall e. String -> LuaE e ()
pushString String
Info.arch
}
compiler_name :: Field e
compiler_name :: forall e. Field e
compiler_name = Field
{ fieldName :: Text
fieldName = Text
"compiler_name"
, fieldType :: TypeSpec
fieldType = TypeSpec
"string"
, fieldDescription :: Text
fieldDescription = Text
"The Haskell implementation with which the host "
Text -> Text -> Text
`T.append` Text
"program was compiled."
, fieldPushValue :: LuaE e ()
fieldPushValue = forall e. String -> LuaE e ()
pushString String
Info.compilerName
}
compiler_version :: LuaError e => Field e
compiler_version :: forall e. LuaError e => Field e
compiler_version = Field
{ fieldName :: Text
fieldName = Text
"compiler_version"
, fieldType :: TypeSpec
fieldType = TypeSpec
"string"
, fieldDescription :: Text
fieldDescription = [Text] -> Text
T.unwords
[ Text
"The Haskell implementation with which the host "
, Text
"program was compiled." ]
, fieldPushValue :: LuaE e ()
fieldPushValue = forall e a. LuaError e => Pusher e a -> [a] -> LuaE e ()
pushList forall a e. (Integral a, Show a) => a -> LuaE e ()
pushIntegral forall a b. (a -> b) -> a -> b
$
Version -> [Int]
versionBranch Version
Info.compilerVersion
}
cputime_precision :: Field e
cputime_precision :: forall e. Field e
cputime_precision = Field
{ fieldName :: Text
fieldName = Text
"cputime_precision"
, fieldType :: TypeSpec
fieldType = TypeSpec
"integer"
, fieldDescription :: Text
fieldDescription = [Text] -> Text
T.unlines
[ Text
"The smallest measurable difference in CPU time that the"
, Text
"implementation can record, and is given as an integral number of"
, Text
"picoseconds."
]
, fieldPushValue :: LuaE e ()
fieldPushValue = forall a e. (Integral a, Show a) => a -> LuaE e ()
pushIntegral Integer
CPUTime.cpuTimePrecision
}
os :: Field e
os :: forall e. Field e
os = Field
{ fieldName :: Text
fieldName = Text
"os"
, fieldType :: TypeSpec
fieldType = TypeSpec
"string"
, fieldDescription :: Text
fieldDescription = Text
"The operating system on which the program is running."
, fieldPushValue :: LuaE e ()
fieldPushValue = forall e. String -> LuaE e ()
pushString String
Info.os
}
cputime :: LuaError e => DocumentedFunction e
cputime :: forall e. LuaError e => DocumentedFunction e
cputime = forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"cputime"
### ioToLua CPUTime.getCPUTime
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult forall a e. (Integral a, Show a) => a -> LuaE e ()
pushIntegral TypeSpec
"integer" Text
"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."
]
env :: LuaError e => DocumentedFunction e
env :: forall e. LuaError e => DocumentedFunction e
env = forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"env"
### ioToLua Env.getEnvironment
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult (forall e a b.
LuaError e =>
Pusher e a -> Pusher e b -> Pusher e [(a, b)]
pushKeyValuePairs forall e. String -> LuaE e ()
pushString forall e. String -> LuaE e ()
pushString) TypeSpec
"table"
Text
"A table mapping environment variable names to their value."
#? "Retrieves the entire environment as a string-indexed table."
getwd :: LuaError e => DocumentedFunction e
getwd :: forall e. LuaError e => DocumentedFunction e
getwd = forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"getwd"
### ioToLua Directory.getCurrentDirectory
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> forall e. Text -> [FunctionResult e String]
filepathResult Text
"The current working directory."
#? "Obtain the current working directory as an absolute path."
getenv :: LuaError e => DocumentedFunction e
getenv :: forall e. LuaError e => DocumentedFunction e
getenv = forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"getenv"
### ioToLua . Env.lookupEnv
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter forall e. Peeker e String
peekString TypeSpec
"string" Text
"var" Text
"name of the environment"
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult (forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall e. LuaE e ()
pushnil forall e. String -> LuaE e ()
pushString) TypeSpec
"string or nil"
Text
"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." ]
ls :: LuaError e => DocumentedFunction e
ls :: forall e. LuaError e => DocumentedFunction e
ls = forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"ls"
### ioToLua . Directory.listDirectory . fromMaybe "."
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Parameter e a -> Parameter e (Maybe a)
opt (forall e. Text -> Text -> Parameter e String
stringParam Text
"directory"
(Text
"Path of the directory whose contents should be listed. "
Text -> Text -> Text
`T.append` Text
"Defaults to `.`."))
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult (forall e a. LuaError e => Pusher e a -> [a] -> LuaE e ()
pushList forall e. String -> LuaE e ()
pushString) TypeSpec
"table"
(Text
"A table of all entries in `directory`, except for the "
Text -> Text -> Text
`T.append` Text
"special entries (`.` and `..`).")
#? "List the contents of a directory."
mkdir :: LuaError e => DocumentedFunction e
mkdir :: forall e. LuaError e => DocumentedFunction e
mkdir = forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"mkdir"
### (\fp createParent ->
if createParent == Just True
then ioToLua (Directory.createDirectoryIfMissing True fp)
else ioToLua (Directory.createDirectory fp))
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e. Text -> Text -> Parameter e String
filepathParam Text
"dirname" Text
"name of the new directory"
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Parameter e a -> Parameter e (Maybe a)
opt (forall e. Text -> Text -> Parameter e Bool
boolParam Text
"create_parent" Text
"create parent directory if necessary")
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> []
#? 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"
]
rmdir :: LuaError e => DocumentedFunction e
rmdir :: forall e. LuaError e => DocumentedFunction e
rmdir = forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"rmdir"
### (\fp recursive ->
if recursive == Just True
then ioToLua (Directory.removeDirectoryRecursive fp)
else ioToLua (Directory.removeDirectory fp))
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e. Text -> Text -> Parameter e String
filepathParam Text
"dirname" Text
"name of the directory to delete"
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Parameter e a -> Parameter e (Maybe a)
opt (forall e. Text -> Text -> Parameter e Bool
boolParam Text
"recursive" Text
"delete content recursively")
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> []
#?("Remove an existing, empty directory. If `recursive` is given, "
`T.append` "then delete the directory and its contents recursively.")
setenv :: LuaError e => DocumentedFunction e
setenv :: forall e. LuaError e => DocumentedFunction e
setenv = forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"setenv"
### (\name value -> ioToLua (Env.setEnv name value))
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter forall e. Peeker e String
peekString TypeSpec
"string" Text
"name"
Text
"name of the environment variable"
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter forall e. Peeker e String
peekString TypeSpec
"string" Text
"value" Text
"new value"
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> []
#? "Set the specified environment variable to a new value."
setwd :: LuaError e => DocumentedFunction e
setwd :: forall e. LuaError e => DocumentedFunction e
setwd = forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"setwd"
### ioToLua . Directory.setCurrentDirectory
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e. Text -> Text -> Parameter e String
filepathParam Text
"directory" Text
"Path of the new working directory"
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> []
#? "Change the working directory to the given path."
tmpdirname :: LuaError e => DocumentedFunction e
tmpdirname :: forall e. LuaError e => DocumentedFunction e
tmpdirname = forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"tmpdirname"
### ioToLua Directory.getTemporaryDirectory
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult forall e. String -> LuaE e ()
pushString TypeSpec
"string"
Text
"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"
]
with_wd :: LuaError e => DocumentedFunction e
with_wd :: forall e. LuaError e => DocumentedFunction e
with_wd = forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"with_wd"
### (\fp callback ->
bracket (Lua.liftIO Directory.getCurrentDirectory)
(Lua.liftIO . Directory.setCurrentDirectory)
(\_ -> do
Lua.liftIO (Directory.setCurrentDirectory fp)
callback `invokeWithFilePath` fp))
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e. Text -> Text -> Parameter e String
filepathParam Text
"directory"
Text
"Directory in which the given `callback` should be executed"
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter forall e. Peeker e Callback
peekCallback TypeSpec
"function" Text
"callback"
Text
"Action to execute in the given directory"
forall e.
HsFnPrecursor e (LuaE e NumResults) -> Text -> DocumentedFunction e
=?> Text
"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."
]
with_env :: LuaError e => DocumentedFunction e
with_env :: forall e. LuaError e => DocumentedFunction e
with_env = forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"with_env"
### (\environment callback ->
bracket (Lua.liftIO Env.getEnvironment)
setEnvironment
(\_ -> setEnvironment environment *> invoke callback))
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter (forall e a b.
LuaError e =>
Peeker e a -> Peeker e b -> Peeker e [(a, b)]
peekKeyValuePairs forall e. Peeker e String
peekString forall e. Peeker e String
peekString) TypeSpec
"table"
Text
"environment"
(Text
"Environment variables and their values to be set before "
Text -> Text -> Text
`T.append` Text
"running `callback`")
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter forall e. Peeker e Callback
peekCallback TypeSpec
"function" Text
"callback"
Text
"Action to execute in the custom environment"
forall e.
HsFnPrecursor e (LuaE e NumResults) -> Text -> DocumentedFunction e
=?> Text
"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 :: t (String, String) -> m ()
setEnvironment t (String, String)
newEnv = forall (m :: * -> *) a. MonadIO m => IO a -> m a
Lua.liftIO forall a b. (a -> b) -> a -> b
$ do
[(String, String)]
curEnv <- IO [(String, String)]
Env.getEnvironment
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(String, String)]
curEnv (String -> IO ()
Env.unsetEnv forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ t (String, String)
newEnv (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry String -> String -> IO ()
Env.setEnv)
with_tmpdir :: LuaError e => DocumentedFunction e
with_tmpdir :: forall e. LuaError e => DocumentedFunction e
with_tmpdir = forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"with_tmpdir"
### (\mParentDir tmpl callback -> case mParentDir of
Nothing -> do
Temp.withSystemTempDirectory tmpl $
invokeWithFilePath callback
Just parentDir -> do
Temp.withTempDirectory parentDir tmpl $
invokeWithFilePath callback)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter forall {e}. StackIndex -> Peek e (Maybe String)
peekParentDir TypeSpec
"string" Text
"parent_dir"
(forall a. Monoid a => [a] -> a
mconcat
[ Text
"Parent directory to create the directory in. If this "
, Text
"parameter is omitted, the system's canonical temporary "
, Text
"directory is used."
])
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e. Text -> Text -> Parameter e String
stringParam Text
"templ" Text
"Directory name template."
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter forall e. Peeker e Callback
peekCallback TypeSpec
"function" Text
"callback"
(Text
"Function which takes the name of the temporary directory as "
Text -> Text -> Text
`T.append` Text
"its first argument.")
forall e.
HsFnPrecursor e (LuaE e NumResults) -> Text -> DocumentedFunction e
=?> Text
"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 :: StackIndex -> Peek e (Maybe String)
peekParentDir StackIndex
idx = do
StackIndex
args <- forall e a. LuaE e a -> Peek e a
liftLua forall e. LuaE e StackIndex
gettop
if StackIndex
args forall a. Ord a => a -> a -> Bool
< StackIndex
3
then forall e a. LuaE e a -> Peek e a
liftLua forall a b. (a -> b) -> a -> b
$ do
forall e. LuaE e ()
pushnil
forall e. StackIndex -> LuaE e ()
insert StackIndex
idx
forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
else forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e. Peeker e String
peekString StackIndex
idx
filepathParam :: Text
-> Text
-> Parameter e FilePath
filepathParam :: forall e. Text -> Text -> Parameter e String
filepathParam = forall e. Text -> Text -> Parameter e String
stringParam
filepathResult :: Text
-> [FunctionResult e FilePath]
filepathResult :: forall e. Text -> [FunctionResult e String]
filepathResult = forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult forall e. String -> LuaE e ()
pushString TypeSpec
"string"