hslua-module-system 1.1.3 → 1.2.0

raw patch · 4 files changed

+388/−20 lines, 4 filesdep +bytestringdep +timedep ~directorydep ~textPVP ok

version bump matches the API change (PVP)

Dependencies added: bytestring, time

Dependency ranges changed: directory, text

API changes (from Hackage documentation)

Files

• CHANGELOG.md +25/−0
• hslua-module-system.cabal +21/−18
• src/HsLua/Module/System.hs +170/−2
• test/test-system.lua +172/−0

@@ -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.

@@ -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

@@ -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

@@ -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),   }, }