core-program 0.6.7.1 → 0.6.8.0

raw patch · 3 files changed

+130/−3 lines, 3 filesdep +processPVP ok

version bump matches the API change (PVP)

Dependencies added: process

API changes (from Hackage documentation)

Files

• core-program.cabal +2/−1
• lib/Core/Program/Execute.hs +84/−0
• lib/Core/Program/Threads.hs +44/−2

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           core-program-version:        0.6.7.1+version:        0.6.8.0 synopsis:       Opinionated Haskell Interoperability description:    A library to help build command-line programs, both tools and                 longer-running daemons.@@ -68,6 +68,7 @@     , hourglass     , mtl     , prettyprinter >=1.6.2+    , process     , safe-exceptions     , stm     , template-haskell >=2.14 && <3

@@ -93,6 +93,7 @@        -- * Running processes     , readProcess+    , callProcess     , execProcess_        -- * Internals@@ -140,6 +141,7 @@ import Control.Exception qualified as Base (throwIO) import Control.Exception.Safe qualified as Safe     ( catch+    , onException     , throw     ) import Control.Monad@@ -178,8 +180,17 @@     ( findExecutable     ) import System.Exit (ExitCode (..))+import System.IO qualified as Base (IOMode (ReadMode), hClose, openFile) import System.Posix.Internals (hostIsThreaded) import System.Posix.Process qualified as Posix (executeFile, exitImmediately)+import System.Process qualified as Base+    ( CreateProcess (std_err, std_in, std_out)+    , StdStream (Inherit, UseHandle)+    , createProcess+    , proc+    , terminateProcess+    , waitForProcess+    ) import System.Process.Typed qualified as Typed (nullStream, proc, readProcess, setStdin) import Prelude hiding (log) @@ -783,6 +794,79 @@                 -- does not return                 _ <- Posix.executeFile cmd' True args' Nothing                 pure ()++{- |+Execute an external child process and wait for it to finish. The command is+specified first and and subsequent arguments as elements of the list. This+helper then logs the command being executed to the debug output, which can be+useful when you're trying to find out what exactly what program is being+invoked.++The output of the child process (its @stdout@) will go to the terminal console+independently of your parent process's output. If your Haskell program does+anything concurrently then anything it 'Core.Program.Logging.write's will be+interleaved and probably make a mess of the child's output. So don't do that.++See the similar 'readProcess' for an action which executes an external program+but which returns its output.++If the thread invoking 'callProcess' receives an interrupting asynchronous+exception then it will terminate the child, waiting for it to exit.++(this wraps __typed-process__'s 'System.Process.Typed.runProcess' but follows+the naming convention of the underlying 'System.Process.callProcess' code from+__process__.)++@since 0.6.8+-}+callProcess :: [Rope] -> Program τ ExitCode+callProcess [] = error "No command provided"+callProcess (cmd : args) = do+    let cmd' = fromRope cmd+    let args' = fmap fromRope args+    let task1 = Base.proc cmd' args'++    let command = mconcat (List.intersperse (singletonRope ' ') (cmd : args))+    debug "command" command++    probe <- liftIO $ do+        findExecutable cmd'++    case probe of+        Nothing -> do+            Safe.throw (CommandNotFound cmd)+        Just _ -> do+            liftIO $ do+                i <- Base.openFile "/dev/null" Base.ReadMode++                let task2 =+                        task1+                            { Base.std_in = Base.UseHandle i+                            , Base.std_out = Base.Inherit+                            , Base.std_err = Base.Inherit+                            }++                (_, _, _, p) <- Base.createProcess task2++                Safe.onException+                    ( do+                        exit <- Base.waitForProcess p+                        Base.hClose i+                        pure exit+                    )+                    ( do+                        --+                        -- To avoid defunct zombie processes, you have to+                        -- wait() on the process and read its exit code. In+                        -- normal circumstances this happens because we are+                        -- _waiting_ but in abnormal circumstances where we+                        -- are forcing the child, we have to wait for the OS+                        -- to give us an exit code.+                        --+                        Base.terminateProcess p+                        _ <- Base.waitForProcess p+                        Base.hClose i+                    )  {- | Reset the start time (used to calculate durations shown in event- and

@@ -44,10 +44,11 @@       -- * Internals     , Thread     , unThread+    , Terminator (..)     ) where  import Control.Concurrent (ThreadId, forkIO, killThread)-import Control.Concurrent.MVar (MVar, newEmptyMVar, newMVar, putMVar, readMVar)+import Control.Concurrent.MVar (MVar, newEmptyMVar, newMVar, putMVar, readMVar, tryPutMVar) import Control.Concurrent.STM (atomically) import Control.Concurrent.STM.TVar (modifyTVar', newTVarIO, readTVarIO) import Control.Exception.Safe qualified as Safe (catch, finally, onException, throw)@@ -354,6 +355,14 @@ {- | Cancel a thread. +Be careful when using this. If you are planning cancel a worker thread then+the main thread that is 'waitThread'ing on it will /throw an exception/,+specifically 'ThreadCancelled' (unless something else has already thrown an+exception in which case /that/ will be thrown instead). In this scenario you+will need to 'Core.Program.Exceptions.catch' around your waiting function+otherwise the uncaught exception will continue to unwind your execution stack+and probably end your program.+ (this wraps __base__\'s 'Control.Concurrent.killThread'. The underlying mechanism used is to throw the 'GHC.Conc.ThreadKilled' exception to the other thread. That exception is asynchronous, so will not be trapped by a@@ -365,7 +374,40 @@ cancelThread :: Thread α -> Program τ () cancelThread thread = do     liftIO $ do-        killThread (threadPointerOf thread)+        --+        -- There are some curiosities about what happens here. Someone+        -- waitThread'ing on a Thread is blocked on reading the outcome MVar.+        -- so to break that wait we put the Left value in. If the thread was+        -- already dead this has no effect, but if not, then this will+        -- initiate it rapidly being killing off.+        --+        let outcome = threadOutcomeOf thread+        result <- tryPutMVar outcome (Left (toException ThreadCancelled))+        case result of+            False -> do+                pure ()+            True -> do+                killThread (threadPointerOf thread)++{- |+When a thread is aborted with 'cancelThread' this value is used to mark a+failed computation inside the 'Thread'. Although it is not the mechanism used+internally to kill the computation, it /is/ the exception that is subsequently+rethrown from 'waitThread' if you are waiting on that thread to finish,+allowing you to 'Core.Program.Exceptions.catch' the case of a thread being+cancelled if necessary.++This is mostly here to differentiate from 'Control.Exception.ThreadKilled',+giving you some knowledge as to whether it was your explicit 'cancelThread'+that ended the thread, or something else. You need to handle it either way,+but sometimes you want to know the difference.++@since 0.6.8+-}+data Terminator = ThreadCancelled+    deriving (Show)++instance Exception Terminator  {- | Fork two threads and wait for both to finish. The return value is the pair of