Merge pull request #197 from istathar/fix-racing-threads

Re-throw exceptions when racing threads
aesiniath · Jun 27, 2023 · bb299b3 · bb299b3
2 parents d52ac49 + 6b88e95
commit bb299b3
Show file tree

Hide file tree

Showing 10 changed files with 44 additions and 26 deletions.
diff --git a/core-data/core-data.cabal b/core-data/core-data.cabal
@@ -1,6 +1,6 @@
 cabal-version: 1.12
 
--- This file has been generated from package.yaml by hpack version 0.35.1.
+-- This file has been generated from package.yaml by hpack version 0.35.2.
 --
 -- see: https://github.com/sol/hpack
 
@@ -26,7 +26,7 @@ license:        MIT
 license-file:   LICENSE
 build-type:     Simple
 tested-with:
-    GHC == 8.10.7, GHC == 9.2.5
+    GHC == 8.10.7, GHC == 9.2.7, GHC == 9.4.5
 
 source-repository head
   type: git

diff --git a/core-effect-effectful/core-effect-effectful.cabal b/core-effect-effectful/core-effect-effectful.cabal
@@ -1,6 +1,6 @@
 cabal-version: 1.12
 
--- This file has been generated from package.yaml by hpack version 0.35.1.
+-- This file has been generated from package.yaml by hpack version 0.35.2.
 --
 -- see: https://github.com/sol/hpack
 
@@ -26,7 +26,7 @@ license:        MIT
 license-file:   LICENSE
 build-type:     Simple
 tested-with:
-    GHC == 9.2.5
+    GHC == 9.2.7, GHC == 9.4.5
 
 source-repository head
   type: git

diff --git a/core-program/core-program.cabal b/core-program/core-program.cabal
@@ -5,7 +5,7 @@ cabal-version: 1.12
 -- see: https://github.com/sol/hpack
 
 name:           core-program
-version:        0.6.9.2
+version:        0.6.9.3
 synopsis:       Opinionated Haskell Interoperability
 description:    A library to help build command-line programs, both tools and
                 longer-running daemons.
@@ -27,7 +27,7 @@ license:        MIT
 license-file:   LICENSE
 build-type:     Simple
 tested-with:
-    GHC == 8.10.7, GHC == 9.2.7
+    GHC == 8.10.7, GHC == 9.2.7, GHC == 9.4.5
 
 source-repository head
   type: git

diff --git a/core-program/lib/Core/Program/Threads.hs b/core-program/lib/Core/Program/Threads.hs
@@ -62,6 +62,7 @@ import Control.Monad
 import Control.Monad.Reader.Class (MonadReader (ask))
 import Core.Data.Structures
 import Core.Program.Context
+import Core.Program.Exceptions
 import Core.Program.Execute
 import Core.Program.Logging
 import Core.System.Base
@@ -479,19 +480,37 @@ raceThreads one two = do
         outcome <- liftIO $ do
             newEmptyMVar
 
-        _ <- forkThread $ do
-            !result1 <- one
-            liftIO $ do
-                putMVar outcome (Left result1)
+        t1 <- forkThread $ do
+            finally
+                ( do
+                    one
+                )
+                ( do
+                    liftIO $ do
+                        putMVar outcome (Left ())
+                )
 
-        _ <- forkThread $ do
-            !result2 <- two
-            liftIO $ do
-                putMVar outcome (Right result2)
+        t2 <- forkThread $ do
+            finally
+                ( do
+                    two
+                )
+                ( do
+                    liftIO $ do
+                        putMVar outcome (Right ())
+                )
 
-        liftIO $ do
+        result <- liftIO $ do
             readMVar outcome
 
