{-|
Module      : HsLua.Module.System
Copyright   : © 2019-2024 Albert Krewinkel
License     : MIT
Maintainer  : Albert Krewinkel <tarleb@hslua.org>
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
  , cputime
  , env
  , getenv
  , getwd
  , 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.CPUTime as CPUTime
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 :: forall e. LuaError e => Module e
documentedModule = Module
  { moduleName :: Name
moduleName = Name
"system"
  , moduleFields :: [Field e]
moduleFields =
      [ Field e
forall e. Field e
arch
      , Field e
forall e. Field e
compiler_name
      , Field e
forall e. LuaError e => Field e
compiler_version
      , Field e
forall e. Field e
cputime_precision
      , Field e
forall e. Field e
os
      ]
  , moduleFunctions :: [DocumentedFunction e]
moduleFunctions =
      [ DocumentedFunction e
forall e. LuaError e => DocumentedFunction e
cputime
      , DocumentedFunction e
forall e. LuaError e => DocumentedFunction e
env
      , DocumentedFunction e
forall e. LuaError e => DocumentedFunction e
getenv
      , DocumentedFunction e
forall e. LuaError e => DocumentedFunction e
getwd
      , DocumentedFunction e
forall e. LuaError e => DocumentedFunction e
ls
      , DocumentedFunction e
forall e. LuaError e => DocumentedFunction e
mkdir
      , DocumentedFunction e
forall e. LuaError e => DocumentedFunction e
rmdir
      , DocumentedFunction e
forall e. LuaError e => DocumentedFunction e
setenv
      , DocumentedFunction e
forall e. LuaError e => DocumentedFunction e
setwd
      , DocumentedFunction e
forall e. LuaError e => DocumentedFunction e
tmpdirname
      , DocumentedFunction e
forall e. LuaError e => DocumentedFunction e
with_env
      , DocumentedFunction e
forall e. LuaError e => DocumentedFunction e
with_tmpdir
      , DocumentedFunction e
forall e. LuaError e => DocumentedFunction e
with_wd
      ]
  , moduleOperations :: [(Operation, DocumentedFunction e)]
moduleOperations = []
  , moduleTypeInitializers :: [LuaE e Name]
moduleTypeInitializers = []
  , moduleDescription :: Text
moduleDescription =
      Text
"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 :: forall e. Field e
arch = Field
  { fieldName :: Text
fieldName = Text
"arch"
  , fieldType :: TypeSpec
fieldType = TypeSpec
"string"
  , fieldDescription :: Text
fieldDescription =
      Text
"The machine architecture on which the program is running."
  , fieldPushValue :: LuaE e ()
fieldPushValue = String -> LuaE e ()
forall e. String -> LuaE e ()
pushString String
Info.arch
  }

-- | Module field containing the Haskell implementation with which the
-- host program was compiled. Wraps @'Info.compilerName'@.
compiler_name :: Field e
compiler_name :: forall e. Field e
compiler_name = Field
  { fieldName :: Text
fieldName = Text
"compiler_name"
  , fieldType :: TypeSpec
fieldType = TypeSpec
"string"
  , fieldDescription :: Text
fieldDescription = Text
"The Haskell implementation with which the host "
                       Text -> Text -> Text
`T.append` Text
"program was compiled."
  , fieldPushValue :: LuaE e ()
fieldPushValue = String -> LuaE e ()
forall e. String -> LuaE e ()
pushString String
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 :: forall e. LuaError e => Field e
compiler_version = Field
  { fieldName :: Text
fieldName = Text
"compiler_version"
  , fieldType :: TypeSpec
fieldType = TypeSpec
"string"
  , fieldDescription :: Text
fieldDescription = [Text] -> Text
T.unwords
      [ Text
"The Haskell implementation with which the host "
      , Text
"program was compiled." ]
  , fieldPushValue :: LuaE e ()
fieldPushValue = Pusher e Int -> [Int] -> LuaE e ()
forall e a. LuaError e => Pusher e a -> [a] -> LuaE e ()
pushList Pusher e Int
forall a e. (Integral a, Show a) => a -> LuaE e ()
pushIntegral ([Int] -> LuaE e ()) -> [Int] -> LuaE e ()
forall a b. (a -> b) -> a -> b
$
                     Version -> [Int]
versionBranch Version
Info.compilerVersion
  }

-- | Field containing the smallest measurable difference in CPU time.
cputime_precision :: Field e
cputime_precision :: forall e. Field e
cputime_precision = Field
  { fieldName :: Text
fieldName = Text
"cputime_precision"
  , fieldType :: TypeSpec
fieldType = TypeSpec
"integer"
  , fieldDescription :: Text
fieldDescription = [Text] -> Text
T.unlines
      [ Text
"The smallest measurable difference in CPU time that the"
      , Text
"implementation can record, and is given as an integral number of"
      , Text
"picoseconds."
      ]
  , fieldPushValue :: LuaE e ()
fieldPushValue = Integer -> LuaE e ()
forall a e. (Integral a, Show a) => a -> LuaE e ()
pushIntegral Integer
CPUTime.cpuTimePrecision
  }

-- | Field containing the operating system on which the program is
-- running.
os :: Field e
os :: forall e. Field e
os = Field
  { fieldName :: Text
fieldName = Text
"os"
  , fieldType :: TypeSpec
fieldType = TypeSpec
"string"
  , fieldDescription :: Text
fieldDescription = Text
"The operating system on which the program is running."
  , fieldPushValue :: LuaE e ()
fieldPushValue = String -> LuaE e ()
forall e. String -> LuaE e ()
pushString String
Info.os
  }


--
-- Functions
--

-- | Access the CPU time, e.g. for benchmarking.
cputime :: LuaError e => DocumentedFunction e
cputime :: forall e. LuaError e => DocumentedFunction e
cputime = Name -> LuaE e Integer -> HsFnPrecursor e (LuaE e Integer)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"cputime"
  ### ioToLua CPUTime.getCPUTime
  HsFnPrecursor e (LuaE e Integer)
-> FunctionResults e Integer -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Pusher e Integer -> TypeSpec -> Text -> FunctionResults e Integer
forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult Pusher e Integer
forall a e. (Integral a, Show a) => a -> LuaE e ()
pushIntegral TypeSpec
"integer" Text
"CPU time in picoseconds"
  #? T.unlines
     [ "Returns the number of picoseconds CPU time used by the current"
     , "program. The precision of this result may vary in different"
     , "versions and on different platforms."
     ]

-- | Retrieve the entire environment
env :: LuaError e => DocumentedFunction e
env :: forall e. LuaError e => DocumentedFunction e
env = Name
-> LuaE e [(String, String)]
-> HsFnPrecursor e (LuaE e [(String, String)])
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"env"
  ### ioToLua Env.getEnvironment
  HsFnPrecursor e (LuaE e [(String, String)])
-> FunctionResults e [(String, String)] -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Pusher e [(String, String)]
-> TypeSpec -> Text -> FunctionResults e [(String, String)]
forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult (Pusher e String -> Pusher e String -> Pusher e [(String, String)]
forall e a b.
LuaError e =>
Pusher e a -> Pusher e b -> Pusher e [(a, b)]
pushKeyValuePairs Pusher e String
forall e. String -> LuaE e ()
pushString Pusher e String
forall e. String -> LuaE e ()
pushString) TypeSpec
"table"
        Text
"A table mapping environment variable names to their value."
  #? "Retrieves the entire environment as a string-indexed table."

-- | Return the current working directory as an absolute path.
getwd :: LuaError e => DocumentedFunction e
getwd :: forall e. LuaError e => DocumentedFunction e
getwd = Name -> LuaE e String -> HsFnPrecursor e (LuaE e String)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"getwd"
  ### ioToLua Directory.getCurrentDirectory
  HsFnPrecursor e (LuaE e String)
-> FunctionResults e String -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Text -> FunctionResults e String
forall e. Text -> [FunctionResult e String]
filepathResult Text
"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 :: forall e. LuaError e => DocumentedFunction e
getenv = Name
-> (String -> LuaE e (Maybe String))
-> HsFnPrecursor e (String -> LuaE e (Maybe String))
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"getenv"
  ### ioToLua . Env.lookupEnv
  HsFnPrecursor e (String -> LuaE e (Maybe String))
-> Parameter e String -> HsFnPrecursor e (LuaE e (Maybe String))
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e String -> TypeSpec -> Text -> Text -> Parameter e String
forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter Peeker e String
forall e. Peeker e String
peekString TypeSpec
"string" Text
"var" Text
"name of the environment"
  HsFnPrecursor e (LuaE e (Maybe String))
-> FunctionResults e (Maybe String) -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Pusher e (Maybe String)
-> TypeSpec -> Text -> FunctionResults e (Maybe String)
forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult (LuaE e () -> (String -> LuaE e ()) -> Pusher e (Maybe String)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe LuaE e ()
forall e. LuaE e ()
pushnil String -> LuaE e ()
forall e. String -> LuaE e ()
pushString) TypeSpec
"string or nil"
        Text
"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 :: forall e. LuaError e => DocumentedFunction e
ls = Name
-> (Maybe String -> LuaE e [String])
-> HsFnPrecursor e (Maybe String -> LuaE e [String])
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"ls"
  ### ioToLua . Directory.listDirectory . fromMaybe "."
  HsFnPrecursor e (Maybe String -> LuaE e [String])
-> Parameter e (Maybe String) -> HsFnPrecursor e (LuaE e [String])
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Parameter e String -> Parameter e (Maybe String)
forall e a. Parameter e a -> Parameter e (Maybe a)
opt (Text -> Text -> Parameter e String
forall e. Text -> Text -> Parameter e String
stringParam Text
"directory"
           (Text
"Path of the directory whose contents should be listed. "
            Text -> Text -> Text
`T.append` Text
"Defaults to `.`."))
  HsFnPrecursor e (LuaE e [String])
-> FunctionResults e [String] -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Pusher e [String] -> TypeSpec -> Text -> FunctionResults e [String]
forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult (Pusher e String -> Pusher e [String]
forall e a. LuaError e => Pusher e a -> [a] -> LuaE e ()
pushList Pusher e String
forall e. String -> LuaE e ()
pushString) TypeSpec
"table"
        (Text
"A table of all entries in `directory`, except for the "
          Text -> Text -> Text
`T.append` Text
"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 :: forall e. LuaError e => DocumentedFunction e
mkdir = Name
-> (String -> Maybe Bool -> LuaE e ())
-> HsFnPrecursor e (String -> Maybe Bool -> LuaE e ())
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"mkdir"
  ### (\fp createParent ->
         if createParent == Just True
         then ioToLua (Directory.createDirectoryIfMissing True fp)
         else ioToLua (Directory.createDirectory fp))
  HsFnPrecursor e (String -> Maybe Bool -> LuaE e ())
-> Parameter e String -> HsFnPrecursor e (Maybe Bool -> LuaE e ())
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Text -> Text -> Parameter e String
forall e. Text -> Text -> Parameter e String
filepathParam Text
"dirname" Text
"name of the new directory"
  HsFnPrecursor e (Maybe Bool -> LuaE e ())
-> Parameter e (Maybe Bool) -> HsFnPrecursor e (LuaE e ())
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Parameter e Bool -> Parameter e (Maybe Bool)
forall e a. Parameter e a -> Parameter e (Maybe a)
opt (Text -> Text -> Parameter e Bool
forall e. Text -> Text -> Parameter e Bool
boolParam Text
"create_parent" Text
"create parent directory if necessary")
  HsFnPrecursor e (LuaE e ())
-> FunctionResults e () -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> []
  #? 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 :: forall e. LuaError e => DocumentedFunction e
rmdir = Name
-> (String -> Maybe Bool -> LuaE e ())
-> HsFnPrecursor e (String -> Maybe Bool -> LuaE e ())
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"rmdir"
  ### (\fp recursive ->
         if recursive == Just True
         then ioToLua (Directory.removeDirectoryRecursive fp)
         else ioToLua (Directory.removeDirectory fp))
  HsFnPrecursor e (String -> Maybe Bool -> LuaE e ())
-> Parameter e String -> HsFnPrecursor e (Maybe Bool -> LuaE e ())
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Text -> Text -> Parameter e String
forall e. Text -> Text -> Parameter e String
filepathParam Text
"dirname" Text
"name of the directory to delete"
  HsFnPrecursor e (Maybe Bool -> LuaE e ())
-> Parameter e (Maybe Bool) -> HsFnPrecursor e (LuaE e ())
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Parameter e Bool -> Parameter e (Maybe Bool)
forall e a. Parameter e a -> Parameter e (Maybe a)
opt (Text -> Text -> Parameter e Bool
forall e. Text -> Text -> Parameter e Bool
boolParam Text
"recursive" Text
"delete content recursively")
  HsFnPrecursor e (LuaE e ())
-> FunctionResults e () -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> []
  #?("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 :: forall e. LuaError e => DocumentedFunction e
setenv = Name
-> (String -> String -> LuaE e ())
-> HsFnPrecursor e (String -> String -> LuaE e ())
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"setenv"
  ### (\name value -> ioToLua (Env.setEnv name value))
  HsFnPrecursor e (String -> String -> LuaE e ())
-> Parameter e String -> HsFnPrecursor e (String -> LuaE e ())
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e String -> TypeSpec -> Text -> Text -> Parameter e String
forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter Peeker e String
forall e. Peeker e String
peekString TypeSpec
"string" Text
"name"
        Text
"name of the environment variable"
  HsFnPrecursor e (String -> LuaE e ())
-> Parameter e String -> HsFnPrecursor e (LuaE e ())
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e String -> TypeSpec -> Text -> Text -> Parameter e String
forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter Peeker e String
forall e. Peeker e String
peekString TypeSpec
"string" Text
"value" Text
"new value"
  HsFnPrecursor e (LuaE e ())
-> FunctionResults e () -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> []
  #? "Set the specified environment variable to a new value."

-- | Change current working directory.
setwd :: LuaError e => DocumentedFunction e
setwd :: forall e. LuaError e => DocumentedFunction e
setwd = Name
-> (String -> LuaE e ()) -> HsFnPrecursor e (String -> LuaE e ())
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"setwd"
  ### ioToLua . Directory.setCurrentDirectory
  HsFnPrecursor e (String -> LuaE e ())
-> Parameter e String -> HsFnPrecursor e (LuaE e ())
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Text -> Text -> Parameter e String
forall e. Text -> Text -> Parameter e String
filepathParam Text
"directory" Text
"Path of the new working directory"
  HsFnPrecursor e (LuaE e ())
-> FunctionResults e () -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> []
  #? "Change the working directory to the given path."

-- | Get the current directory for temporary files.
tmpdirname :: LuaError e => DocumentedFunction e
tmpdirname :: forall e. LuaError e => DocumentedFunction e
tmpdirname = Name -> LuaE e String -> HsFnPrecursor e (LuaE e String)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"tmpdirname"
  ### ioToLua Directory.getTemporaryDirectory
  HsFnPrecursor e (LuaE e String)
-> FunctionResults e String -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Pusher e String -> TypeSpec -> Text -> FunctionResults e String
forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult Pusher e String
forall e. String -> LuaE e ()
pushString TypeSpec
"string"
        Text
"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 :: forall e. LuaError e => DocumentedFunction e
with_wd = Name
-> (String -> Callback -> LuaE e NumResults)
-> HsFnPrecursor e (String -> Callback -> LuaE e NumResults)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"with_wd"
  ### (\fp callback ->
        bracket (Lua.liftIO Directory.getCurrentDirectory)
                (Lua.liftIO . Directory.setCurrentDirectory)
        (\_ -> do
              Lua.liftIO (Directory.setCurrentDirectory fp)
              callback `invokeWithFilePath` fp))
  HsFnPrecursor e (String -> Callback -> LuaE e NumResults)
-> Parameter e String
-> HsFnPrecursor e (Callback -> LuaE e NumResults)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Text -> Text -> Parameter e String
forall e. Text -> Text -> Parameter e String
filepathParam Text
"directory"
        Text
"Directory in which the given `callback` should be executed"
  HsFnPrecursor e (Callback -> LuaE e NumResults)
-> Parameter e Callback -> HsFnPrecursor e (LuaE e NumResults)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e Callback
-> TypeSpec -> Text -> Text -> Parameter e Callback
forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter Peeker e Callback
forall e. Peeker e Callback
peekCallback TypeSpec
"function" Text
"callback"
        Text
"Action to execute in the given directory"
  HsFnPrecursor e (LuaE e NumResults) -> Text -> DocumentedFunction e
forall e.
HsFnPrecursor e (LuaE e NumResults) -> Text -> DocumentedFunction e
=?> Text
"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 :: forall e. LuaError e => DocumentedFunction e
with_env = Name
-> ([(String, String)] -> Callback -> LuaE e NumResults)
-> HsFnPrecursor
     e ([(String, String)] -> Callback -> LuaE e NumResults)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"with_env"
  ### (\environment callback ->
        bracket (Lua.liftIO Env.getEnvironment)
                setEnvironment
                (\_ -> setEnvironment environment *> invoke callback))
  HsFnPrecursor
  e ([(String, String)] -> Callback -> LuaE e NumResults)
