hslua-module-system 0.2.1 → 0.2.2
raw patch · 7 files changed
+248/−146 lines, 7 filesdep +tasty-luadep ~hsluaPVP ok
version bump matches the API change (PVP)
Dependencies added: tasty-lua
Dependency ranges changed: hslua
API changes (from Hackage documentation)
Files
- CHANGELOG.md +7/−0
- hslua-module-system.cabal +24/−7
- src/Foreign/Lua/Module/System.hs +1/−1
- src/Foreign/Lua/Module/SystemUtils.hs +8/−3
- test/system-module-tests.lua +0/−124
- test/test-hslua-module-system.hs +9/−11
- test/test-system.lua +199/−0
CHANGELOG.md view
@@ -1,5 +1,12 @@ # Revision history for hslua-module-system +## 0.2.2 -- 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.+ ## 0.2.1 -- 2019-05-04 - Use module helpers made available with HsLua 1.0.3. This avoids
hslua-module-system.cabal view
@@ -1,5 +1,5 @@ name: hslua-module-system-version: 0.2.1+version: 0.2.2 synopsis: Lua module wrapper around Haskell's System module. description: Provides access to system information and functionality@@ -14,13 +14,18 @@ license-file: LICENSE author: Albert Krewinkel maintainer: albert+hslua@zeitkraut.de-copyright: Albert Krewinkel <albert+hslua@zeitkraut.de>+copyright: © 2019-2020 Albert Krewinkel <albert+hslua@zeitkraut.de> category: Foreign build-type: Simple extra-source-files: CHANGELOG.md- test/system-module-tests.lua+ , test/test-system.lua cabal-version: >=1.10-tested-with: GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.4, GHC == 8.6.5+tested-with: GHC == 8.0.2+ , GHC == 8.2.2+ , GHC == 8.4.4+ , GHC == 8.6.5+ , GHC == 8.8.3+ , GHC == 8.10.1 source-repository head type: git@@ -31,7 +36,7 @@ , containers >= 0.5 && < 0.7 , directory >= 1.3 && < 1.4 , exceptions >= 0.8 && < 0.11- , hslua >= 1.0.3 && < 1.2+ , hslua >= 1.0.3 && < 1.3 , temporary >= 1.2 && < 1.4 default-extensions: LambdaCase default-language: Haskell2010@@ -45,10 +50,22 @@ type: exitcode-stdio-1.0 main-is: test-hslua-module-system.hs hs-source-dirs: test- ghc-options: -Wall -threaded+ ghc-options: -Wall+ -Wincomplete-record-updates+ -Wnoncanonical-monad-instances+ -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 build-depends: base , hslua , hslua-module-system , tasty , tasty-hunit- , text + , tasty-lua >= 0.2 && < 0.3+ , text
src/Foreign/Lua/Module/System.hs view
@@ -1,6 +1,6 @@ {-| Module : Foreign.Lua.Module.System-Copyright : © 2019 Albert Krewinkel+Copyright : © 2019-2020 Albert Krewinkel License : MIT Maintainer : Albert Krewinkel <albert+hslua@zeitkraut.de> Stability : alpha
src/Foreign/Lua/Module/SystemUtils.hs view
@@ -1,6 +1,6 @@ {-| Module : Foreign.Lua.Module.SystemUtils-Copyright : © 2019 Albert Krewinkel+Copyright : © 2019-2020 Albert Krewinkel License : MIT Maintainer : Albert Krewinkel <albert+hslua@zeitkraut.de> Stability : alpha@@ -21,7 +21,8 @@ import Foreign.Lua (Lua, NumResults(..), Peekable, Pushable, StackIndex) import qualified Foreign.Lua as Lua --- | Lua callback function+-- | Lua callback function. This type is similar to @'AnyValue'@, and+-- the same caveats apply. newtype Callback = Callback StackIndex instance Peekable Callback where@@ -35,7 +36,11 @@ push (Callback idx) = Lua.pushvalue idx --- | Any value of unknown type+-- | Any value of unknown type.+--+-- This simply wraps the function's index on the Lua stack. Changes to+-- the stack may only be made with great care, as they can break the+-- reference. newtype AnyValue = AnyValue { fromAnyValue :: StackIndex } instance Peekable AnyValue where
− test/system-module-tests.lua
@@ -1,124 +0,0 @@------ Tests for the system module----local system = require 'system'---- Check existence static fields-assert(type(system.arch) == 'string')-assert(type(system.compiler_name) == 'string')-assert(type(system.compiler_version) == 'table')-assert(type(system.os) == 'string')---- getwd-assert(type(system.getwd()) == 'string')---- env-assert(type(system.env()) == 'table')---- ls-assert(type(system.ls('.')) == 'table')-assert(#system.ls('.') == #system.ls())--- ls should fail when called on files or non-existent directories-assert(pcall(system.ls, 'thisdoesnotexist') == false)-assert(pcall(system.ls, 'README.md') == false)---- mkdir and rmdir-function in_tmpdir (callback)- local orig_dir = system.getwd()- return system.with_tmpdir(- 'hello',- function (tmpdir)- system.setwd(tmpdir)- local result = callback(tmpdir)- system.setwd(orig_dir)- return result- end- )-end--function test_mkdir_rmdir ()- -- mkdir- assert(not pcall(system.mkdir, '.'), "should not be possible to create `.`")- assert(pcall(system.mkdir, 'foo'), "normal dir creation")- assert(pcall(system.mkdir, 'foo', true), "dir creation if exists")- assert((system.ls())[1] == 'foo')- assert(not pcall(system.mkdir, 'bar/baz'),- "creation of nested dir")- assert(pcall(system.mkdir, 'bar/baz', true),- "nested dir creation, including parent directories")- assert((system.ls 'bar')[1] == 'baz')-- -- rmdir- assert(pcall(system.rmdir, 'foo'), "delete empty directory")- assert(not pcall(system.rmdir, 'bar'), "cannot delete non-empty dir")- assert(pcall(system.rmdir, 'bar', true), "delete dir recursively")- assert(#system.ls() == 0, "dir should be empty")-end-in_tmpdir(test_mkdir_rmdir)---- tmpdirname-assert(type(system.tmpdirname()) == 'string', "tmpdirname should return a string")---- with_env-local outer_value = 'outer test value'-local inner_value = 'inner test value'-local inner_only = 'test #2'--function check_env ()- assert(os.getenv 'SYSTEM_TEST' == inner_value, "env has test value")- assert(os.getenv 'SYSTEM_TEST_INNER_ONLY' == inner_only,- "inner only exists")- assert(os.getenv 'SYSTEM_TEST_OUTER_ONLY' == nil,- "outer only variable should be unset")-end--local test_env = {- SYSTEM_TEST = inner_value,- SYSTEM_TEST_INNER_ONLY = inner_only-}-system.setenv('SYSTEM_TEST_OUTER_ONLY', outer_value)-system.setenv('SYSTEM_TEST', outer_value)-system.with_env(test_env, check_env)--assert(system.getenv 'SYSTEM_TEST' == outer_value, "value was restored")-assert(system.getenv 'SYSTEM_TEST_INNER_ONLY' == nil, "value was restored")-assert(system.getenv 'SYSTEM_TEST_OUTER_ONLY' == outer_value,- "value was restored")---- with_tmpdir-local token = 'Banana'-function write_read_token (tmpdir)- local filename = tmpdir .. '/foo.txt'- local fh = io.open(filename, 'w')- fh:write(token .. '\n')- fh:close()- return io.open(filename):read '*l'-end--assert(system.with_tmpdir('.', 'foo', write_read_token) == token)-assert(system.with_tmpdir('foo', write_read_token) == token)----- Complex scripts-function create_then_count_files ()- io.open('README.org', 'w'):close()- return #system.ls '.'-end--assert(in_tmpdir(create_then_count_files) == 1, 'Number of files should be 1')--system.setenv('TESTING', token)-assert(system.getenv 'TESTING' == token,- 'setting and getting env var is inconsistent')---- with_wd-local cwd = system.getwd()-function check_wd (path)- assert(path == system.getwd(), "current path is given as arg")- assert(path ~= cwd, "current path has changed from original")-end--system.with_tmpdir(- 'wd-test',- function (path) return system.with_wd(path, check_wd) end-)
test/test-hslua-module-system.hs view
@@ -1,7 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} {-| Module : Main-Copyright : © 2019 Albert Krewinkel+Copyright : © 2019-2020 Albert Krewinkel License : MIT Maintainer : Albert Krewinkel <albert+hslua@zeitkraut.de> Stability : alpha@@ -11,16 +11,22 @@ Tests for the `system` Lua module. -} -import Control.Monad (void, when)+import Control.Monad (void) import Foreign.Lua (Lua) import Foreign.Lua.Module.System (preloadModule, pushModule) import Test.Tasty (TestTree, defaultMain, testGroup) import Test.Tasty.HUnit (assertEqual, testCase)+import Test.Tasty.Lua (translateResultsFromFile) import qualified Foreign.Lua as Lua main :: IO ()-main = defaultMain $ testGroup "hslua-module-system" [tests]+main = do+ luaTestResults <- Lua.run $ do+ Lua.openlibs+ Lua.requirehs "system" (void pushModule)+ translateResultsFromFile "test/test-system.lua"+ defaultMain $ testGroup "hslua-module-system" [tests, luaTestResults] -- | HSpec tests for the Lua 'system' module tests :: TestTree@@ -40,14 +46,6 @@ preloadModule "hssystem" assertEqual' "loading the module fails " Lua.OK =<< Lua.dostring "require 'hssystem'"-- , testCase "Lua tests pass" . Lua.run $ do- Lua.openlibs- preloadModule "system"- assertEqual' "error while running lua tests" Lua.OK =<< do- st <- Lua.loadfile "test/system-module-tests.lua"- when (st == Lua.OK) $ Lua.call 0 0- return st ] assertEqual' :: (Show a, Eq a) => String -> a -> a -> Lua ()
+ test/test-system.lua view
@@ -0,0 +1,199 @@+--+-- Tests for the system module+--+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('os', function ()+ assert.are_equal(type(system.os), 'string')+ 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')+ assert.are_equal(os.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 '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 '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 'tmpdirname' {+ test('returns a string', function ()+ assert.are_equal(type(system.tmpdirname()), 'string')+ end)+ },++ group 'with_env' {+ test('resets environment', function ()+ 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),+ },+}