diff --git a/Distribution/Compat/Exception.hs b/Distribution/Compat/Exception.hs
new file mode 100644
index 0000000000000000000000000000000000000000..a6deef845c43b7d03ccdd1798b811b0ad630cbda
--- /dev/null
+++ b/Distribution/Compat/Exception.hs
@@ -0,0 +1,23 @@
+{-# LANGUAGE CPP #-}
+{-# OPTIONS_GHC -cpp #-}
+{-# OPTIONS_NHC98 -cpp #-}
+{-# OPTIONS_JHC -fcpp #-}
+-- #hide
+module Distribution.Compat.Exception (bracketOnError) where
+
+import Control.Exception as Exception
+
+#if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ < 606)
+bracketOnError
+        :: IO a         -- ^ computation to run first (\"acquire resource\")
+        -> (a -> IO b)  -- ^ computation to run last (\"release resource\")
+        -> (a -> IO c)  -- ^ computation to run in-between
+        -> IO c         -- returns the value from the in-between computation
+bracketOnError before after thing =
+  Exception.block (do
+    a <- before
+    Exception.catch
+        (Exception.unblock (thing a))
+        (\e -> do { after a; Exception.throw e }))
+#endif
+
diff --git a/Distribution/Simple/Utils.hs b/Distribution/Simple/Utils.hs
index 2d8a424c657325a7815ebc398414a02e43638bbb..72e45fefa243cfd35fa370138b5f35b60634b8fa 100644
--- a/Distribution/Simple/Utils.hs
+++ b/Distribution/Simple/Utils.hs
@@ -135,7 +135,7 @@ import System.IO
 import System.IO.Error as IO.Error
     ( try )
 import qualified Control.Exception as Exception
-    ( bracket, bracket_, bracketOnError, catch, finally )
+    ( bracket, bracket_, catch, finally )
 
 import Distribution.Text
     ( display )
@@ -157,6 +157,7 @@ import qualified Control.Exception as Exception
     ( throwIO )
 #endif
 
+import Distribution.Compat.Exception as Exception (bracketOnError)
 import Distribution.Compat.TempFile (openTempFile, openBinaryTempFile)
 import Distribution.Verbosity