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

[Jake Mcarthur]

Alright, I have tested it now. I still feel funny about most of the  
names I chose for the types and functions, and it's still very ugly,  
but the code appears to work correctly. In this version I have also  
added "retry" and "orElse" functions so that it can feel more like the  
STM monad. I think the biggest downside to this monad is the potential  
confusion about whether to use "could" or "must," but I have a feeling  
that better naming choices would reduce the ambiguity.

Thoughts?

> module CachedSTM where
>
> import Control.Applicative
> import Control.Concurrent.STM as S
> import Control.Monad
>
> data CachedSTM a = CSTM {
>       getMust :: STM (),
>       getCould :: 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' <- getCould cstm
>                  getMust cstm' `S.orElse` return ()
>                  getMust cstm `S.orElse` return ()
>           s = getCould =<< getCould 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 (getCould cstm) `S.orElse`  
> return Nothing
>
> could :: STM a -> CachedSTM a
> could stm = CSTM (return ()) stm
>
> must :: STM () -> CachedSTM ()
> must stm = CSTM (stm `S.orElse` return ()) $ return ()
>
> retry :: CachedSTM a
> retry = could S.retry
>
> orElse :: CachedSTM a -> CachedSTM a -> CachedSTM a
> orElse a b = do must $ getMust a
>                 temp <- could newEmptyTMVar
>                 must $ (getCould a >>= putTMVar temp) `S.orElse`  
> getMust b
>                 could $ takeTMVar temp `S.orElse` getCould b

I don't think the IVar code has changed (no version control for this),  
but here it is again for quick reference:

> 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
-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://www.haskell.org/pipermail/haskell-cafe/attachments/20080429/cad30905/attachment.htm