+        case result of
+            Left _ -> do
+                result1 <- waitThread t1
+                pure (Left result1)
+            Right _ -> do
+                result2 <- waitThread t2
+                pure (Right result2)
+
 {- |
 Fork two threads and race them against each other. When one action completes
 the other will be cancelled with an exception. This is useful for enforcing
@@ -515,7 +534,7 @@ linkThread :: Thread α -> Program τ ()
 linkThread _ = pure ()
 {-# DEPRECATED linkThread "Exceptions are bidirectional so linkThread no longer needed" #-}
 
-{-|
+{- |
 If a timeout is exceeded this exception will be thrown by 'timeoutThread'.
 
 @since 0.6.9

diff --git a/core-program/package.yaml b/core-program/package.yaml
@@ -1,5 +1,5 @@
 name: core-program
-version: 0.6.9.2
+version: 0.6.9.3
 synopsis: Opinionated Haskell Interoperability
 description: |
   A library to help build command-line programs, both tools and

diff --git a/core-telemetry/core-telemetry.cabal b/core-telemetry/core-telemetry.cabal
@@ -28,7 +28,7 @@ license:        MIT
 license-file:   LICENSE
 build-type:     Simple
 tested-with:
-    GHC == 8.10.7, GHC == 9.2.7
+    GHC == 8.10.7, GHC == 9.2.7, GHC == 9.4.5
 extra-doc-files:
     HoneycombTraceExample.png
     honeycomb-sad-trace.png

diff --git a/core-text/core-text.cabal b/core-text/core-text.cabal
@@ -1,6 +1,6 @@
 cabal-version: 1.18
 
--- This file has been generated from package.yaml by hpack version 0.35.1.
+-- This file has been generated from package.yaml by hpack version 0.35.2.
 --
 -- see: https://github.com/sol/hpack
 
@@ -32,7 +32,7 @@ license:        MIT
 license-file:   LICENSE
 build-type:     Simple
 tested-with:
-    GHC == 8.10.7, GHC == 9.2.5
+    GHC == 8.10.7, GHC == 9.2.7, GHC == 9.4.5
 extra-doc-files:
     AnsiColours.png
 

diff --git a/core-webserver-servant/core-webserver-servant.cabal b/core-webserver-servant/core-webserver-servant.cabal
@@ -1,6 +1,6 @@
 cabal-version: 1.12
 
--- This file has been generated from package.yaml by hpack version 0.35.1.
+-- This file has been generated from package.yaml by hpack version 0.35.2.
 --
 -- see: https://github.com/sol/hpack
 
@@ -24,7 +24,7 @@ license:        MIT
 license-file:   LICENSE
 build-type:     Simple
 tested-with:
-    GHC == 8.10.7, GHC == 9.2.5
+    GHC == 8.10.7, GHC == 9.2.7, GHC == 9.4.5
 
 source-repository head
   type: git

diff --git a/core-webserver-warp/core-webserver-warp.cabal b/core-webserver-warp/core-webserver-warp.cabal
@@ -1,6 +1,6 @@
 cabal-version: 1.12
 
--- This file has been generated from package.yaml by hpack version 0.35.1.
+-- This file has been generated from package.yaml by hpack version 0.35.2.
 --
 -- see: https://github.com/sol/hpack
 
@@ -24,7 +24,7 @@ license:        MIT
 license-file:   LICENSE
 build-type:     Simple
 tested-with:
-    GHC == 8.10.7, GHC == 9.2.5
+    GHC == 8.10.7, GHC == 9.2.7, GHC == 9.4.5
 
 source-repository head
   type: git

diff --git a/unbeliever.cabal b/unbeliever.cabal
@@ -1,6 +1,6 @@
 cabal-version: 1.12
 
--- This file has been generated from package.yaml by hpack version 0.35.1.
+-- This file has been generated from package.yaml by hpack version 0.35.2.
 --
 -- see: https://github.com/sol/hpack
 
@@ -84,7 +84,6 @@ executable snippet
     , core-data
     , core-program
     , core-text
-  buildable: False
   default-language: Haskell2010
 
 executable webserver