diff --git a/LICENCE b/LICENCE --- a/LICENCE +++ b/LICENCE @@ -1,4 +1,4 @@ -Copyright (c) 2017,2018, Commonwealth Scientific and Industrial Research Organisation +Copyright (c) 2019-2025 Tony Morris (CSIRO) ABN 41 687 119 230. All rights reserved. diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,3 +1,8 @@ +0.1.0.10 + +* moved to gitlab +* minor updates to code + 0.1.0.9 * add exceptions to `Process` functions diff --git a/exitcode.cabal b/exitcode.cabal --- a/exitcode.cabal +++ b/exitcode.cabal @@ -1,28 +1,28 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: exitcode -version: 0.1.0.9 +version: 0.1.0.10 synopsis: Monad transformer for exit codes description: - <> - . Monad transformer for exit codes + . + <> license: BSD3 license-file: LICENCE author: Queensland Functional Programming Lab maintainer: Tony Morris -copyright: Copyright (C) 2019-2022 Tony Morris +copyright: Copyright (C) 2019-2025 Tony Morris category: Control build-type: Simple extra-source-files: changelog.md cabal-version: >=1.10 -homepage: https://github.com/system-f/exitcode -bug-reports: https://github.com/system-f/exitcode/issues -tested-with: GHC == 7.10.3, GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.3, GHC == 8.6.1 +homepage: https://gitlab.com/system-f/code/exitcode +bug-reports: https://gitlab.com/system-f/code/exitcode/issues +tested-with: GHC == 7.10.3, GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.3, GHC == 8.6.1, GHC == 9.4.8, GHC == 9.6.7 source-repository head type: git - location: git@github.com:system-f/exitcode.git + location: git@gitlab.com:system-f/code/exitcode.git library exposed-modules: Control.Exitcode diff --git a/src/Control/Exitcode.hs b/src/Control/Exitcode.hs --- a/src/Control/Exitcode.hs +++ b/src/Control/Exitcode.hs @@ -466,7 +466,7 @@ instance Monad f => Monad (ExitcodeT f e) where return = - ExitcodeT . return . return + pure ExitcodeT x >>= f = ExitcodeT (x >>= either (pure . Left) (runExitcodeT . f)) diff --git a/src/Control/Process/CreateProcess.hs b/src/Control/Process/CreateProcess.hs --- a/src/Control/Process/CreateProcess.hs +++ b/src/Control/Process/CreateProcess.hs @@ -34,74 +34,74 @@ class HasCreateProcess a where create_process :: Lens' a CreateProcess + {-# INLINE child_group #-} child_group :: Lens' a (Maybe GroupID) - {-# INLINE child_group #-} child_group = create_process . child_group + {-# INLINE child_user #-} child_user :: Lens' a (Maybe UserID) - {-# INLINE child_user #-} child_user = create_process . child_user + {-# INLINE close_fds #-} close_fds :: Lens' a Bool - {-# INLINE close_fds #-} close_fds = create_process . close_fds + {-# INLINE create_group #-} create_group :: Lens' a Bool - {-# INLINE create_group #-} create_group = create_process . create_group + {-# INLINE create_new_console #-} create_new_console :: Lens' a Bool - {-# INLINE create_new_console #-} create_new_console = create_process . create_new_console + {-# INLINE cwd #-} cwd :: Lens' a (Maybe FilePath) - {-# INLINE cwd #-} cwd = create_process . cwd + {-# INLINE delegate_ctlc #-} delegate_ctlc :: Lens' a Bool - {-# INLINE delegate_ctlc #-} delegate_ctlc = create_process . delegate_ctlc + {-# INLINE detach_console #-} detach_console :: Lens' a Bool - {-# INLINE detach_console #-} detach_console = create_process . detach_console + {-# INLINE env #-} env :: Lens' a (Maybe [(String, String)]) - {-# INLINE env #-} env = create_process . env + {-# INLINE new_session #-} new_session :: Lens' a Bool - {-# INLINE new_session #-} new_session = create_process . new_session + {-# INLINE std_err #-} std_err :: Lens' a StdStream - {-# INLINE std_err #-} std_err = create_process . std_err + {-# INLINE std_in #-} std_in :: Lens' a StdStream - {-# INLINE std_in #-} std_in = create_process . std_in + {-# INLINE std_out #-} std_out :: Lens' a StdStream - {-# INLINE std_out #-} std_out = create_process . std_out + {-# INLINE use_process_jobs #-} use_process_jobs :: Lens' a Bool - {-# INLINE use_process_jobs #-} use_process_jobs = create_process . use_process_jobs @@ -196,7 +196,7 @@ std_out f (CreateProcess csc cw en sti sto ste clf crg dct dcl cnc nss chg chu upj) = fmap (\sto' -> CreateProcess csc cw en sti sto' ste clf crg dct dcl cnc nss chg chu upj) (f sto) use_process_jobs f (CreateProcess csc cw en sti sto ste clf crg dct dcl cnc nss chg chu upj) = - fmap (\upj' -> CreateProcess csc cw en sti sto ste clf crg dct dcl cnc nss chg chu upj') (f upj) + fmap (CreateProcess csc cw en sti sto ste clf crg dct dcl cnc nss chg chu) (f upj) class AsCreateProcess a where _CreateProcess :: diff --git a/src/Control/Process/Process.hs b/src/Control/Process/Process.hs --- a/src/Control/Process/Process.hs +++ b/src/Control/Process/Process.hs @@ -57,25 +57,50 @@ ) import qualified System.Process as P(readCreateProcessWithExitCode, readProcessWithExitCode, waitForProcess, getProcessExitCode) +-- | @readCreateProcessWithExitCode@ works exactly like 'readProcessWithExitCode' except that it +-- lets you pass 'CreateProcess' giving better flexibility. +-- +-- Note that @Handle@s provided for @std_in@, @std_out@, or @std_err@ via the CreateProcess +-- record will be ignored. readCreateProcessWithExitCode :: Exception e' => CreateProcess - -> String - -> ExitcodeT (ExceptT e' IO) (String, String) (String, String) + -> String -- ^ standard input + -> ExitcodeT (ExceptT e' IO) (String, String) (String, String) -- ^ exitcode, stdout, stderr readCreateProcessWithExitCode p a = tryExitcode (liftExitcode (P.readCreateProcessWithExitCode p a)) >>= \(x, y, z) -> hoistExitcode (pure . runIdentity) (set _Exitcode1 (y, z) (fromExitCode' x)) readProcessWithExitCode :: Exception e' => - FilePath - -> [String] - -> String - -> ExitcodeT (ExceptT e' IO) (String, String) (String, String) + FilePath -- ^ Filename of the executable (see 'RawCommand' for details) + -> [String] -- ^ any arguments + -> String -- ^ standard input + -> ExitcodeT (ExceptT e' IO) (String, String) (String, String) -- ^ exitcode, stdout, stderr readProcessWithExitCode p a i = tryExitcode (liftExitcode (P.readProcessWithExitCode p a i)) >>= \(x, y, z) -> hoistExitcode (pure . runIdentity) (set _Exitcode1 (y, z) (fromExitCode' x)) +{- | Waits for the specified process to terminate, and returns its exit code. +On Unix systems, may throw 'UserInterrupt' when using 'delegate_ctlc'. + +GHC Note: in order to call @waitForProcess@ without blocking all the +other threads in the system, you must compile the program with +@-threaded@. + +Note that it is safe to call @waitForProcess@ for the same process in multiple +threads. When the process ends, threads blocking on this call will wake in +FIFO order. When using 'delegate_ctlc' and the process is interrupted, only +the first waiting thread will throw 'UserInterrupt'. + +(/Since: 1.2.0.0/) On Unix systems, a negative value @'ExitFailure' -/signum/@ +indicates that the child was terminated by signal @/signum/@. +The signal numbers are platform-specific, so to test for a specific signal use +the constants provided by "System.Posix.Signals" in the @unix@ package. +Note: core dumps are not reported, use "System.Posix.Process" if you need this +detail. + +-} waitForProcess :: Exception e' => ProcessHandle @@ -84,6 +109,15 @@ tryExitcode (liftExitcode (P.waitForProcess h)) >>= \x -> hoistExitcode (pure . runIdentity) (fromExitCode' x) +{- | +This is a non-blocking version of 'waitForProcess'. If the process is +still running, 'Nothing' is returned. If the process has exited, then +@'Just' e@ is returned where @e@ is the exit code of the process. + +On Unix systems, see 'waitForProcess' for the meaning of exit codes +when the process died as the result of a signal. May throw +'UserInterrupt' when using 'delegate_ctlc'. +-} getProcessExitCode :: Exception e' => ProcessHandle @@ -92,6 +126,15 @@ liftTryExitcode (P.getProcessExitCode h) >>= maybe (pure Nothing) (hoistExitcode (pure . runIdentity) . set _Exitcode1 (Just ()) . fromExitCode') +{- | +This is a non-blocking version of 'waitForProcess'. If the process is +still running, 'Nothing' is returned. If the process has exited, then +@'Just' e@ is returned where @e@ is the exit code of the process. + +On Unix systems, see 'waitForProcess' for the meaning of exit codes +when the process died as the result of a signal. May throw +'UserInterrupt' when using 'delegate_ctlc'. +-} getProcessExitCodeBool :: Exception e' => ProcessHandle