[Haskell-cafe] class Runnable vs fromJust (was Re: haskell idiom
for reversible computations)
MR K P SCHUPKE
k.schupke at imperial.ac.uk
Tue Mar 23 20:30:09 EST 2004
The problem with Runnable is that it is not ewasily implementable
for all monads... So purists rather than implement it for some don't
implement it at all.
Here's some examples:
class Runnable x y where
run :: x -> y
instance Runnable (m a) (m a) where
run = id
instance Runnable (s -> m a) (s -> m a) where
run = id
instance (Monad m,Monad n,MonadT t m,Runnable (m a) (n a)) => Runnable (t m a) (n a) where
run = run . down
instance (Monad m,MonadT t m,Monad (t m)) => Runnable (t m a) (m a) where
run = down
These declare runnable for monad-transformers for which "down" is definable
down is the functional opposite of lift (or "up" as it is sometimes called)
The state monad transformer needs an instance of Runnable if you want to
pass a value in:
instance (MonadState st (StateT st m),Monad m,Monad n,Runnable (st -> m s) (st -> n s)) => Runnable (StateT st m s) (st -> n s) where
run = run . (\(ST m) s -> do
(_,a) <- m s
return a)
instance (MonadState st (StateT st m),Monad m) => Runnable (StateT st m s) (st -> m s) where
run = \(ST m) s -> do
(_,a) <- m s
return a
Whereas defining Runnable for the continuation-monad-transformer is quite a challenge:
instance (MonadT (ContT r) m,Runnable ((r -> m r) -> m r) ((r -> n r) -> n r)) => Runnable (ContT r m r) ((r -> n r) -> n r) where
run = run . (\(CT m) kappa -> m kappa)
instance MonadT (ContT r) m => Runnable (ContT r m r) ((r -> m r) -> m r) where
run = (\(CT m) kappa -> m kappa)
Have Fun.
Keean.
More information about the Haskell-Cafe
mailing list