Script 'mail_helper' called by obssrc
Hello community,
here is the log from the commit of package ghc-hslua-module-system for
openSUSE:Factory checked in at 2021-11-11 21:36:33
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Factory/ghc-hslua-module-system (Old)
and /work/SRC/openSUSE:Factory/.ghc-hslua-module-system.new.1890 (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-hslua-module-system"
Thu Nov 11 21:36:33 2021 rev:7 rq:930333 version:1.0.0
Changes:
--------
---
/work/SRC/openSUSE:Factory/ghc-hslua-module-system/ghc-hslua-module-system.changes
2020-12-22 11:40:40.389573670 +0100
+++
/work/SRC/openSUSE:Factory/.ghc-hslua-module-system.new.1890/ghc-hslua-module-system.changes
2021-11-11 21:36:47.636904928 +0100
@@ -1,0 +2,10 @@
+Mon Nov 1 08:48:28 UTC 2021 - [email protected]
+
+- Update hslua-module-system to version 1.0.0.
+ ## 1.0.0
+
+ Release pending.
+
+ - Use hslua 2.0.
+
+-------------------------------------------------------------------
Old:
----
hslua-module-system-0.2.2.1.tar.gz
New:
----
hslua-module-system-1.0.0.tar.gz
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ ghc-hslua-module-system.spec ++++++
--- /var/tmp/diff_new_pack.ZxCdC8/_old 2021-11-11 21:36:48.220905354 +0100
+++ /var/tmp/diff_new_pack.ZxCdC8/_new 2021-11-11 21:36:48.220905354 +0100
@@ -1,7 +1,7 @@
#
# spec file for package ghc-hslua-module-system
#
-# Copyright (c) 2020 SUSE LLC
+# Copyright (c) 2021 SUSE LLC
#
# All modifications and additions to the file contributed by third parties
# remain the property of their copyright owners, unless otherwise agreed
@@ -19,34 +19,34 @@
%global pkg_name hslua-module-system
%bcond_with tests
Name: ghc-%{pkg_name}
-Version: 0.2.2.1
+Version: 1.0.0
Release: 0
Summary: Lua module wrapper around Haskell's System module
License: MIT
URL: https://hackage.haskell.org/package/%{pkg_name}
Source0:
https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{version}.tar.gz
BuildRequires: ghc-Cabal-devel
-BuildRequires: ghc-containers-devel
BuildRequires: ghc-directory-devel
BuildRequires: ghc-exceptions-devel
-BuildRequires: ghc-hslua-devel
+BuildRequires: ghc-hslua-core-devel
+BuildRequires: ghc-hslua-marshalling-devel
+BuildRequires: ghc-hslua-packaging-devel
BuildRequires: ghc-rpm-macros
BuildRequires: ghc-temporary-devel
+BuildRequires: ghc-text-devel
ExcludeArch: %{ix86}
%if %{with tests}
BuildRequires: ghc-tasty-devel
BuildRequires: ghc-tasty-hunit-devel
BuildRequires: ghc-tasty-lua-devel
-BuildRequires: ghc-text-devel
%endif
%description
Provides access to system information and functionality to Lua scripts 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.
+This package is part of HsLua, a Haskell framework built around the embeddable
+scripting language <https://lua.org Lua>.
%package devel
Summary: Haskell %{pkg_name} library development files
++++++ hslua-module-system-0.2.2.1.tar.gz -> hslua-module-system-1.0.0.tar.gz
++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/hslua-module-system-0.2.2.1/CHANGELOG.md
new/hslua-module-system-1.0.0/CHANGELOG.md
--- old/hslua-module-system-0.2.2.1/CHANGELOG.md 2001-09-09
03:46:40.000000000 +0200
+++ new/hslua-module-system-1.0.0/CHANGELOG.md 2001-09-09 03:46:40.000000000
+0200
@@ -1,5 +1,11 @@
# Revision history for hslua-module-system
+## 1.0.0
+
+Release pending.
+
+- Use hslua 2.0.
+
## 0.2.2.1 -- 2020-10-16
- Relaxed upper bound for hslua, allow `hslua-1.3.*`.
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/hslua-module-system-0.2.2.1/LICENSE
new/hslua-module-system-1.0.0/LICENSE
--- old/hslua-module-system-0.2.2.1/LICENSE 2001-09-09 03:46:40.000000000
+0200
+++ new/hslua-module-system-1.0.0/LICENSE 2001-09-09 03:46:40.000000000
+0200
@@ -1,4 +1,4 @@
-Copyright (c) 2019 Albert Krewinkel
+Copyright (c) 2019-2021 Albert Krewinkel
Permission is hereby granted, free of charge, to any person obtaining
a copy of this software and associated documentation files (the
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/hslua-module-system-0.2.2.1/Setup.hs
new/hslua-module-system-1.0.0/Setup.hs
--- old/hslua-module-system-0.2.2.1/Setup.hs 2001-09-09 03:46:40.000000000
+0200
+++ new/hslua-module-system-1.0.0/Setup.hs 1970-01-01 01:00:00.000000000
+0100
@@ -1,2 +0,0 @@
-import Distribution.Simple
-main = defaultMain
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/hslua-module-system-0.2.2.1/hslua-module-system.cabal
new/hslua-module-system-1.0.0/hslua-module-system.cabal
--- old/hslua-module-system-0.2.2.1/hslua-module-system.cabal 2001-09-09
03:46:40.000000000 +0200
+++ new/hslua-module-system-1.0.0/hslua-module-system.cabal 2001-09-09
03:46:40.000000000 +0200
@@ -1,55 +1,45 @@
+cabal-version: 2.2
name: hslua-module-system
-version: 0.2.2.1
+version: 1.0.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.
+description: Provides access to system information and
+ functionality to Lua scripts 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.
-homepage: https://github.com/hslua/hslua-module-system
+ This package is part of HsLua, a Haskell framework
+ built around the embeddable scripting language
+ <https://lua.org Lua>.
+homepage: https://github.com/hslua/hslua
license: MIT
license-file: LICENSE
author: Albert Krewinkel
maintainer: [email protected]
-copyright: ?? 2019-2020 Albert Krewinkel <[email protected]>
+copyright: ?? 2019-2021 Albert Krewinkel <[email protected]>
category: Foreign
-build-type: Simple
extra-source-files: CHANGELOG.md
, 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
, GHC == 8.8.3
- , GHC == 8.10.1
+ , GHC == 8.10.4
+ , GHC == 9.0.1
source-repository head
type: git
- location: https://github.com/hslua/hslua-module-system.git
+ location: https://github.com/hslua/hslua.git
+ subdir: hslua-module-system
-library
- build-depends: base >= 4.9 && < 5
- , containers >= 0.5 && < 0.7
- , directory >= 1.3 && < 1.4
- , exceptions >= 0.8 && < 0.11
- , hslua >= 1.0.3 && < 1.4
- , temporary >= 1.2 && < 1.4
- default-extensions: LambdaCase
+common common-options
default-language: Haskell2010
- exposed-modules: Foreign.Lua.Module.System
- other-modules: Foreign.Lua.Module.SystemUtils
- hs-source-dirs: src
- other-extensions: OverloadedStrings
-
-test-suite test-hslua-module-system
- default-language: Haskell2010
- type: exitcode-stdio-1.0
- main-is: test-hslua-module-system.hs
- hs-source-dirs: test
+ build-depends: base >= 4.8 && < 5
+ , hslua-core >= 2.0 && < 2.1
+ , hslua-packaging >= 2.0 && < 2.1
+ , text >= 1.0 && < 1.3
+ default-extensions: LambdaCase
+ , OverloadedStrings
ghc-options: -Wall
-Wincomplete-record-updates
-Wnoncanonical-monad-instances
@@ -62,10 +52,25 @@
-Wincomplete-uni-patterns
-Wpartial-fields
-fhide-source-paths
- build-depends: base
- , hslua
- , hslua-module-system
- , tasty
- , tasty-hunit
- , tasty-lua >= 0.2 && < 0.3
+
+library
+ import: common-options
+ build-depends: directory >= 1.3 && < 1.4
+ , exceptions >= 0.8 && < 0.11
+ , hslua-marshalling >= 2.0 && < 2.1
+ , temporary >= 1.2 && < 1.4
+ , text >= 1.0 && < 1.3
+ 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.1
, text
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/hslua-module-system-0.2.2.1/src/Foreign/Lua/Module/System.hs
new/hslua-module-system-1.0.0/src/Foreign/Lua/Module/System.hs
--- old/hslua-module-system-0.2.2.1/src/Foreign/Lua/Module/System.hs
2001-09-09 03:46:40.000000000 +0200
+++ new/hslua-module-system-1.0.0/src/Foreign/Lua/Module/System.hs
1970-01-01 01:00:00.000000000 +0100
@@ -1,207 +0,0 @@
-{-|
-Module : Foreign.Lua.Module.System
-Copyright : ?? 2019-2020 Albert Krewinkel
-License : MIT
-Maintainer : Albert Krewinkel <[email protected]>
-Stability : alpha
-Portability : Requires GHC 8 or later.
-
-Provide a Lua module containing a selection of @'System'@ functions.
--}
-module Foreign.Lua.Module.System (
-
- -- * Module
- pushModule
- , preloadModule
-
- -- * Fields
- , arch
- , compiler_name
- , compiler_version
- , os
-
- -- * Functions
- , env
- , getwd
- , getenv
- , ls
- , mkdir
- , rmdir
- , setenv
- , setwd
- , tmpdirname
- , with_env
- , with_tmpdir
- , with_wd
- )
-where
-
-import Control.Applicative ((<$>))
-import Control.Monad (forM_)
-import Control.Monad.Catch (bracket)
-import Data.Maybe (fromMaybe)
-import Data.Version (versionBranch)
-import Foreign.Lua (Lua, NumResults (..), Optional (..))
-import Foreign.Lua.Module.SystemUtils
-
-import qualified Data.Map as Map
-import qualified Foreign.Lua as Lua
-import qualified System.Directory as Directory
-import qualified System.Environment as Env
-import qualified System.Info as Info
-import qualified System.IO.Temp as Temp
-
---
--- Module
---
-
--- | Pushes the @system@ module to the Lua stack.
-pushModule :: Lua NumResults
-pushModule = do
- Lua.newtable
- Lua.addfield "arch" arch
- Lua.addfield "compiler_name" compiler_name
- Lua.addfield "compiler_version" compiler_version
- Lua.addfield "os" os
- Lua.addfunction "env" env
- Lua.addfunction "getenv" getenv
- Lua.addfunction "getwd" getwd
- Lua.addfunction "ls" ls
- Lua.addfunction "mkdir" mkdir
- Lua.addfunction "rmdir" rmdir
- Lua.addfunction "setenv" setenv
- Lua.addfunction "setwd" setwd
- Lua.addfunction "tmpdirname" tmpdirname
- Lua.addfunction "with_env" with_env
- Lua.addfunction "with_tmpdir" with_tmpdir
- Lua.addfunction "with_wd" with_wd
- return 1
-
--- | Add the @system@ module under the given name to the table of
--- preloaded packages.
-preloadModule :: String -> Lua ()
-preloadModule = flip Lua.preloadhs pushModule
-
---
--- Fields
---
-
--- | The machine architecture on which the program is running.
-arch :: String
-arch = Info.arch
-
--- | The Haskell implementation with which the host program was
--- compiled.
-compiler_name :: String
-compiler_name = Info.compilerName
-
--- | The version of `compiler_name` with which the host program was
--- compiled.
-compiler_version :: [Int]
-compiler_version = versionBranch Info.compilerVersion
-
--- | The operating system on which the program is running.
-os :: String
-os = Info.os
-
-
---
--- Functions
---
-
--- | Retrieve the entire environment
-env :: Lua NumResults
-env = do
- kvs <- ioToLua Env.getEnvironment
- let addValue (k, v) = Lua.push k *> Lua.push v *> Lua.rawset (-3)
- Lua.newtable
- mapM_ addValue kvs
- return (NumResults 1)
-
--- | Return the current working directory as an absolute path.
-getwd :: Lua FilePath
-getwd = ioToLua Directory.getCurrentDirectory
-
--- | Returns the value of an environment variable
-getenv :: String -> Lua (Optional String)
-getenv name = ioToLua (Optional <$> Env.lookupEnv name)
-
--- | List the contents of a directory.
-ls :: Optional FilePath -> Lua [FilePath]
-ls fp = do
- let fp' = fromMaybe "." (fromOptional fp)
- ioToLua (Directory.listDirectory fp')
-
--- | 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 :: FilePath -> Bool -> Lua ()
-mkdir fp createParent =
- if createParent
- then ioToLua (Directory.createDirectoryIfMissing True fp)
- else ioToLua (Directory.createDirectory fp)
-
--- | Remove an existing directory.
-rmdir :: FilePath -> Bool -> Lua ()
-rmdir fp recursive =
- if recursive
- then ioToLua (Directory.removeDirectoryRecursive fp)
- else ioToLua (Directory.removeDirectory fp)
-
--- | Set the specified environment variable to a new value.
-setenv :: String -> String -> Lua ()
-setenv name value = ioToLua (Env.setEnv name value)
-
--- | Change current working directory.
-setwd :: FilePath -> Lua ()
-setwd fp = ioToLua $ Directory.setCurrentDirectory fp
-
--- | Get the current directory for temporary files.
-tmpdirname :: Lua FilePath
-tmpdirname = ioToLua Directory.getTemporaryDirectory
-
--- | Run an action in a different directory, then restore the old
--- working directory.
-with_wd :: FilePath -> Callback -> Lua NumResults
-with_wd fp callback =
- bracket (Lua.liftIO Directory.getCurrentDirectory)
- (Lua.liftIO . Directory.setCurrentDirectory)
- $ \_ -> do
- Lua.liftIO (Directory.setCurrentDirectory fp)
- callback `invokeWithFilePath` fp
-
-
--- | Run an action, then restore the old environment variable values.
-with_env :: Map.Map String String -> Callback -> Lua NumResults
-with_env environment callback =
- bracket (Lua.liftIO Env.getEnvironment)
- setEnvironment
- (\_ -> setEnvironment (Map.toList environment) >> invoke callback)
- where
- setEnvironment newEnv = Lua.liftIO $ 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)
-
-with_tmpdir :: String -- ^ parent dir or template
- -> AnyValue -- ^ template or callback
- -> Optional Callback -- ^ callback or nil
- -> Lua NumResults
-with_tmpdir parentDir tmpl callback =
- case fromOptional callback of
- Nothing -> do
- -- At most two args. The first arg (parent dir) has probably been
- -- omitted, so we shift arguments and use the system's canonical
- -- temporary directory.
- let tmpl' = parentDir
- callback' <- Lua.peek (fromAnyValue tmpl)
- Temp.withSystemTempDirectory tmpl' (invokeWithFilePath callback')
- Just callback' -> do
- -- all args given. Second value must be converted to a string.
- tmpl' <- Lua.peek (fromAnyValue tmpl)
- Temp.withTempDirectory parentDir tmpl' (invokeWithFilePath callback')
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/hslua-module-system-0.2.2.1/src/Foreign/Lua/Module/SystemUtils.hs
new/hslua-module-system-1.0.0/src/Foreign/Lua/Module/SystemUtils.hs
--- old/hslua-module-system-0.2.2.1/src/Foreign/Lua/Module/SystemUtils.hs
2001-09-09 03:46:40.000000000 +0200
+++ new/hslua-module-system-1.0.0/src/Foreign/Lua/Module/SystemUtils.hs
1970-01-01 01:00:00.000000000 +0100
@@ -1,79 +0,0 @@
-{-|
-Module : Foreign.Lua.Module.SystemUtils
-Copyright : ?? 2019-2020 Albert Krewinkel
-License : MIT
-Maintainer : Albert Krewinkel <[email protected]>
-Stability : alpha
-Portability : Requires GHC 8 or later.
-
-Utility functions and types for HsLua's system module.
--}
-module Foreign.Lua.Module.SystemUtils
- ( AnyValue (..)
- , Callback (..)
- , invoke
- , invokeWithFilePath
- , ioToLua
- )
-where
-
-import Control.Exception (IOException, try)
-import Foreign.Lua (Lua, NumResults(..), Peekable, Pushable, StackIndex)
-import qualified Foreign.Lua as Lua
-
--- | Lua callback function. This type is similar to @'AnyValue'@, and
--- the same caveats apply.
-newtype Callback = Callback StackIndex
-
-instance Peekable Callback where
- peek idx = do
- isFn <- Lua.isfunction idx
- if isFn
- then return (Callback idx)
- else Lua.throwException "Function expected"
-
-instance Pushable Callback where
- push (Callback idx) = Lua.pushvalue idx
-
-
--- | 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
- peek = return . AnyValue
-
-instance Pushable AnyValue where
- push (AnyValue idx) = Lua.pushvalue idx
-
--- | Call Lua callback function and return all of its results.
-invoke :: Callback -> Lua NumResults
-invoke callback = do
- oldTop <- Lua.gettop
- Lua.push callback
- Lua.call 0 Lua.multret
- newTop <- Lua.gettop
- return . NumResults . fromIntegral . Lua.fromStackIndex $
- newTop - oldTop
-
--- | Call Lua callback function with the given filename as its argument.
-invokeWithFilePath :: Callback -> FilePath -> Lua NumResults
-invokeWithFilePath callback filename = do
- oldTop <- Lua.gettop
- Lua.push callback
- Lua.push filename
- Lua.call (Lua.NumArgs 1) Lua.multret
- newTop <- Lua.gettop
- return . NumResults . fromIntegral . Lua.fromStackIndex $
- newTop - oldTop
-
--- | Convert a System IO operation to a Lua operation.
-ioToLua :: IO a -> Lua a
-ioToLua action = do
- result <- Lua.liftIO (try action)
- case result of
- Right result' -> return result'
- Left err -> Lua.throwException (show (err :: IOException))
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/hslua-module-system-0.2.2.1/src/HsLua/Module/System.hs
new/hslua-module-system-1.0.0/src/HsLua/Module/System.hs
--- old/hslua-module-system-0.2.2.1/src/HsLua/Module/System.hs 1970-01-01
01:00:00.000000000 +0100
+++ new/hslua-module-system-1.0.0/src/HsLua/Module/System.hs 2001-09-09
03:46:40.000000000 +0200
@@ -0,0 +1,368 @@
+{-|
+Module : HsLua.Module.System
+Copyright : ?? 2019-2021 Albert Krewinkel
+License : MIT
+Maintainer : Albert Krewinkel <[email protected]>
+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
+ , env
+ , getwd
+ , getenv
+ , ls
+ , mkdir
+ , rmdir
+ , setenv
+ , setwd
+ , tmpdirname
+ , with_env
+ , with_tmpdir
+ , with_wd
+ )
+where
+
+import Control.Monad (forM_)
+import Control.Monad.Catch (bracket)
+import Data.Maybe (fromMaybe)
+import Data.Text (Text)
+import Data.Version (versionBranch)
+import HsLua.Core
+import HsLua.Marshalling
+import HsLua.Packaging
+import HsLua.Module.SystemUtils
+
+import qualified Data.Text as T
+import qualified HsLua.Core as Lua
+import qualified System.Directory as Directory
+import qualified System.Environment as Env
+import qualified System.Info as Info
+import qualified System.IO.Temp as Temp
+
+-- | The "system" module.
+documentedModule :: LuaError e => Module e
+documentedModule = Module
+ { moduleName = "system"
+ , moduleFields =
+ [ arch
+ , compiler_name
+ , compiler_version
+ , os
+ ]
+ , moduleFunctions =
+ [ env
+ , getenv
+ , getwd
+ , ls
+ , mkdir
+ , rmdir
+ , setenv
+ , setwd
+ , tmpdirname
+ , with_env
+ , with_tmpdir
+ , with_wd
+ ]
+ , moduleOperations = []
+ , moduleDescription =
+ "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 = Field
+ { fieldName = "arch"
+ , fieldDescription =
+ "The machine architecture on which the program is running."
+ , fieldPushValue = 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 = Field
+ { fieldName = "compiler_name"
+ , fieldDescription = "The Haskell implementation with which the host "
+ `T.append` "program was compiled."
+ , fieldPushValue = 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 = Field
+ { fieldName = "compiler_version"
+ , fieldDescription = T.unwords
+ [ "The Haskell implementation with which the host "
+ , "program was compiled." ]
+ , fieldPushValue = pushList pushIntegral $
+ versionBranch Info.compilerVersion
+ }
+
+-- | Field containing the operating system on which the program is
+-- running.
+os :: Field e
+os = Field
+ { fieldName = "os"
+ , fieldDescription = "The operating system on which the program is running."
+ , fieldPushValue = pushString Info.os
+ }
+
+
+--
+-- Functions
+--
+
+-- | 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."
+
+-- | 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 "."
+ <#> optionalParameter peekFilePath "string" "directory"
+ ("Path of the directory whose contents should be listed. "
+ `T.append` "Defaults to `.`.")
+ =#> functionResult (pushList pushString) "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))
+ <#> parameter peekFilePath "string" "dirname"
+ "name of the new directory"
+ <#> optionalParameter peekBool "boolean" "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"
+ ]
+
+-- | 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"
+ <#> optionalParameter peekBool "boolean" "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 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 (Lua.liftIO Directory.getCurrentDirectory)
+ (Lua.liftIO . Directory.setCurrentDirectory)
+ (\_ -> do
+ Lua.liftIO (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 (Lua.liftIO 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 = Lua.liftIO $ 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)
+
+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."
+ ])
+ <#> parameter peekString "string" "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`."
+ #? ("Create and use a temporary directory inside the given directory."
+ `T.append` "The directory is deleted after use.")
+ where
+ peekParentDir idx = do
+ args <- liftLua gettop
+ if args < 3
+ then liftLua $ do
+ pushnil
+ insert idx
+ return Nothing
+ else Just <$> peekString idx
+
+
+--
+-- Parameters
+--
+
+-- | Retrieves a file path from the stack.
+peekFilePath :: Peeker e FilePath
+peekFilePath = peekString
+
+-- | Filepath function parameter.
+filepathParam :: Text -- ^ name
+ -> Text -- ^ description
+ -> Parameter e FilePath
+filepathParam name description = Parameter
+ { parameterPeeker = peekFilePath
+ , parameterDoc = ParameterDoc
+ { parameterName = name
+ , parameterType = "string"
+ , parameterDescription = description
+ , parameterIsOptional = False
+ }
+ }
+
+-- | Result of a function returning a file path.
+filepathResult :: Text -- ^ Description
+ -> [FunctionResult e FilePath]
+filepathResult = functionResult pushString "string"
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/hslua-module-system-0.2.2.1/src/HsLua/Module/SystemUtils.hs
new/hslua-module-system-1.0.0/src/HsLua/Module/SystemUtils.hs
--- old/hslua-module-system-0.2.2.1/src/HsLua/Module/SystemUtils.hs
1970-01-01 01:00:00.000000000 +0100
+++ new/hslua-module-system-1.0.0/src/HsLua/Module/SystemUtils.hs
2001-09-09 03:46:40.000000000 +0200
@@ -0,0 +1,66 @@
+{-|
+Module : HsLua.Module.SystemUtils
+Copyright : ?? 2019-2021 Albert Krewinkel
+License : MIT
+Maintainer : Albert Krewinkel <[email protected]>
+
+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))
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/hslua-module-system-0.2.2.1/test/test-hslua-module-system.hs
new/hslua-module-system-1.0.0/test/test-hslua-module-system.hs
--- old/hslua-module-system-0.2.2.1/test/test-hslua-module-system.hs
2001-09-09 03:46:40.000000000 +0200
+++ new/hslua-module-system-1.0.0/test/test-hslua-module-system.hs
2001-09-09 03:46:40.000000000 +0200
@@ -1,7 +1,8 @@
{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeApplications #-}
{-|
Module : Main
-Copyright : ?? 2019-2020 Albert Krewinkel
+Copyright : ?? 2019-2021 Albert Krewinkel
License : MIT
Maintainer : Albert Krewinkel <[email protected]>
Stability : alpha
@@ -10,21 +11,23 @@
Tests for the `system` Lua module.
-}
+module Main (main) where
import Control.Monad (void)
-import Foreign.Lua (Lua)
-import Foreign.Lua.Module.System (preloadModule, pushModule)
+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)
-import qualified Foreign.Lua as Lua
-
main :: IO ()
main = do
- luaTestResults <- Lua.run $ do
- Lua.openlibs
- Lua.requirehs "system" (void pushModule)
+ luaTestResults <- run @Lua.Exception $ do
+ openlibs
+ registerModule documentedModule
+ pop 1
translateResultsFromFile "test/test-system.lua"
defaultMain $ testGroup "hslua-module-system" [tests, luaTestResults]
@@ -32,21 +35,21 @@
tests :: TestTree
tests = testGroup "HsLua System module"
[ testCase "system module can be pushed to the stack" $
- Lua.run (void pushModule)
+ run (void (pushModule documentedModule) :: Lua ())
- , testCase "system module can be added to the preloader" . Lua.run $ do
- Lua.openlibs
- preloadModule "system"
- assertEqual' "function not added to preloader" Lua.TypeFunction =<< do
- Lua.getglobal' "package.preload.system"
- Lua.ltype (-1)
-
- , testCase "system module can be loaded as hssystem" . Lua.run $ do
- Lua.openlibs
- preloadModule "hssystem"
- assertEqual' "loading the module fails " Lua.OK =<<
- Lua.dostring "require 'hssystem'"
+ , 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 = Lua.liftIO . assertEqual msg expected
+assertEqual' msg expected = liftIO . assertEqual msg expected
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/hslua-module-system-0.2.2.1/test/test-system.lua
new/hslua-module-system-1.0.0/test/test-system.lua
--- old/hslua-module-system-0.2.2.1/test/test-system.lua 2001-09-09
03:46:40.000000000 +0200
+++ new/hslua-module-system-1.0.0/test/test-system.lua 2001-09-09
03:46:40.000000000 +0200
@@ -55,7 +55,9 @@
test('setenv sets environment values', function ()
system.setenv('HSLUA_SYSTEM_MODULE', 'test')
- assert.are_equal(os.getenv '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),
},
@@ -140,32 +142,36 @@
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
- )
+ -- 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)
},
@@ -195,5 +201,11 @@
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),
},
}
