Skip to content

Commit

Permalink
Make withErrors exception safe
Browse files Browse the repository at this point in the history
  • Loading branch information
jorisdral committed Dec 23, 2024
1 parent 8423cb3 commit 9680339
Show file tree
Hide file tree
Showing 2 changed files with 15 additions and 9 deletions.
9 changes: 9 additions & 0 deletions fs-sim/CHANGELOG.md
Original file line number Diff line number Diff line change
@@ -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
Expand Down
15 changes: 6 additions & 9 deletions fs-sim/src/System/FS/Sim/Error.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down

0 comments on commit 9680339

Please sign in to comment.