diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,31 @@ `hslua-module-system` uses [PVP Versioning][]. +## 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. diff --git a/hslua-module-system.cabal b/hslua-module-system.cabal --- a/hslua-module-system.cabal +++ b/hslua-module-system.cabal @@ -1,6 +1,6 @@ cabal-version: 2.2 name: hslua-module-system -version: 1.1.3 +version: 1.2.0 synopsis: Lua module wrapper around Haskell's System module. description: Provides access to system information and @@ -20,16 +20,15 @@ extra-source-files: test/test-system.lua extra-doc-files: CHANGELOG.md , README.md -tested-with: GHC == 8.4.4 - , GHC == 8.6.5 - , GHC == 8.8.3 +tested-with: GHC == 8.8.4 , GHC == 8.10.7 , GHC == 9.0.2 , GHC == 9.2.8 , GHC == 9.4.8 - , GHC == 9.6.5 - , GHC == 9.8.2 - , GHC == 9.10.1 + , GHC == 9.6.7 + , GHC == 9.8.4 + , GHC == 9.10.2 + , GHC == 9.12.2 source-repository head type: git @@ -41,29 +40,34 @@ build-depends: base >= 4.11 && < 5 , hslua-core >= 2.1 && < 2.4 , hslua-packaging >= 2.3 && < 2.4 - , text >= 1.2 && < 2.2 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 - if impl(ghc >= 8.2) - ghc-options: -Wcpp-undef - -Werror=missing-home-modules - if impl(ghc >= 8.4) - ghc-options: -Widentities - -Wincomplete-uni-patterns - -Wpartial-fields - -fhide-source-paths + -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: directory >= 1.3 && < 1.4 + build-depends: bytestring >= 0.10.2 && < 0.13 + , directory >= 1.3.2 && < 1.4 , exceptions >= 0.8 && < 0.11 , 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.15 exposed-modules: HsLua.Module.System other-modules: HsLua.Module.SystemUtils hs-source-dirs: src @@ -77,4 +81,3 @@ , tasty >= 0.11 , tasty-hunit >= 0.9 , tasty-lua >= 1.0 && < 1.2 - , text diff --git a/src/HsLua/Module/System.hs b/src/HsLua/Module/System.hs --- a/src/HsLua/Module/System.hs +++ b/src/HsLua/Module/System.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-| Module : HsLua.Module.System Copyright : © 2019-2025 Albert Krewinkel @@ -20,24 +21,31 @@ , os -- ** Functions + , cmd + , cp , cputime , env , getenv , getwd , ls , mkdir + , read_file + , rename + , rm , rmdir - , run , setenv , setwd + , times , tmpdirname , with_env , with_tmpdir , with_wd + , write_file + , xdg ) where -import Control.Monad (forM_) +import Control.Monad ((>=>), forM_) import Control.Monad.Catch (bracket) import Data.Maybe (fromMaybe) import Data.Text (Text) @@ -47,7 +55,11 @@ 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 @@ -69,19 +81,26 @@ ] , moduleFunctions = [ cmd + , cp , cputime , env , getenv , getwd , ls , mkdir + , read_file + , rename + , rm , rmdir , setenv , setwd + , times , tmpdirname , with_env , with_tmpdir , with_wd + , write_file + , xdg ] , moduleOperations = [] , moduleTypeInitializers = [] @@ -183,6 +202,18 @@ , "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" @@ -260,6 +291,48 @@ , "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" @@ -291,6 +364,22 @@ =#> [] #? "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" @@ -367,6 +456,7 @@ 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 @@ -401,7 +491,55 @@ 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 (pushList pushString)) + "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 -- @@ -445,3 +583,33 @@ 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 diff --git a/test/test-system.lua b/test/test-system.lua --- a/test/test-system.lua +++ b/test/test-system.lua @@ -1,6 +1,8 @@ -- -- Tests for the system module -- +local io = require 'io' + local system = require 'system' local tasty = require 'tasty' @@ -51,6 +53,17 @@ 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') @@ -125,7 +138,104 @@ 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' @@ -143,6 +253,29 @@ 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') @@ -224,5 +357,44 @@ '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), }, }