stm-io-hooks 0.2.1 → 0.3.0

raw patch · 4 files changed

+112/−9 lines, 4 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Control/Concurrent/AdvSTM.hs +3/−2
• Control/Monad/AdvSTM/Class.hs +106/−4
• Control/Monad/AdvSTM/Def.hs +1/−1
• stm-io-hooks.cabal +2/−2

@@ -24,7 +24,7 @@                                             , check                                             , alwaysSucceeds                                             , always-                                            , runAtomic+--                                            , runAtomic                                             , catchSTM                                             , liftAdv                                             , newTVar@@ -44,6 +44,7 @@ import Prelude hiding (catch) import Control.Monad.AdvSTM.Def(AdvSTM(..),Env(..),TVarValue(..)) import Control.Monad.AdvSTM.Class( MonadAdvSTM(..), TVar( TVar ), onCommitLock, currentTid, valueTVar )+-- import Control.Monad.Reader(ReaderT(ReaderT),mapReaderT,runReaderT)  import Control.Exception(throw,catch,SomeException,fromException,try,block,Deadlock(..))  import Control.Monad(mplus,when,liftM,ap,unless)@@ -85,7 +86,7 @@      always inv = unlift inv >>= liftAdv . S.always  -    runAtomic = atomically+--    runAtomic = atomically       catchSTM action handler = do         action'  <- unlift action

@@ -20,12 +20,16 @@ import qualified Control.Concurrent.STM as S import qualified Control.Concurrent.STM.TVar as OldTVar import qualified Control.Concurrent.STM.TMVar as OldTMVar-import Control.Monad(Monad)+import Control.Monad(Monad,liftM)+import Control.Monad.Trans(lift)+import Control.Monad.Reader(ReaderT(ReaderT),mapReaderT,runReaderT)+import Control.Monad.State(StateT(StateT),mapStateT,runStateT,evalStateT)+import Control.Monad.Writer(WriterT(WriterT),mapWriterT,runWriterT,execWriterT) -- import Control.Monad.AdvSTM.Def(AdvSTM) import Control.Concurrent( ThreadId ) --import GHC.Conc( unsafeIOToSTM ) -- import {-# SOURCE #-} Control.Concurrent.AdvSTM.TVar-+import Data.Monoid  data TVar a = TVar      { valueTVar    :: OldTVar.TVar a     @@ -88,7 +92,7 @@     always :: m Bool -> m ()      -- | Runs a transaction atomically in the 'IO' monad. -    runAtomic :: m a -> IO a+--    runAtomic :: m a -> IO a      -- | See 'S.catchSTM'     catchSTM  :: Exception e => m a -> (e -> m a) -> m a@@ -109,5 +113,103 @@     newTVar :: a -> m (TVar a)  --    newTVarIO :: a -> IO (TVar a)-     +++mapReaderT2 :: (m a -> n b -> o c) -> ReaderT w m a -> ReaderT w n b -> ReaderT w o c+mapReaderT2 f m1 m2 = ReaderT $ \r -> f (runReaderT m1 r) (runReaderT m2 r) ++instance MonadAdvSTM m => MonadAdvSTM (ReaderT r m) where+  onCommit = lift . onCommit  ++  onRetry  = lift . onRetry ++  orElse = mapReaderT2 orElse++  retry  = lift retry++  check = lift . check ++  alwaysSucceeds = mapReaderT alwaysSucceeds++  always = mapReaderT always+++  catchSTM m h = ReaderT (\r -> catchSTM (runReaderT m r) (\e -> runReaderT (h e) r))++  liftAdv = lift . liftAdv + +  readTVar = lift . readTVar++  writeTVar tvar = lift . writeTVar tvar++  newTVar = lift . newTVar +++mapStateT2 :: (m (a, s) -> n (b, s) -> o (c,s)) -> StateT s m a -> StateT s n b -> StateT s o c+mapStateT2 f m1 m2 = StateT $ \s -> f (runStateT m1 s) (runStateT m2 s)++liftStateT f m = StateT $ \s -> let a = evalStateT m s+                                in do r <- f a+                                      return (r,s)++instance MonadAdvSTM m => MonadAdvSTM (StateT s m) where+  onCommit = lift . onCommit  ++  onRetry  = lift . onRetry ++  orElse = mapStateT2 orElse++  retry  = lift retry++  check = lift . check ++  alwaysSucceeds = liftStateT alwaysSucceeds ++  always = liftStateT always+  +  catchSTM m h = StateT (\r -> catchSTM (runStateT m r) (\e -> runStateT (h e) r))++  liftAdv = lift . liftAdv + +  readTVar = lift . readTVar++  writeTVar tvar = lift . writeTVar tvar++  newTVar = lift . newTVar +++-- mapWriterT2 :: (m (a, w) -> n (b, w) -> o (c,w')) -> WriterT w m a -> WriterT w n b -> WriterT w' o c+-- mapWriterT2 f m1 m2 = WriterT $ \s -> f (runWriterT m1 s) (runWriterT m2 s)++{-+ - TODO: +liftWriterT f m = WriterT $ \s -> let a = runWriterT m s+                                in do r <- f a+                                      return (r,s)++instance (MonadAdvSTM m, Monoid w) => MonadAdvSTM (WriterT w m) where+  onCommit = lift . onCommit  ++  onRetry  = lift . onRetry ++--  orElse = mapWriterT2 orElse++  retry  = lift retry++  check = lift . check ++--  alwaysSucceeds = mapWriterT alwaysSucceeds ++--  always = mapWriterT always+  +  catchSTM m h = WriterT (\r -> catchSTM (runWriterT m r) (\e -> runWriterT (h e) r))++  liftAdv = lift . liftAdv + +  readTVar = lift . readTVar++  writeTVar tvar = lift . writeTVar tvar++  newTVar = lift . newTVar +-}

@@ -20,7 +20,7 @@ import Control.Concurrent.STM.TMVar(TMVar)  import Control.Concurrent(MVar,ThreadId) import Control.Monad(Monad,MonadPlus)-import Control.Monad.Reader(ReaderT)+import Control.Monad.Reader(ReaderT,mapReaderT,runReaderT)  -- | Drop-in replacement for the STM monad newtype AdvSTM a = AdvSTM (ReaderT Env S.STM a)

@@ -13,7 +13,7 @@     * If the onCommit action throws an exception, the original values of      the modified TVars are restored.     .-    Note: The package can be used as a drop-in replacement for the+    Note: The package can be used as a drop-in replacement for      'Control.Concurrent.STM'. Part of this library uses code from     the Haskell Wiki (see <http://haskell.org/haskellwiki/?title=New_monads/MonadAdvSTM>). @@ -23,7 +23,7 @@ License:        BSD3 License-file:   LICENSE Homepage:       http://darcs.monoid.at/stm-io-hooks-Version:        0.2.1+Version:        0.3.0  Build-type:     Simple                         Cabal-Version:  >= 1.2.3