For complex pure functions that update an IORef it's convenient to be able to log error messages. This function makes it possible by accumulating error messages from the pure function, threading them through atomicModifyIORef and logging them afterwards at once.
Signed-off-by: Petr Pudlak <[email protected]> --- src/Ganeti/Utils/IORef.hs | 20 ++++++++++++++++++++ 1 file changed, 20 insertions(+) diff --git a/src/Ganeti/Utils/IORef.hs b/src/Ganeti/Utils/IORef.hs index 12857bf..cd8302e 100644 --- a/src/Ganeti/Utils/IORef.hs +++ b/src/Ganeti/Utils/IORef.hs @@ -26,14 +26,18 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA module Ganeti.Utils.IORef ( atomicModifyWithLens , atomicModifyIORefErr + , atomicModifyIORefErrLog ) where +import Control.Monad import Control.Monad.Base import Data.IORef.Lifted import Data.Tuple (swap) import Ganeti.BasicTypes import Ganeti.Lens +import Ganeti.Logging +import Ganeti.Logging.WriterLog -- | Atomically modifies an 'IORef' using a lens atomicModifyWithLens :: (MonadBase IO m) @@ -48,3 +52,19 @@ atomicModifyIORefErr :: (MonadBase IO m) atomicModifyIORefErr ref f = let f' x = genericResult ((,) x . Bad) (fmap Ok) (f x) in ResultT $ atomicModifyIORef ref f' + +-- | Atomically modifies an 'IORef' using a function that can possibly fail +-- and log errors. +-- If it fails, the value of the 'IORef' is preserved. +-- Any log messages are passed to the outer monad. +atomicModifyIORefErrLog :: (MonadBase IO m, MonadLog m) + => IORef a -> (a -> ResultT e WriterLog (a, b)) + -> ResultT e m b +atomicModifyIORefErrLog ref f = ResultT $ do + let f' x = let ((a, b), w) = runWriterLog + . liftM (genericResult ((,) x . Bad) (fmap Ok)) + . runResultT $ f x + in (a, (b, w)) + (b, w) <- atomicModifyIORef ref f' + dumpLogSeq w + return b -- 2.0.0.526.g5318336
