[Haskell-cafe] Re: Control.Exceptions and MonadIO
Brian Hulley
brianh at metamilk.com
Sat Apr 22 15:15:45 EDT 2006
oleg at pobox.com wrote:
> Robert Dockins wrote:
>> One additional (very unfortunate) point is that higher-order IO monad
>> combinators will not work on your monad, eg, the ones in
>> Control.Exception.
>
> Although that is true in general, for many useful and interesting
> cases (including ReaderT, the state transformer, and the newtype
> wrapping of IO) one _can_ use catch, bracket etc. constructs in
> MonadIO. Please see this message and the follow-up discussion:
>
> http://www.haskell.org/pipermail/haskell/2006-February/017547.html
I still don't see how this helps with the StateT transformer for example,
because the state would be lost which isn't much use. For example, here is
my attempt to implement a version of bracket_ which would work with an
arbitrary StrictMonadIO:
class MonadIO m => StrictMonadIO m where
getUnliftIO :: m (m a -> IO a)
instance StrictMonadIO IO where
getUnliftIO = return id
instance StrictMonadIO m => StrictMonadIO (StateT s m) where
getUnliftIO = StateT $ \s ->
do
unliftIO <- getUnliftIO
return (\(StateT s_mas) ->
do
(a, _) <- unliftIO (s_mas s) -- NEW STATE
LOST
return a
, s) -- OLD STATE IS RETURNED
bracket_ :: StrictMonadIO m => m a -> m b -> m c -> m c
bracket_ a b c = do
unliftIOa <- getUnliftIO
unliftIOb <- getUnliftIO
unliftIOc <- getUnliftIO
liftIO $ bracket_ (unliftIOa a) (unliftIOb b) (unliftIOc
c)
There are some points that are problematic:
1) Any changes made to the state by unlifted actions are discarded
2) The implementation of bracket_ seems unnecessarily messy because of the
strange limitation that higher rank polymorphism is not allowed ie the
following definition gives a compiler error:
getUnliftIO :: m (forall a. m a -> IO a) -- what's wrong with this?
So the essential question is: does there exist any way to implement a
bracket_ that will work properly with a state monad?
I'm also wondering: exactly why is it impossible to implement the Exception
functions for an arbitrary MonadIO? Surely the higher order functions could
just be implemented using some very low level primitives like:
push_block_async :: IO ()
pop_block_async :: IO ()
push_unblock_async :: IO ()
pop_unblock_async :: IO ()
block :: MonadIO m -> m a -> m a
block x = do
liftIO push_block_async
a <- x
liftIO pop_block_async
return a
bracket_ a b c = block $ do
a
unblock c
b
Thanks, Brian.
More information about the Haskell-Cafe
mailing list