On Apr 28, 2008, at 10:01 PM, Ryan Ingram wrote:
The problem I have with all of these STM-based solutions to this
problem is that they don't actually cache until the action fully
executes successfully.
I just hacked together a new monad that I think might solve this, at
least with a little extra work. I haven't tested it yet though because
I have to do some studying now. I just want to go ahead and put it up
for review and see if you guys think this is a good approach.
To use it you use the "could" and "must" functions to specify which
STM actions may be rolled back and which ones must be permanent. When
you apply maybeAtomicallyC to a CachedSTM action, all the "must"
actions are performed individually, where any that fail do not affect
any of the others. Once the "must" actions are done, the "could"
actions are performed, returning Just the result. If that fails then
the whole thing simply returns Nothing, but the "must" actions are
still committed.
At least, I _hope_ the above is what it actually does!
module CachedSTM where
import Control.Applicative
import Control.Concurrent.STM
import Control.Monad
data CachedSTM a = CSTM {
getMust :: STM (),
getShould :: STM a
}
instance Functor CachedSTM where
f `fmap` (CSTM m s) = CSTM m $ f <$> s
joinCSTM :: CachedSTM (CachedSTM a) -> CachedSTM a
joinCSTM cstm = CSTM m s
where m = do cstm' <- getShould cstm
getMust cstm' `orElse` return ()
getMust cstm `orElse` return ()
s = getShould =<< getShould cstm
instance Applicative CachedSTM where
pure = return
(<*>) = ap
instance Monad CachedSTM where
return = CSTM (return ()) . return
x >>= f = joinCSTM $ f <$> x
maybeAtomicallyC :: CachedSTM a -> IO (Maybe a)
maybeAtomicallyC cstm = atomically $ do
getMust cstm
liftM Just (getShould cstm) `orElse`
return Nothing
could :: STM a -> CachedSTM a
could stm = CSTM (return ()) stm
must :: STM () -> CachedSTM ()
must stm = CSTM stm $ return ()
Now the IVal stuff might look something like:
module IVal where
import CachedSTM
import Control.Applicative
import Control.Concurrent.STM
import Control.Monad
import System.IO.Unsafe
newtype IVal a = IVal (TVar (Either (CachedSTM a) a))
newIVal :: CachedSTM a -> CachedSTM (IVal a)
newIVal = fmap IVal . could . newTVar . Left
newIValIO :: CachedSTM a -> IO (IVal a)
newIValIO = fmap IVal . newTVarIO . Left
cached :: CachedSTM a -> IVal a
cached = unsafePerformIO . newIValIO
force :: IVal a -> CachedSTM a
force (IVal tv) = could (readTVar tv) >>= either compute return
where compute wait = do x <- wait
must . writeTVar tv $ Right x
return x
instance Functor IVal where
f `fmap` x = cached $ f <$> force x
instance Applicative IVal where
pure = return
(<*>) = ap
instance Monad IVal where
return = cached . return
x >>= f = cached (force x >>= force . f)
- Jake
_______________________________________________
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe
