hslua-module-system 0.2.2.1 → 1.0.0

raw patch · 10 files changed

+544/−372 lines, 10 filesdep +hslua-coredep +hslua-marshallingdep +hslua-packagingdep −containersdep −hsluadep ~basedep ~tastydep ~tasty-hunitsetup-changedPVP ok

version bump matches the API change (PVP)

Dependencies added: hslua-core, hslua-marshalling, hslua-packaging

Dependencies removed: containers, hslua

Dependency ranges changed: base, tasty, tasty-hunit, tasty-lua, text

API changes (from Hackage documentation)

Files

• CHANGELOG.md +6/−0
• LICENSE +1/−1
• Setup.hs +0/−2
• hslua-module-system.cabal +42/−37
• src/Foreign/Lua/Module/System.hs +0/−207
• src/Foreign/Lua/Module/SystemUtils.hs +0/−79
• src/HsLua/Module/System.hs +368/−0
• src/HsLua/Module/SystemUtils.hs +66/−0
• test/test-hslua-module-system.hs +24/−21
• test/test-system.lua +37/−25

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

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

@@ -1,2 +0,0 @@-import Distribution.Simple-main = defaultMain

@@ -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:          albert+hslua@zeitkraut.de-copyright:           © 2019-2020 Albert Krewinkel <albert+hslua@zeitkraut.de>+copyright:           © 2019-2021 Albert Krewinkel <albert+hslua@zeitkraut.de> 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--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-  default-language:    Haskell2010-  exposed-modules:     Foreign.Lua.Module.System-  other-modules:       Foreign.Lua.Module.SystemUtils-  hs-source-dirs:      src-  other-extensions:    OverloadedStrings+  location:          https://github.com/hslua/hslua.git+  subdir:            hslua-module-system -test-suite test-hslua-module-system+common common-options   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

@@ -1,207 +0,0 @@-{-|-Module      : Foreign.Lua.Module.System-Copyright   : © 2019-2020 Albert Krewinkel-License     : MIT-Maintainer  : Albert Krewinkel <albert+hslua@zeitkraut.de>-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')

@@ -1,79 +0,0 @@-{-|-Module      : Foreign.Lua.Module.SystemUtils-Copyright   : © 2019-2020 Albert Krewinkel-License     : MIT-Maintainer  : Albert Krewinkel <albert+hslua@zeitkraut.de>-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))

@@ -0,0 +1,368 @@+{-|+Module      : HsLua.Module.System+Copyright   : © 2019-2021 Albert Krewinkel+License     : MIT+Maintainer  : Albert Krewinkel <albert+hslua@zeitkraut.de>+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"

@@ -0,0 +1,66 @@+{-|+Module      : HsLua.Module.SystemUtils+Copyright   : © 2019-2021 Albert Krewinkel+License     : MIT+Maintainer  : Albert Krewinkel <albert+hslua@zeitkraut.de>++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))

@@ -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 <albert+hslua@zeitkraut.de> 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 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" . Lua.run $ do-      Lua.openlibs-      preloadModule "hssystem"-      assertEqual' "loading the module fails " Lua.OK =<<-        Lua.dostring "require 'hssystem'"+  , 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

@@ -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'+      -- 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 -           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 outer_value = 'outer test value'+      local inner_value = 'inner test value'+      local inner_only = 'test #2' -           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-           )+      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)   }, @@ -194,6 +200,12 @@       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),   }, }