Transaction.hs

{-# LANGUAGE GeneralizedNewtypeDeriving, FlexibleInstances, MultiParamTypeClasses #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Conjure.Utils.Transaction
-- Copyright   :  (c) Lemmih 2006
-- License     :  BSD-like
--
-- Maintainer  :  lemmih@gmail.com
-- Stability   :  experimental
-- Portability :  non-portable (requires STM)
--
-----------------------------------------------------------------------------
module Conjure.Utils.Transaction where

import Control.Concurrent.STM
import Control.Monad.State

newtype Transaction a = Transaction (StateT [IO ()] STM a) deriving (Monad,MonadPlus)

instance MonadState [IO ()] Transaction where
    get = Transaction get
    put a = Transaction (put a)

-- | Run a STM action.
stm :: STM a -> Transaction a
stm action = Transaction (lift action)

-- | Execute an IO action when the transaction commits.
onCommit :: IO a -> Transaction ()
onCommit action
    = do lst <- get
         put ((action>>return()):lst)

-- | Execute an atomic transaction.
runT :: Transaction a -> IO a
runT (Transaction trans)
    = do (a,lst) <- atomically $ runStateT trans []
         sequence_ (reverse lst)
         return a