-> Parameter e [(String, String)]
-> HsFnPrecursor e (Callback -> LuaE e NumResults)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e [(String, String)]
-> TypeSpec -> Text -> Text -> Parameter e [(String, String)]
forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter (Peeker e String -> Peeker e String -> Peeker e [(String, String)]
forall e a b.
LuaError e =>
Peeker e a -> Peeker e b -> Peeker e [(a, b)]
peekKeyValuePairs Peeker e String
forall e. Peeker e String
peekString Peeker e String
forall e. Peeker e String
peekString) TypeSpec
"table"
        Text
"environment"
        (Text
"Environment variables and their values to be set before "
         Text -> Text -> Text
`T.append` Text
"running `callback`")
  HsFnPrecursor e (Callback -> LuaE e NumResults)
-> Parameter e Callback -> HsFnPrecursor e (LuaE e NumResults)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e Callback
-> TypeSpec -> Text -> Text -> Parameter e Callback
forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter Peeker e Callback
forall e. Peeker e Callback
peekCallback TypeSpec
"function" Text
"callback"
        Text
"Action to execute in the custom environment"
  HsFnPrecursor e (LuaE e NumResults) -> Text -> DocumentedFunction e
forall e.
HsFnPrecursor e (LuaE e NumResults) -> Text -> DocumentedFunction e
=?> Text
"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 :: t (String, String) -> m ()
setEnvironment t (String, String)
newEnv = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
Lua.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    -- Crude, but fast enough: delete all entries in new environment,
    -- then restore old environment one-by-one.
    [(String, String)]
