diff --git a/patches/async-2.2.3.patch b/patches/async-2.2.3.patch
index bfb329e4a8a976e45f7cd86a306ccfba7e4815de..c6ad805b56afbebb93b3802473c40e4fa12f372f 100644
--- a/patches/async-2.2.3.patch
+++ b/patches/async-2.2.3.patch
@@ -1,8 +1,8 @@
 diff --git a/Control/Concurrent/Async.hs b/Control/Concurrent/Async.hs
-index 064a262..f962a61 100644
+index 064a262..16c772c 100644
 --- a/Control/Concurrent/Async.hs
 +++ b/Control/Concurrent/Async.hs
-@@ -959,7 +959,13 @@ tryAll = try
+@@ -959,9 +959,21 @@ tryAll = try
  {-# INLINE rawForkIO #-}
  rawForkIO :: IO () -> IO ThreadId
  rawForkIO action = IO $ \ s ->
@@ -17,3 +17,12 @@ index 064a262..f962a61 100644
  
  {-# INLINE rawForkOn #-}
  rawForkOn :: Int -> IO () -> IO ThreadId
+ rawForkOn (I# cpu) action = IO $ \ s ->
+-   case (forkOn# cpu action s) of (# s1, tid #) -> (# s1, ThreadId tid #)
++   case (forkOn# cpu
++#if __GLASGOW_HASKELL__ >= 903
++           (unIO action)
++#else
++           action
++#endif
++           s) of (# s1, tid #) -> (# s1, ThreadId tid #)
diff --git a/patches/async-pool-0.9.1.patch b/patches/async-pool-0.9.1.patch
index eda1c3f7959a3b0eb710ee236ee0e977acaee224..385dd88c08f07e7e8355407138a2365313c7dc18 100644
--- a/patches/async-pool-0.9.1.patch
+++ b/patches/async-pool-0.9.1.patch
@@ -1,8 +1,8 @@
 diff --git a/Control/Concurrent/Async/Pool/Async.hs b/Control/Concurrent/Async/Pool/Async.hs
-index be4e7c0..dda2ea4 100644
+index be4e7c0..7d189d1 100644
 --- a/Control/Concurrent/Async/Pool/Async.hs
 +++ b/Control/Concurrent/Async/Pool/Async.hs
-@@ -711,7 +711,13 @@ tryAll = try
+@@ -711,9 +711,21 @@ tryAll = try
  {-# INLINE rawForkIO #-}
  rawForkIO :: IO () -> IO ThreadId
  rawForkIO action = IO $ \ s ->
@@ -17,3 +17,12 @@ index be4e7c0..dda2ea4 100644
  
  {-# INLINE rawForkOn #-}
  rawForkOn :: Int -> IO () -> IO ThreadId
+ rawForkOn (I# cpu) action = IO $ \ s ->
+-   case (forkOn# cpu action s) of (# s1, tid #) -> (# s1, ThreadId tid #)
++   case (forkOn# cpu
++#if __GLASGOW_HASKELL__ >= 903
++           (unIO action)
++#else
++           action
++#endif
++           s) of (# s1, tid #) -> (# s1, ThreadId tid #)
diff --git a/patches/hspec-core-2.8.2.patch b/patches/hspec-core-2.8.2.patch
index 3663f630ab1a0c8e4d94f59c9beab40a11bb7057..973f86f2aed427e81cd5720dd99c1dbbe47cb5de 100644
--- a/patches/hspec-core-2.8.2.patch
+++ b/patches/hspec-core-2.8.2.patch
@@ -1,8 +1,8 @@
 diff --git a/vendor/Control/Concurrent/Async.hs b/vendor/Control/Concurrent/Async.hs
-index 81c3e69..d11e944 100644
+index 81c3e69..199c5bd 100644
 --- a/vendor/Control/Concurrent/Async.hs
 +++ b/vendor/Control/Concurrent/Async.hs
-@@ -862,7 +862,13 @@ tryAll = try
+@@ -862,9 +862,21 @@ tryAll = try
  {-# INLINE rawForkIO #-}
  rawForkIO :: IO () -> IO ThreadId
  rawForkIO action = IO $ \ s ->
@@ -17,3 +17,12 @@ index 81c3e69..d11e944 100644
  
  {-# INLINE rawForkOn #-}
  rawForkOn :: Int -> IO () -> IO ThreadId
+ rawForkOn (I# cpu) action = IO $ \ s ->
+-   case (forkOn# cpu action s) of (# s1, tid #) -> (# s1, ThreadId tid #)
++   case (forkOn# cpu
++#if __GLASGOW_HASKELL__ >= 903
++           (unIO action)
++#else
++           action
++#endif
++           s) of (# s1, tid #) -> (# s1, ThreadId tid #)
diff --git a/patches/hspec-meta-2.7.8.patch b/patches/hspec-meta-2.7.8.patch
index 70d58afc724be6b7fa523eed5610a2dea56d35fa..747d7a811988aeb7cf1168aa467f5016e39051f6 100644
--- a/patches/hspec-meta-2.7.8.patch
+++ b/patches/hspec-meta-2.7.8.patch
@@ -12,10 +12,10 @@ index f0a3585..79b71b1 100644
  import           GHC.IO.Exception
  import           Control.Exception
 diff --git a/hspec-core/vendor/Control/Concurrent/Async.hs b/hspec-core/vendor/Control/Concurrent/Async.hs
-index d968934..c552c11 100644
+index d968934..4aa8c90 100644
 --- a/hspec-core/vendor/Control/Concurrent/Async.hs
 +++ b/hspec-core/vendor/Control/Concurrent/Async.hs
-@@ -862,7 +862,13 @@ tryAll = try
+@@ -862,9 +862,21 @@ tryAll = try
  {-# INLINE rawForkIO #-}
  rawForkIO :: IO () -> IO ThreadId
  rawForkIO action = IO $ \ s ->
@@ -30,6 +30,15 @@ index d968934..c552c11 100644
  
  {-# INLINE rawForkOn #-}
  rawForkOn :: Int -> IO () -> IO ThreadId
+ rawForkOn (I# cpu) action = IO $ \ s ->
+-   case (forkOn# cpu action s) of (# s1, tid #) -> (# s1, ThreadId tid #)
++   case (forkOn# cpu
++#if __GLASGOW_HASKELL__ >= 903
++           (unIO action)
++#else
++           action
++#endif
++           s) of (# s1, tid #) -> (# s1, ThreadId tid #)
 diff --git a/hspec-discover/src/Test/Hspec/Discover/Run.hs b/hspec-discover/src/Test/Hspec/Discover/Run.hs
 index f95879b..2f87b9e 100644
 --- a/hspec-discover/src/Test/Hspec/Discover/Run.hs
diff --git a/patches/threads-0.5.1.6.patch b/patches/threads-0.5.1.6.patch
index 1b1b0ba91f25b6a314c727022c8b4ebd94a2934e..fb6148fa592b5727309cc080c4b939b22773bd60 100644
--- a/patches/threads-0.5.1.6.patch
+++ b/patches/threads-0.5.1.6.patch
@@ -1,5 +1,5 @@
 diff --git a/Control/Concurrent/Raw.hs b/Control/Concurrent/Raw.hs
-index 58dbf8e..02b7c69 100644
+index 58dbf8e..729bd2c 100644
 --- a/Control/Concurrent/Raw.hs
 +++ b/Control/Concurrent/Raw.hs
 @@ -1,3 +1,4 @@
@@ -7,7 +7,7 @@ index 58dbf8e..02b7c69 100644
  {-# LANGUAGE NoImplicitPrelude, MagicHash, UnboxedTuples #-}
  
  module Control.Concurrent.Raw ( rawForkIO, rawForkOn ) where
-@@ -7,13 +8,23 @@ import GHC.IO        ( IO(IO) )
+@@ -7,15 +8,31 @@ import GHC.IO        ( IO(IO) )
  import GHC.Exts      ( Int(I#), fork#, forkOn# )
  import GHC.Conc      ( ThreadId(ThreadId) )
  
@@ -32,3 +32,12 @@ index 58dbf8e..02b7c69 100644
  
  {-# INLINE rawForkOn #-}
  rawForkOn :: Int -> IO () -> IO ThreadId
+ rawForkOn (I# cpu) action = IO $ \s ->
+-   case (forkOn# cpu action s) of (# s1, tid #) -> (# s1, ThreadId tid #)
++   case (forkOn# cpu
++#if __GLASGOW_HASKELL__ >= 903
++           (unIO action)
++#else
++           action
++#endif
++           s) of (# s1, tid #) -> (# s1, ThreadId tid #)