[Haskell-cafe] Re: Caching the Result of a Transaction?

[Jake Mcarthur]

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