curEnv <- IO [(String, String)]
Env.getEnvironment
    [(String, String)] -> ((String, String) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(String, String)]
curEnv (String -> IO ()
Env.unsetEnv (String -> IO ())
-> ((String, String) -> String) -> (String, String) -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, String) -> String
forall a b. (a, b) -> a
fst)
    t (String, String) -> ((String, String) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ t (String, String)
newEnv ((String -> String -> IO ()) -> (String, String) -> IO ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry String -> String -> IO ()
Env.setEnv)

with_tmpdir :: LuaError e => DocumentedFunction e
with_tmpdir :: forall e. LuaError e => DocumentedFunction e
with_tmpdir = Name
-> (Maybe String -> String -> Callback -> LuaE e NumResults)
-> HsFnPrecursor
     e (Maybe String -> String -> Callback -> LuaE e NumResults)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"with_tmpdir"
  ### (\mParentDir tmpl callback -> case mParentDir of
          Nothing -> do
            Temp.withSystemTempDirectory tmpl $
              invokeWithFilePath callback
          Just parentDir -> do
            Temp.withTempDirectory parentDir tmpl $
              invokeWithFilePath callback)
  HsFnPrecursor
  e (Maybe String -> String -> Callback -> LuaE e NumResults)
-> Parameter e (Maybe String)
-> HsFnPrecursor e (String -> Callback -> LuaE e NumResults)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e (Maybe String)
-> TypeSpec -> Text -> Text -> Parameter e (Maybe String)
forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter Peeker e (Maybe String)
forall {e}. StackIndex -> Peek e (Maybe String)
peekParentDir TypeSpec
"string" Text
"parent_dir"
        ([Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
         [ Text
"Parent directory to create the directory in. If this "
         , Text
"parameter is omitted, the system's canonical temporary "
         , Text
"directory is used."
         ])
  HsFnPrecursor e (String -> Callback -> LuaE e NumResults)
-> Parameter e String
-> HsFnPrecursor e (Callback -> LuaE e NumResults)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Text -> Text -> Parameter e String
forall e. Text -> Text -> Parameter e String
stringParam Text
"templ" Text
"Directory name template."
  HsFnPrecursor e (Callback -> LuaE e NumResults)
-> Parameter e Callback -> HsFnPrecursor e (LuaE e NumResults)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e Callback
-> TypeSpec -> Text -> Text -> Parameter e Callback
forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter Peeker e Callback
forall e. Peeker e Callback
peekCallback TypeSpec
"function" Text
"callback"
        (Text
"Function which takes the name of the temporary directory as "
         Text -> Text -> Text
`T.append` Text
"its first argument.")
  HsFnPrecursor e (LuaE e NumResults) -> Text -> DocumentedFunction e
forall e.
HsFnPrecursor e (LuaE e NumResults) -> Text -> DocumentedFunction e
=?> Text
"The results of the call to `callback`."
  #? T.unlines
     [ "Create and use a temporary directory inside the given directory."
     , "The directory is deleted after the callback returns."
     ]
  where
    peekParentDir :: StackIndex -> Peek e (Maybe String)
peekParentDir StackIndex
idx = do
      StackIndex
args <- LuaE e StackIndex -> Peek e StackIndex
forall e a. LuaE e a -> Peek e a
liftLua LuaE e StackIndex
forall e. LuaE e StackIndex
gettop
      if StackIndex
args StackIndex -> StackIndex -> Bool
forall a. Ord a => a -> a -> Bool
< StackIndex
3
        then LuaE e (Maybe String) -> Peek e (Maybe String)
forall e a. LuaE e a -> Peek e a
liftLua (LuaE e (Maybe String) -> Peek e (Maybe String))
-> LuaE e (Maybe String) -> Peek e (Maybe String)
forall a b. (a -> b) -> a -> b
$ do
          LuaE e ()
forall e. LuaE e ()
pushnil
          StackIndex -> LuaE e ()
forall e. StackIndex -> LuaE e ()
insert StackIndex
idx
          Maybe String -> LuaE e (Maybe String)
forall a. a -> LuaE e a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing
        else String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> Peek e String -> Peek e (Maybe String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Peeker e String
forall e. Peeker e String
peekString StackIndex
idx


--
-- Parameters
--

-- | Filepath function parameter.
filepathParam :: Text  -- ^ name
              -> Text  -- ^ description
              -> Parameter e FilePath
filepathParam :: forall e. Text -> Text -> Parameter e String
filepathParam = Text -> Text -> Parameter e String
forall e. Text -> Text -> Parameter e String
stringParam

-- | Result of a function returning a file path.
filepathResult :: Text -- ^ Description
               -> [FunctionResult e FilePath]
filepathResult :: forall e. Text -> [FunctionResult e String]
filepathResult = Pusher e String -> TypeSpec -> Text -> FunctionResults e String
forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult Pusher e String
forall e. String -> LuaE e ()
pushString TypeSpec
"string"