hslua-module-system-1.3.0/0000755000000000000000000000000007346545000013625 5ustar0000000000000000hslua-module-system-1.3.0/CHANGELOG.md0000644000000000000000000001053507346545000015442 0ustar0000000000000000# Changelog `hslua-module-system` uses [PVP Versioning][]. ## hslua-module-system-1.3.0 Released 2026-01-08. - Require hslua-packaging 2.4 or later. ## hslua-module-system-1.2.3 Release 2025-08-09. - Allowed time-1.15. ## hslua-module-system-1.2.2 Released 2025-08-09. - Fix compilation error. ## hslua-module-system-1.2.2 Released 2025-08-09. - Lists of file paths now have a "FilePath list" metatable that add list methods. ## hslua-module-system-1.2.1.1 Released 2025-07-23. - Fixed the docstring of `exists`. ## hslua-module-system-1.2.1 Released 2025-07-23. - Add new function `exists`, which allows to check the existance and, optionally, type of a filesystem object at the given path. ## hslua-module-system-1.2.0 Released 2025-06-23. - Added new functions `read_file` and `write_file`: These are convenience functions that makes it easier to work with UTF-8 encoded filenames. The functions in the Lua standard library expect filenames encoded in the system's codepage, often leading to subtle bugs. - Added new functions `cp`, `rename`, and `rm`, which can be used similar to the functions in the `os` standard library, but expect paths to be given as UTF-8 instead of a file system specific encoding. - Added new function `times`: the function allows to obtain the modification time and access time of a file or directory. - Added new function `xdg`: this function gives easy access to XDG directories and search paths. - Fixed module export list: the function `cmd` was only added to the Lua module, but not exported from the Haskell module. Instead, `HsLua.Core.run` was erroneously reexported. ## hslua-module-system-1.1.3 Released 2025-05-21. - Improved docs for the `os` field. - Added new function `cmd` that runs system commands. - Moved `CHANGELOG.md` to the `extra-doc-files` field in the cabal file and also added `README.md` to that field. ## hslua-module-system-1.1.2 Released 2024-05-28. - Fixed error handling in `with_wd`: exceptions when changing directories are now properly converted to Lua errors. ## hslua-module-system-1.1.1 Released 2024-01-18. - Relaxed upper bound for text, allowing text-2.1. ## hslua-module-system-1.1.0.1 Released 2023-03-26. - Improve doc strings. ## hslua-module-system-1.1.0 - Update to hslua-2.3; this includes the addition of type initializers to the module and type specifiers to the fields. ## hslua-module-system-1.0.3 Released 2023-02-14. - Added new function `cputime` and field `cputime_precision`, e.g. for benchmarking. ## hslua-module-system-1.0.2 Released 2022-02-19. - Adjusted package bounds, for hslua-core and hslua-packaging. ## hslua-module-system-1.0.1 Released 2022-01-29. - Relaxed upper bound of hslua-core, hslua-marshalling, and hslua-packaging, allowing their respective version 2.1. ## hslua-module-system-1.0.0 Released 2021-10-21. - Use hslua 2.0. ## hslua-module-system-0.2.2.1 Released 2020-10-16. - Relaxed upper bound for hslua, allow `hslua-1.3.*`. ## hslua-module-system-0.2.2 Released 2020-08-15. - Relaxed upper bound for hslua, allow `hslua-1.2.*`. - Improved documentation of internal types. - Use tasty-lua for unit tests. - Update CI to test with all GHC versions. ## hslua-module-system-0.2.1 Released 2019-05-04. - Use module helpers made available with HsLua 1.0.3. This avoids code duplication when used with other hslua modules. ## hslua-module-system-0.2.0 Released 2019-05-01. All fields and functions are now exported from the Haskell module under the same name as that used in Lua. ### New fields - `arch`: processor architecture. - `compiler_name`: Haskell compiler that was used to compile the module. - `compiler_version`: version of the compiler. - `os`: operating system. ### New functions - `mkdir`: create a new directory. - `rmdir`: remove a directory. - `with_env`: perform action with custom environment. - `with_wd`: perform action in another directory. ### Removed or renamed functions - `currentdir` was renamed to `getwd`. - `chdir` was renamed to `setwd`. - `pwd` was removed. ### Misc - Fix typos and copy-paste errors in docs, tests. ## hslua-module-system-0.1.0 Released 2019-04-26. - First version. Released on an unsuspecting world. [PVP Versioning]: https://pvp.haskell.org hslua-module-system-1.3.0/LICENSE0000644000000000000000000000205107346545000014630 0ustar0000000000000000Copyright (c) 2019-2026 Albert Krewinkel Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. hslua-module-system-1.3.0/README.md0000644000000000000000000001424007346545000015105 0ustar0000000000000000HsLua Module: System ==================== This module provides access to system information and functionality via Haskell's `System` module. Intended usage for this package is to preload it by adding the loader function to `package.preload`. Note that the Lua `package` library must have already been loaded before the loader can be added. Example ------- ``` haskell loadProg :: Lua Status loadProg = do openlibs preloadModule documentedModule -- create a temporary directory, print it's path, then delete it again. dostring $ "system = require 'system'\n" <> "system.with_tmpdir('.', 'foo', print)" ``` Documentation ------------- ### Fields #### arch The machine architecture on which the program is running. #### compiler_name The Haskell implementation with which the host program was compiled. #### compiler_version The version of `compiler_name` with which the host program was compiled. #### cputime_precision The smallest measurable difference in CPU time that the implementation can record, and is given as an integral number of picoseconds. #### os The operating system on which the program is running. ### General Functions #### cmd `cmd (command, args[, input[, opts]])` Executes a system command with the given arguments and `input` on *stdin*. Parameters: `command` : command to execute (string) `args` : command arguments ({string,...}) `input` : input on stdin (string) `opts` : process options (table) Returns: - exit code – `false` on success, an integer otherwise (integer|boolean) - stdout (string) - stderr (string) #### cputime `cputime ()` 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. See also the field `cputime_precision`. #### env `env ()` Retrieve the entire environment. Returns: - A table mapping environment variables names to their string value (table). #### getenv `getenv (var)` Return the value of the environment variable `var`, or `nil` if there is no such value. Parameters: `var` : name of the environment variable (string) Returns: - value of the variable, or nil if the variable is not defined (string or nil). #### getwd `getwd ()` Obtain the current working directory as an absolute path. Returns: - The current working directory (string). #### ls `ls ([directory])` List the contents of a directory. Parameters: `directory` : Path of the directory whose contents should be listed (string). Defaults to `.`. Returns: - A table of all entries in `directory` without the special entries (`.` and `..`). #### mkdir `mkdir (dirname [, create_parent])` 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. If the optional second parameter is provided and truthy, then all directories, including parent directories, are created as necessary. Parameters: `dirname` : name of the new directory `create_parent` : create parent directories if necessary #### rmdir `rmdir (dirname [, recursive])` Remove an existing, empty directory. If `recursive` is given, then delete the directory and its contents recursively. Parameters: `dirname` : name of the directory to delete `recursive` : delete content recursively #### setenv `setenv (var, value)` Set the specified environment variable to a new value. Parameters: `var` : name of the environment variable (string). `value` : new value (string). #### setwd `setwd (directory)` Change the working directory to the given path. Parameters: `directory` : Path of the directory which is to become the new working directory (string) #### tmpdirname `tmpdirname ()` Returns the current directory for temporary files. 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: - TMP environment variable. - TEMP environment variable. - USERPROFILE environment variable. - The Windows directory The operation may fail if the operating system has no notion of temporary directory. The function doesn't verify whether the path exists. Returns: - The current directory for temporary files (string). #### with\_env `with_env (environment, callback)` 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. Parameters: `environment` : Environment variables and their values to be set before running `callback`. (table with string keys and string values) `callback` : Action to execute in the custom environment (function) Returns: - The result(s) of the call to `callback` #### with\_tmpdir `with_tmpdir ([parent_dir,] templ, callback)` Create and use a temporary directory inside the given directory. The directory is deleted after use. Parameters: `parent_dir` : Parent directory to create the directory in (string). If this parameter is omitted, the system's canonical temporary directory is used. `templ` : Directory name template (string). `callback` : Function which takes the name of the temporary directory as its first argument (function). Returns: - The result of the call to `callback`. #### with\_wd `with_wd (directory, callback)` 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. Parameters: `directory` : Directory in which the given `callback` should be executed (string) `callback` : Action to execute in the given directory (function) Returns: - The result(s) of the call to `callback` License ------- This package is licensed under the MIT license. See [`LICENSE`](LICENSE) for details. hslua-module-system-1.3.0/hslua-module-system.cabal0000644000000000000000000000623607346545000020541 0ustar0000000000000000cabal-version: 2.2 name: hslua-module-system version: 1.3.0 synopsis: Lua module wrapper around Haskell's System module. description: Provides access to system information and functionality to Lua scripts via Haskell's `System` module. . This package is part of HsLua, a Haskell framework built around the embeddable scripting language . homepage: https://github.com/hslua/hslua license: MIT license-file: LICENSE author: Albert Krewinkel maintainer: tarleb@hslua.org copyright: © 2019-2026 Albert Krewinkel category: Foreign extra-source-files: test/test-system.lua extra-doc-files: CHANGELOG.md , README.md tested-with: GHC == 9.6 , GHC == 9.8 , GHC == 9.10 , GHC == 9.12 source-repository head type: git location: https://github.com/hslua/hslua.git subdir: hslua-module-system common common-options default-language: Haskell2010 build-depends: base >= 4.11 && < 5 , hslua-core >= 2.1 && < 2.4 , hslua-packaging >= 2.4 && < 2.5 default-extensions: LambdaCase , OverloadedStrings ghc-options: -Wall -Wcpp-undef -Werror=missing-home-modules -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wnoncanonical-monad-instances -Wpartial-fields -Wredundant-constraints -fhide-source-paths if impl(ghc >= 8.10) ghc-options: -Wunused-packages if impl(ghc >= 9.0) ghc-options: -Winvalid-haddock library import: common-options build-depends: bytestring >= 0.10.2 && < 0.13 , directory >= 1.3.2 && < 1.4 , exceptions >= 0.8 && < 0.11 , hslua-list >= 1.1 && < 1.2 , hslua-marshalling >= 2.1 && < 2.4 , process >= 1.2.3 && < 1.7 , temporary >= 1.2 && < 1.4 , text >= 1.2 && < 2.2 , time >= 1.9 && < 1.16 exposed-modules: HsLua.Module.System other-modules: HsLua.Module.SystemUtils hs-source-dirs: src test-suite test-hslua-module-system import: common-options type: exitcode-stdio-1.0 main-is: test-hslua-module-system.hs hs-source-dirs: test build-depends: hslua-module-system , tasty >= 0.11 , tasty-hunit >= 0.9 , tasty-lua >= 1.0 && < 1.2 hslua-module-system-1.3.0/src/HsLua/Module/0000755000000000000000000000000007346545000016655 5ustar0000000000000000hslua-module-system-1.3.0/src/HsLua/Module/System.hs0000644000000000000000000005525307346545000020507 0ustar0000000000000000{-# LANGUAGE CPP #-} {-| Module : HsLua.Module.System Copyright : © 2019-2026 Albert Krewinkel License : MIT Maintainer : Albert Krewinkel 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 , cmd , cp , cputime , env , exists , getenv , getwd , ls , mkdir , read_file , rename , rm , rmdir , setenv , setwd , times , tmpdirname , with_env , with_tmpdir , with_wd , write_file , xdg ) 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.List (newListMetatable) import HsLua.Marshalling import HsLua.Packaging import HsLua.Module.SystemUtils import qualified Data.ByteString as B import qualified Data.Text as T import qualified Data.Time as Time import qualified Data.Time.Format.ISO8601 as ISO8601 import qualified HsLua.Core.Utf8 as Utf8 import qualified System.CPUTime as CPUTime import qualified System.Directory as Directory import qualified System.Environment as Env import qualified System.Exit as Exit import qualified System.Info as Info import qualified System.IO.Temp as Temp import qualified System.Process as Process -- | The "system" module. documentedModule :: LuaError e => Module e documentedModule = defmodule "system" `withFields` [ arch , compiler_name , compiler_version , cputime_precision , os ] `withFunctions` [ cmd , cp , cputime , env , exists , getenv , getwd , ls , mkdir , read_file , rename , rm , rmdir , setenv , setwd , times , tmpdirname , with_env , with_tmpdir , with_wd , write_file , xdg ] `withDescription` "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 = deffield "arch" `withType` stringType `withDescription` "The machine architecture on which the program is running." `withValue` 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 = deffield "compiler_name" `withType` stringType `withDescription` "The Haskell implementation with which the host program was compiled." `withValue` 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 = deffield "compiler_version" `withType` stringType `withDescription` "The Haskell implementation with which the host program was compiled." `withValue` pushList pushIntegral (versionBranch Info.compilerVersion) -- | Field containing the smallest measurable difference in CPU time. cputime_precision :: Field e cputime_precision = deffield "cputime_precision" `withType` integerType `withDescription` T.unlines [ "The smallest measurable difference in CPU time that the" , "implementation can record, and is given as an integral number of" , "picoseconds." ] `withValue` pushIntegral CPUTime.cpuTimePrecision -- | Field containing the operating system on which the program is -- running. os :: Field e os = deffield "os" `withType` "string" `withDescription` T.unlines [ "The operating system on which the program is running." , "The most common values are `darwin` (macOS), `freebsd`, `linux`," , "`linux-android`, `mingw32` (Windows), `netbsd`, `openbsd`." ] `withValue` pushString Info.os -- -- Functions -- -- | Run a system command cmd :: LuaError e => DocumentedFunction e cmd = defun "cmd" ### (\command args minput opts -> do let input = fromMaybe "" minput let cp_opts = (Process.proc command args) { Process.env = processOptsEnv =<< opts , Process.cwd = processOptsCwd =<< opts } liftIO $ Process.readCreateProcessWithExitCode cp_opts input) <#> filepathParam "command" "command to execute" <#> parameter (peekList peekString) "{string,...}" "args" "command arguments" <#> opt (parameter peekString "string" "input" "input on stdin") <#> opt (parameter peekProcessOptions "table" "opts" "process options") =#> (functionResult (pushExitCode . (\(a,_,_) -> a)) "integer|boolean" "exit code – `false` on success, an integer otherwise" <> functionResult (pushString . \(_,b,_) -> b) "string" "stdout" <> functionResult (pushString . \(_,_,c) -> c) "string" "stderr") #? T.unlines [ "Executes a system command with the given arguments and `input`" , "on *stdin*." ] -- | Copy a file cp :: LuaError e => DocumentedFunction e cp = defun "cp" ### (\src tgt -> ioToLua $ Directory.copyFile src tgt) <#> filepathParam "source" "source file" <#> filepathParam "target" "target destination" =#> [] #? T.unlines [ "Copy a file with its permissions." , "If the destination file already exists, it is overwritten." ] -- | 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." -- | Check the existence of a file path. exists :: LuaError e => DocumentedFunction e exists = defun "exists" ### (\fp mbType -> do case T.toLower <$> mbType of Nothing -> -- any file type is fine ioToLua $ Directory.doesPathExist fp Just "directory" -> -- must be a directory or a symlink pointing to one ioToLua $ Directory.doesDirectoryExist fp Just "file" -> -- must be a file or a symlink pointing to one ioToLua $ Directory.doesFileExist fp Just "symlink" -> -- must exist and be a symlink ioToLua $ (&&) <$> Directory.doesPathExist fp <*> Directory.pathIsSymbolicLink fp Just otherType -> failLua $ "Unsupported filesystem object type: " <> T.unpack otherType) <#> filepathParam "path" "file path to check" <#> opt (textParam "type" "the required type of the filesystem object") =#> functionResult pushBool "boolean" "whether a filesystem object of type `type` exists at `path`." #? T.unlines [ "Check whether there exists a filesystem object at the given path." , "If `type` is given and either *directory* or *file*, then the" , "function returns `true` if and only if the file system object has" , "the given type, or if it's a symlink pointing to an object of that" , "type. Passing *symlink* as type requires the path itself to be a" , "symlink. Types other than those will cause an error." ] -- | 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 pushFilePathList "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" ] -- | Returns the contents of a file. read_file :: LuaError e => DocumentedFunction e read_file = defun "read_file" ### (ioToLua . B.readFile) <#> filepathParam "filepath" "File to read" =#> functionResult pushByteString "string" "file contents" -- | Rename a file path. rename :: LuaError e => DocumentedFunction e rename = defun "rename" ### (\old new -> ioToLua $ do isDir <- Directory.doesDirectoryExist old if isDir then Directory.renameDirectory old new else Directory.renameFile old new) <#> filepathParam "old" "original path" <#> filepathParam "new" "new path" =#> [] #? T.unlines [ "Change the name of an existing path from `old` to `new`." , "" , "If `old` is a directory and `new` is a directory that already" , "exists, then `new` is atomically replaced by the `old` directory." , "On Win32 platforms, this function fails if `new` is an existing" , "directory." , "" , "If `old` does not refer to a directory, then neither may `new`." , "" , "Renaming may not work across file system boundaries or due to" , "other system-specific reasons. It's generally more robust to" , "copy the source path to its destination before deleting the" , "source." ] -- | Remove a file. rm :: LuaError e => DocumentedFunction e rm = defun "rm" ### ioToLua . Directory.removeFile <#> filepathParam "filename" "file to remove" =#> [] #? "Removes the directory entry for an existing file." -- | 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 modification time and access time of a file. times :: LuaError e => DocumentedFunction e times = defun "times" ### (\filepath -> ioToLua $ (,) <$> Directory.getModificationTime filepath <*> Directory.getAccessTime filepath) <#> filepathParam "filepath" "file or directory path" =#> (functionResult (pushUTCTime . fst) "table" "time at which the file or directory was last modified" <> functionResult (pushUTCTime . snd) "table" "time at which the file or directory was last accessed") #? T.unlines [ "Obtain the modification and access time of a file or directory." , "The times are returned as strings using the ISO 8601 format." ] -- | 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) -- | Provides a temporary directory for the given action. 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 -- | Write a string to a file. write_file :: LuaError e => DocumentedFunction e write_file = defun "write_file" ### (\filepath contents -> ioToLua $ B.writeFile filepath contents) <#> filepathParam "filepath" "path to target file" <#> parameter peekByteString "string" "contents" "file contents" =#> [] #? "Writes a string to a file." -- | Obtain the paths to special directories. xdg :: LuaError e => DocumentedFunction e xdg = defun "xdg" ### (\xdgDirTypeOrList mfp-> case xdgDirTypeOrList of Left xdgDirType -> Left <$> let fp = fromMaybe "" mfp in ioToLua $ Directory.getXdgDirectory xdgDirType fp Right xdgDirList -> ioToLua $ Right <$> Directory.getXdgDirectoryList xdgDirList) <#> parameter peekXdgDirectory "string" "xdg_directory_type" (T.unlines [ "The type of the XDG directory or search path." , "Must be one of `config`, `data`, `cache`, `state`," , "`datadirs`, or `configdirs`." , "" , "Matching is case-insensitive, and underscores and `XDG`" , "prefixes are ignored, so a value like" , "`XDG_DATA_DIRS` is also acceptable." , "" , "The `state` directory might not be available, depending" , "on the version of the underlying Haskell library." ]) <#> opt (filepathParam "filepath" ("relative path that is appended to the path; ignored " <> "if the result is a list of search paths.")) =#> functionResult (either pushString pushFilePathList) "string|{string,...}" "Either a single file path, or a list of search paths." #? T.unlines [ "Access special directories and directory search paths." , "" , "Special directories for storing user-specific application" , "data, configuration, and cache files, as specified by the" , "[XDG Base Directory Specification](" <> "https://specifications.freedesktop.org/basedir-spec/latest/)." ] -- -- 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" -- -- Process parameters -- -- | Process options data ProcessOpts = ProcessOpts { processOptsEnv :: Maybe [(String, String)] , processOptsCwd :: Maybe FilePath } -- | Peek process creation options peekProcessOptions :: LuaError e => Peeker e ProcessOpts peekProcessOptions = typeChecked "table" istable $ \idx -> do let peekEnv = peekKeyValuePairs peekString peekString env' <- peekFieldRaw (peekNilOr peekEnv) "env" idx cwd' <- peekFieldRaw (peekNilOr peekString) "cwd" idx return $ ProcessOpts { processOptsEnv = env' , processOptsCwd = cwd' } -- | Pushes an exit code; failure codes are pushed as integers, and -- success is pushed as `false`. This means that the value can be -- interpreted as a boolean `failed` value. pushExitCode :: Pusher e Exit.ExitCode pushExitCode = \case Exit.ExitSuccess -> pushBool False Exit.ExitFailure n -> pushIntegral n -- | Pushes a time as ISO 8601 string. pushUTCTime :: Pusher e Time.UTCTime pushUTCTime = pushString . ISO8601.iso8601Show -- | Get an XDG directory type identifier. peekXdgDirectory :: Peeker e (Either Directory.XdgDirectory Directory.XdgDirectoryList) peekXdgDirectory = (fmap cleanupXdgSpec . peekText) >=> \case "cache" -> pure (Left Directory.XdgCache) "config" -> pure (Left Directory.XdgConfig) "data" -> pure (Left Directory.XdgData) #if MIN_VERSION_directory(1,3,7) "state" -> pure (Left Directory.XdgState) #endif "datadirs" -> pure (Right Directory.XdgDataDirs) "configdirs" -> pure (Right Directory.XdgConfigDirs) s -> failPeek $ "Expected 'cache', 'config', 'data', or 'state', got: " <> Utf8.fromText s where -- Cleanup the XDG directory specifier as to make matching easier -- while keeping things permissive. -- Remove underscores, any 'xdg' prefix, and -- make sure everything is lowercase cleanupXdgSpec = (\s -> fromMaybe s $ T.stripPrefix "xdg" s) . T.filter (/= '_') . T.toLower -- | Pushes a list of file paths. pushFilePathList :: LuaError e => Pusher e [FilePath] pushFilePathList fps = do pushList pushString fps newListMetatable "FilePath list" (pure ()) setmetatable (nth 2) hslua-module-system-1.3.0/src/HsLua/Module/SystemUtils.hs0000644000000000000000000000342107346545000021516 0ustar0000000000000000{-| Module : HsLua.Module.SystemUtils Copyright : © 2019-2026 Albert Krewinkel License : MIT Maintainer : Albert Krewinkel Utility functions and types for HsLua's system module. -} module HsLua.Module.SystemUtils ( Callback (..) , peekCallback , invoke , invokeWithFilePath , ioToLua ) where import Control.Exception (IOException, try) import HsLua.Core hiding (try) import HsLua.Marshalling -- | Lua callback function. This type is similar to @'AnyValue'@, and -- the same caveats apply. newtype Callback = Callback StackIndex peekCallback :: Peeker e Callback peekCallback = reportValueOnFailure "function" $ \idx -> do idx' <- absindex idx isFn <- isfunction idx' return $ if isFn then Just $ Callback idx' else Nothing pushCallback :: Pusher e Callback pushCallback (Callback idx) = pushvalue idx -- | Call Lua callback function and return all of its results. invoke :: LuaError e => Callback -> LuaE e NumResults invoke callback = do oldTop <- gettop pushCallback callback call 0 multret newTop <- gettop return . NumResults . fromStackIndex $ newTop - oldTop -- | Call Lua callback function with the given filename as its argument. invokeWithFilePath :: LuaError e => Callback -> FilePath -> LuaE e NumResults invokeWithFilePath callback filename = do oldTop <- gettop pushCallback callback pushString filename call (NumArgs 1) multret newTop <- gettop return . NumResults . fromStackIndex $ newTop - oldTop -- | Convert a System IO operation to a Lua operation. ioToLua :: LuaError e => IO a -> LuaE e a ioToLua action = do result <- liftIO (try action) case result of Right result' -> return result' Left err -> failLua (show (err :: IOException)) hslua-module-system-1.3.0/test/0000755000000000000000000000000007346545000014604 5ustar0000000000000000hslua-module-system-1.3.0/test/test-hslua-module-system.hs0000644000000000000000000000345507346545000022045 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeApplications #-} {-| Module : Main Copyright : © 2019-2026 Albert Krewinkel License : MIT Maintainer : Albert Krewinkel Stability : alpha Portability : Requires language extensions ForeignFunctionInterface, OverloadedStrings. Tests for the `system` Lua module. -} module Main (main) where import Control.Monad (void) import HsLua.Core as Lua import HsLua.Module.System (documentedModule) import HsLua.Packaging.Module (preloadModule, preloadModuleWithName, pushModule, registerModule) import Test.Tasty (TestTree, defaultMain, testGroup) import Test.Tasty.HUnit (assertEqual, testCase) import Test.Tasty.Lua (translateResultsFromFile) main :: IO () main = do luaTestResults <- run @Lua.Exception $ do openlibs registerModule documentedModule pop 1 translateResultsFromFile "test/test-system.lua" defaultMain $ testGroup "hslua-module-system" [tests, luaTestResults] -- | HSpec tests for the Lua 'system' module tests :: TestTree tests = testGroup "HsLua System module" [ testCase "system module can be pushed to the stack" $ run (void (pushModule documentedModule) :: Lua ()) , testCase "system module can be added to the preloader" . run $ do openlibs preloadModule documentedModule assertEqual' "function not added to preloader" TypeFunction =<< do _ <- dostring "return package.preload.system" ltype top , testCase "system module can be loaded as hssystem" . run $ do openlibs preloadModuleWithName documentedModule "hssystem" assertEqual' "loading the module fails " OK =<< dostring "require 'hssystem'" ] assertEqual' :: (Show a, Eq a) => String -> a -> a -> Lua () assertEqual' msg expected = liftIO . assertEqual msg expected hslua-module-system-1.3.0/test/test-system.lua0000644000000000000000000003515507346545000017621 0ustar0000000000000000-- -- Tests for the system module -- local io = require 'io' local system = require 'system' local tasty = require 'tasty' local group = tasty.test_group local test = tasty.test_case local assert = tasty.assert --- helper function, combining with_wd and with_tmpdir function in_tmpdir (callback) return function () system.with_tmpdir('test-sytem-tmpdir', function (tmpdir) system.with_wd(tmpdir, callback) end) end end --- dummy string for testing local token = 'Banana' --- check if token can be written into a file in given directory; returns the --- content of this file. function write_read_token (dir, filename) local filename = string.format('%s/%s', dir, 'foo.txt') local fh = io.open(filename, 'w') fh:write(token .. '\n') fh:close() return io.open(filename):read '*l' end -- Check existence static fields return { group 'static fields' { test('arch', function () assert.are_equal(type(system.arch), 'string') end), test('compiler_name', function () assert.are_equal(type(system.compiler_name), 'string') end), test('compiler_version', function () assert.are_equal(type(system.compiler_version), 'table') end), test('cputime_precision', function () assert.are_equal(type(system.cputime_precision), 'number') end), test('os', function () assert.are_equal(type(system.os), 'string') end), }, group 'copy' { test('copys the file', in_tmpdir(function () local content = 'Це тестовий контент.' local fh = io.open('a.txt', 'w') fh:write(content) fh:close() system.cp('a.txt', 'b.txt') assert.are_equal(content, io.open('b.txt'):read('a')) end)) }, group 'cputime' { test('returns a number', function () assert.are_equal(type(system.cputime()), 'number') end), }, group 'environment' { test('getenv returns same result as os.getenv', function () assert.are_equal(system.getenv 'PATH', os.getenv 'PATH') end), test('setenv sets environment values', function () system.setenv('HSLUA_SYSTEM_MODULE', 'test') -- apparently this works differently on Windows. local getenv = system.os == 'mingw32' and system.getenv or os.getenv assert.are_equal(getenv 'HSLUA_SYSTEM_MODULE', 'test') end), }, group 'getwd' { test('returns a string', function () assert.are_equal(type(system.getwd()), 'string') end) }, group 'env' { test('returns a table', function () assert.are_equal(type(system.env()), 'table') end) }, group 'exists' { test('returns `false` if the path does not exist', in_tmpdir(function () -- the temporary dir should be empty assert.is_falsy(system.exists('does-not-exist.txt')) end)), test('returns `true` if the path does not exist', in_tmpdir(function () io.open('README.md', 'w'):close() assert.is_truthy(system.exists('README.md')) end)), test('returns `false` for non-existing files', in_tmpdir(function () assert.is_falsy(system.exists('README.md', 'file')) end)), test('returns `true` for existing files', in_tmpdir(function () io.open('README.md', 'w'):close() assert.is_truthy(system.exists('README.md', 'file')) end)), test('returns `false` for missing directories', in_tmpdir(function () assert.is_falsy(system.exists('folder', 'directory')) end)), test('returns `true` for existing directories', in_tmpdir(function () system.mkdir 'folder' assert.is_truthy(system.exists('folder', 'directory')) end)), test('returns `false` for missing directories', in_tmpdir(function () assert.is_falsy(system.exists('folder', 'directory')) end)), test('returns `false` for file when checking for dir', in_tmpdir(function () io.open('folder', 'w'):close() assert.is_falsy(system.exists('folder', 'directory')) end)), test('returns `true` for dir when checking for file', in_tmpdir(function () system.mkdir 'README.md' assert.is_falsy(system.exists('README.md', 'file')) end)), test('errors for unknown type', in_tmpdir(function () assert.error_matches( function () system.exists('x', 'device') end, 'Unsupported filesystem object' ) end)), }, group 'ls' { test('returns a table', function () assert.are_equal(type(system.ls('.')), 'table') end), test('lists files in directory', in_tmpdir(function () io.open('README.org', 'w'):close() assert.are_same(system.ls '.', {'README.org'}) end)), test('argument defaults to `.`', function () assert.are_equal(#system.ls('.'), #system.ls()) end), test('fails when arg is not a directory', function () assert.error_matches( function () system.ls('thisdoesnotexist') end, 'thisdoesnotexist' ) assert.error_matches( function () system.ls('README.md') end, 'README%.md' ) end) }, group 'mkdir' { test('create directory', in_tmpdir(function () system.mkdir 'foo' assert.are_equal((system.ls())[1], 'foo') end)), test('create nested directories', in_tmpdir(function () system.mkdir('foo/bar', true) assert.are_equal((system.ls())[1], 'foo') assert.are_equal((system.ls 'foo')[1], 'bar') end)), test('cannot create existing directory', in_tmpdir(function () assert.error_matches(function () system.mkdir '.' end, '%.') end)), test('optionally ignores existing directories', in_tmpdir(function () system.mkdir 'foo' system.mkdir('foo', true) end)), test('normal operation', in_tmpdir(function () system.mkdir 'foo' end)), }, group 'read_file' { test('reads the contents of a file', in_tmpdir(function () local contents = '# Topic\n\nSome contents.\n' local filename = 'my-test.md' local fh = io.open(filename, 'wb') fh:write(contents) fh:close() assert.are_equal(system.read_file(filename), contents) end)), test('can read non-UTF-8 binary data', in_tmpdir(function () local contents = table.concat({ 'Valid ASCII: a', 'Valid 2 Octet Sequence: "\xc3\xb1"', 'Invalid 2 Octet Sequence: "\xc3\x28"', 'Invalid Sequence Identifier: "\xa0\xa1"', 'Valid 3 Octet Sequence: "\xe2\x82\xa1"', 'Invalid 3 Octet Sequence (in 2nd Octet): "\xe2\x28\xa1"', 'Invalid 3 Octet Sequence (in 3rd Octet): "\xe2\x82\x28"', 'Valid 4 Octet Sequence: "\xf0\x90\x8c\xbc"', 'Invalid 4 Octet Sequence (in 2nd Octet): "\xf0\x28\x8c\xbc"', 'Invalid 4 Octet Sequence (in 3rd Octet): "\xf0\x90\x28\xbc"', 'Invalid 4 Octet Sequence (in 4th Octet): "\xf0\x28\x8c\x28"', }, '\n') local fh = io.open('my-other-test.md', 'wb') fh:write(contents) fh:close() assert.are_equal(system.read_file('my-other-test.md'), contents) end)), test('fails if file does not exist', in_tmpdir(function () assert.error_matches( function () system.read_file('does-not-exist.org') end, 'No such file or directory' ) end)), test('fails when trying to read a directory', in_tmpdir(function () system.mkdir 'folder' assert.error_matches( function () system.read_file('folder') end, system.os == 'mingw32' and 'permission denied' or 'inappropriate type' ) end)), }, group 'rename' { test('renames a file', in_tmpdir(function () local contents = 'Le café au lait es très délicieux.' local old = 'original.txt' local new = 'moved.txt' local fh = io.open(old, 'wb') fh:write(contents) fh:close() system.rename(old, new) assert.are_equal(io.open(new, 'rb'):read('a'), contents) end)), test('renames a directory', in_tmpdir(function () local old = 'folder' local new = 'moved' -- Create folder that contains a file. system.mkdir(old) system.with_wd(old, function () io.open('test.txt', 'wb'):close() end) local filelist = system.ls(old) -- Move folder to new path system.rename(old, new) assert.are_same(filelist, system.ls(new)) end)), test( 'fails if source path is a file and target is a directory', in_tmpdir(function () local old = 'foo.txt' local new = 'folder' io.open(old, 'wb'):close() system.mkdir(new) assert.error_matches( function () system.rename(old, new) end, os.system == 'mingw32' and 'permission denied' or 'inappropriate type' ) end) ), }, group 'rm' { test('removes a file', in_tmpdir(function () local fh = io.open('test.txt', 'w') fh:write('Hello\n') fh:close() system.rm('test.txt') assert.are_same(system.ls '.', {}) end)), test('fails if file does not exist', in_tmpdir(function () assert.error_matches( function () system.rm('nope.txt') end, 'does not exist' ) end)), }, group 'rmdir' { test('remove empty directory', in_tmpdir(function () system.mkdir 'remove-me' system.rmdir 'remove-me' assert.are_same(system.ls(), {}) end)), test('fail if directory is not empty', in_tmpdir(function () system.mkdir('outer/inner', true) assert.error_matches(function () system.rmdir('outer') end, '.') end)), test('optionally delete recursively', in_tmpdir(function () system.mkdir('outer/inner', true) system.rmdir('outer', true) assert.are_same(system.ls(), {}) end)) }, group 'times' { test('returns two strings', in_tmpdir(function () system.write_file('foo.txt', 'test') local mtime, atime = system.times('foo.txt') assert.are_equal(type(mtime), 'string') assert.are_equal(type(atime), 'string') end)), test('mtime can be parsed as ISO 8601 ', in_tmpdir(function () system.write_file('foo.txt', 'test') local mtime = system.times('foo.txt') local year, month, day, hour, min, sec = string.match(mtime, '(%d%d%d%d)%-(%d%d)-(%d%d)T(%d%d):(%d%d):(%d%d)') assert.is_truthy(year and month and day and hour and min and sec) end)), test('atime can be parsed as ISO 8601 ', in_tmpdir(function () system.write_file('foo.txt', 'test') local _, atime = system.times('foo.txt') local year, month, day, hour, min, sec = string.match(atime, '(%d%d%d%d)%-(%d%d)-(%d%d)T(%d%d):(%d%d):(%d%d)') assert.is_truthy(year and month and day and hour and min and sec) end)), }, group 'tmpdirname' { test('returns a string', function () assert.are_equal(type(system.tmpdirname()), 'string') end) }, group 'with_env' { test('resets environment', function () -- TODO: this test fails on Windows for unknown reasons and is -- disabled on there for that reason. This needs fixing. if system.os == 'mingw32' then return nil end local outer_value = 'outer test value' local inner_value = 'inner test value' local inner_only = 'test #2' function check_env () assert.are_equal(os.getenv 'HSLUA_SYSTEM_TEST', inner_value) assert.are_equal( os.getenv 'HSLUA_SYSTEM_TEST_INNER_ONLY', inner_only ) assert.is_nil(os.getenv 'HSLUA_SYSTEM_TEST_OUTER_ONLY') end local test_env = { HSLUA_SYSTEM_TEST = inner_value, HSLUA_SYSTEM_TEST_INNER_ONLY = inner_only } system.setenv('HSLUA_SYSTEM_TEST_OUTER_ONLY', outer_value) system.setenv('HSLUA_SYSTEM_TEST', outer_value) system.with_env(test_env, check_env) assert.are_equal(system.getenv 'HSLUA_SYSTEM_TEST', outer_value) assert.is_nil(system.getenv 'HSLUA_SYSTEM_TEST_INNER_ONLY') assert.are_equal( system.getenv 'HSLUA_SYSTEM_TEST_OUTER_ONLY', outer_value ) end) }, group 'with_tmpdir' { test('no base directory given', function () assert.are_equal(system.with_tmpdir('foo', write_read_token), token) end), test('cwd as base directory', function () assert.are_equal(system.with_tmpdir('.', 'foo', write_read_token), token) end), }, group 'with_wd' { test('can change to test directory', function () system.with_wd('test', function () local cwd = system.getwd() assert.is_truthy(cwd:match 'test$') end) end), test('returns to old directory once done', function () local cwd = system.getwd() system.with_wd('test', function () end) assert.are_equal(system.getwd(), cwd) end), test('working directory is passed to callback', function () system.with_wd('test', function (path) assert.is_truthy(system.getwd():match (path .. '$')) end) end), test('all callback results are returned', function () local a, b, c = system.with_wd('test', function (path) return 'a', 'b', 'c' end) assert.are_same({a, b, c}, {'a', 'b', 'c'}) end), test('raises an error on nonexistent directory', function () assert.error_matches( function () system.with_wd('does-not-exist', function () end) end, 'does not exist' ) end) }, group 'write_file' { test('writes a string to a file', in_tmpdir(function () local contents = 'Das ist ein Satz auf deutsch.\n' local filename = 'deutsch.txt' system.write_file(filename, contents) assert.are_equal(io.open(filename, 'rb'):read('a'), contents) end)), test('works with `read_file` on Unicode filenames', in_tmpdir(function () local contents = 'Речення українською для перевірки Юнікоду.' local filename = 'український_текст.txt' system.write_file(filename, contents) assert.are_equal(system.read_file(filename), contents) end)), }, group 'xdg' { test('returns a cache directory', function () assert.is_truthy(#system.xdg('cache') > 1) end), test("second argument get's appended" , function () local rel_path = 'pandoc/lua' local data_path = system.xdg('data', rel_path) assert.are_equal( -- replace backslashes with slashes to make this work on windows data_path:sub(- #rel_path, -1):gsub('\\', '/'), rel_path ) end), test("raises an error if the XDG directory is unknown" , function () assert.error_matches(function () system.xdg('foo') end, 'got: foo') end), test('`xdg_` prefix is accepted', function () assert.is_truthy(#system.xdg('xdg_cache') > 1) end), test('returns a list of `XDG_DATA_DIRS`', function () assert.are_equal(type(system.xdg('XDG_DATA_DIRS')), 'table') end), }, }