From 9680339d5fbad63f51a4f9ba3537360a2a317594 Mon Sep 17 00:00:00 2001
From: Joris Dral <joris@well-typed.com>
Date: Mon, 23 Dec 2024 18:02:47 +0100
Subject: [PATCH] Make `withErrors` exception safe

---
 fs-sim/CHANGELOG.md               |  9 +++++++++
 fs-sim/src/System/FS/Sim/Error.hs | 15 ++++++---------
 2 files changed, 15 insertions(+), 9 deletions(-)

diff --git a/fs-sim/CHANGELOG.md b/fs-sim/CHANGELOG.md
index 6991adc..434f2fb 100644
--- a/fs-sim/CHANGELOG.md
+++ b/fs-sim/CHANGELOG.md
@@ -1,5 +1,14 @@
 # Revision history for fs-sim
 
+## ?.?.?.? -- ????-??-??
+
+### Breaking
+
+* Fix a bug where `withErrors` would not put back the previous `Errors` when an
+  exception is thrown during execution of the function. Though we fixed the bug,
+  it is also a breaking change: the type signature now has an additional
+  constraint.
+
 ## 0.3.1.0 -- 2024-12-10
 
 ### Non-breaking
diff --git a/fs-sim/src/System/FS/Sim/Error.hs b/fs-sim/src/System/FS/Sim/Error.hs
index f55b2e6..5897ad8 100644
--- a/fs-sim/src/System/FS/Sim/Error.hs
+++ b/fs-sim/src/System/FS/Sim/Error.hs
@@ -572,15 +572,12 @@ runSimErrorFS mockFS errors action = do
 
 -- | Execute the next action using the given 'Errors'. After the action is
 -- finished, the previous 'Errors' are restored.
-withErrors :: MonadSTM m => StrictTVar m Errors -> Errors -> m a -> m a
-withErrors errorsVar tempErrors action = do
-    originalErrors <- atomically $ do
-      originalErrors <- readTVar errorsVar
-      writeTVar errorsVar tempErrors
-      return originalErrors
-    res <- action
-    atomically $ writeTVar errorsVar originalErrors
-    return res
+withErrors :: (MonadSTM m, MonadThrow m) => StrictTVar m Errors -> Errors -> m a -> m a
+withErrors errorsVar tempErrors action =
+    bracket
+      (atomically $ swapTVar errorsVar tempErrors)
+      (\originalErrors -> atomically $ swapTVar errorsVar originalErrors)
+      $ \_ -> action
 
 {-------------------------------------------------------------------------------
   Utilities