
I posted an improved version of the new monad to the wiki at http://haskell.org/haskellwiki/New_monads/MonadAdvSTM Observations: ** This idiom made it easy for the retrying case to queue an action which ensures success in the next attempt. ** More than one operation can be queued for both the commit and the retry possibilities. ** Reading the TVar in the onRetry/retryWith branch sees the "rolled back" value, which luckily is the initialization value instead of undefined in the case where the TVar was created in the aborted block. ** The new code includes unlift* operations which makes the STM code in testUnlift much easier to write. The relevant example its output are now: -- Example code using the above, lifting into MonadAdvSTM: test ::(Monad m, MonadAdvSTM m) => TVar Bool -> m [Char] test todo = do onCommit (print "onCommit Start") onRetry (print "onRetry Start") v <- liftAdv $ newTVar 7 liftAdv $ writeTVar v 42 onCommit (atomically (readTVar v) >>= \x->print ("onCommit v",x)) onRetry (atomically (readTVar v) >>= \x->print ("onRetry v",x)) choice <- liftAdv $ readTVar todo case choice of True -> return "foo" False -> retryWith $ do atomically (writeTVar todo True) print "Flipped choice to True to avoid infinite loop" -- Same example as test, but unlifting from AdvSTM testUnlift :: TVar Bool -> AdvSTM [Char] testUnlift todo = do onCommit <- unlift1 onCommit onRetry <- unlift1 onRetry retryWith <- unlift1 retryWith liftAdv $ do onCommit (print "onCommit Start") onRetry (print "onRetry Start") v <- newTVar 7 writeTVar v 42 onCommit (atomically (readTVar v) >>= \x->print ("onCommit v",x)) onRetry (atomically (readTVar v) >>= \x->print ("onRetry v",x)) choice <- readTVar todo case choice of True -> return "foo" False -> retryWith $ do atomically (writeTVar todo True) print "Flipped choice to True to avoid infinite loop" -- Example similar to Simon's suggested example: countRetries :: (MonadAdvSTM m, Monad m, Enum a) => IORef a -> m a1 -> m a1 countRetries ioref action = let incr = do old <- readIORef ioref writeIORef ioref $! (succ old) in action `orElseAdv` (retryWith incr) -- Load this file in GHCI and execute main to run the test: main = do counter <- newIORef 0 todo <- newTVarIO False print "test" result <- runAdvSTM (countRetries counter $ test todo) retries <- readIORef counter print ("result",result,"retries",retries) atomically (writeTVar todo False) print "testUnlift" result <- runAdvSTM (countRetries counter $ testUnlift todo) retries <- readIORef counter print ("result",result,"retries",retries) print "bye world" The output in GHCI is *AdvSTM> main "test" "onRetry Start" ("onRetry v",7) "Flipped choice to True to avoid infinite loop" "onCommit Start" ("onCommit v",42) ("result","foo","retries",1) "testUnlift" "onRetry Start" ("onRetry v",7) "Flipped choice to True to avoid infinite loop" "onCommit Start" ("onCommit v",42) ("result","foo","retries",2) "bye world"