💥 Crashing

a6/src/SPC.hs

@@ -32,6 +32,7 @@ import Control.Concurrent
     readChan,
     ThreadId
   )
+import Control.Exception (SomeException, catch)
 import Control.Monad (ap, forever, liftM, void, filterM, when)
 import GenServer
 import System.Clock.Seconds (Clock (Monotonic), Seconds, getTime)
@@ -121,7 +122,8 @@ data SPCMsg
     MsgAddWorker WorkerName Worker
   | -- | Worker finished job
     MsgJobDone JobId
-  -- | MsgDebug (ReplyChan SPCState)
+  | -- | Crashed
+    MsgJobCrashed JobId
 
 -- | A handle to the SPC instance.
 data SPC = SPC (Server SPCMsg)
@@ -287,6 +289,12 @@ handleMsg c = do
                 spcJobsDone = (jobid, DoneCancelled) : spcJobsDone state
               }
         _ -> pure ()
+    MsgJobCrashed jobid -> do
+      state <- get
+      case (lookup jobid $ spcJobsRunning state) of
+        Just (_, _, _) -> do
+          jobDone jobid DoneCrashed
+        Nothing -> pure ()
     _ -> pure ()
 
 startSPC :: IO SPC
@@ -375,8 +383,13 @@ workerLoop c m = forever $ do
     -- stuff happening here
     MsgStartJob action jobid rsvp -> do
       t <- forkIO $ do
+        let doJob = do
               action
               sendTo c $ MsgJobDone jobid
+            onException :: SomeException -> IO ()
+            onException _ =
+              sendTo c $ MsgJobCrashed jobid
+        doJob `catch` onException
       reply rsvp t
 
 -- | Shut down a running worker. No effect if the worker is already

a6/src/SPC_Tests.hs

@@ -129,6 +129,22 @@ tests =
           r2 <- jobWait spc j2
           r2 @?= Done
 
+          x <- readIORef ref
+          x @?= True,
+        testCase "Crash" $ do
+          ref <- newIORef False
+          spc <- startSPC
+          w <- workerAdd spc "C1-10P"
+          isRight w @?= True
+
+          j1 <- jobAdd spc $ Job (error "boom") 1
+          r1 <- jobWait spc j1
+          r1 @?= DoneCrashed
+
+          -- Ensure new jobs can still work.
+          j2 <- jobAdd spc $ Job (writeIORef ref True) 1
+          r2 <- jobWait spc j2
+          r2 @?= Done
           x <- readIORef ref
           x @?= True
       ]