Proposal: Add throwSTM and generalize catchSTM

[Bas van Dijk]

On Sun, Sep 26, 2010 at 11:24 PM, Antoine Latter <aslatter at gmail.com> wrote:
> So that's a +1 from me. It would be nice to get a Hackage analysis to
> get an idea of what will break from this change.

There are 83 direct reverse dependencies of stm:

http://bifunctor.homelinux.net/~roel/cgi-bin/hackage-scripts/revdeps/stm-2.1.2.2#direct

None of them define throwSTM, so adding this function will not break anything.

6 of those packages use catchSTM.

>From a quick read of the source code all of them seem to keep working
with the proposed generalization.

What follows is the detailed analysis:


* stm-io-hooks-0.6.0/Control/Concurrent/AdvSTM.hs:88:

import qualified Control.Concurrent.STM as S

class Monad m => MonadAdvSTM m where
    ...
    catchSTM  :: Exception e => m a -> (e -> m a) -> m a

instance MonadAdvSTM AdvSTM where
    ...
    catchSTM action handler = do
        action'  <- unlift action
        handler' <- unlift1 handler
        let handler'' e = case fromException e of
                            Nothing -> throw e
                            Just e' -> handler' e'
        liftAdv $ S.catchSTM action' handler''

This code does not have to be modified.
However there's an opportunity to simplify it to just:

    catchSTM action handler = do
        action'  <- unlift action
        handler' <- unlift1 handler
        liftAdv $ S.catchSTM action' handler'


* HAppS-State-0.9.3/src/HAppS/State/Monad.hs:86:
* happstack-state-0.5.0.2/src/Happstack/State/Monad.hs:82:

class CatchEv m where
#if __GLASGOW_HASKELL__ < 610
    catchEv :: Ev m a -> (Exception -> a) -> Ev m a
#else
    catchEv :: Ev m a -> (SomeException -> a) -> Ev m a
#endif
instance CatchEv (ReaderT st STM) where
    catchEv (Ev cmd) fun = Ev $ \s -> ReaderT $ \r -> runReaderT (cmd
s) r `catchSTM` (\a -> return (fun a))

instance CatchEv (StateT st STM) where
    catchEv (Ev cmd) fun = Ev $ \s -> StateT $ \r -> runStateT (cmd s)
r `catchSTM` (\a -> return (fun a,r))

This code does not have to be modified.
However it would be a nice opportunity to generalize:
catchEv ::  Exception e => Ev m a -> (e -> a) -> Ev m a


* PriorityChansConverger-0.1/Control/Concurrent/ConcurrentUISupport.hs:223:

reportExceptionIfAnySTM :: (String -> STM ()) -> String -> STM a -> STM a
reportExceptionIfAnySTM reportStr caller_f_name stma = catchSTM stma
(\ se@(E.SomeException e) -> reportStr ("An error occurred in function
'" ++ caller_f_name ++ "'. Type: " ++ (show $ typeRepTyCon $ typeOf e)
++ ". Representation: " ++ show se) >> E.throw (se ::
E.SomeException))

This code does not have to be modified.


* Pugs-6.2.13.15/src/Pugs/AST/Eval.hs:181:

guardSTM :: STM a -> Eval a
guardSTM x = do
    rv <- stm $ fmap Right x `catchSTM` (return . Left)
    case rv of
        Left e -> fail (show e)
        Right v -> return v

This code does not have to be modified.


* monadIO-0.9.2.0/src/Control/Concurrent/STM/MonadIO.hs:52:

Only reexports catchSTM. There's one package which depends on monadIO:
orc. However this package does not use the exported catchSTM.



Regards,

Bas