[Haskell-cafe] Re: Is my code too complicated?
Ertugrul Soeylemez
es at ertes.de
Sun Jul 4 09:47:21 EDT 2010
Bulat Ziganshin <bulat.ziganshin at gmail.com> wrote:
> Saturday, July 3, 2010, 4:25:22 PM, you wrote:
>
> > This has proven very useful for me. My usual way is writing monad
> > transformers and sticking them together, often together with
> > concurrent programming.
>
> > ... /what/ my code is
> > doing, because it's written in natural language as much as possible
>
> can we see such code? i always thought that monad transformers are
> hard to use since you need to lift operations from inner monads on
> every use
This may appear like a disadvantage, but as your monad gets more
complicated, this becomes a virtue, because it gives you great type
safety. In general, you can write specialized lifting functions for
specialized monads. Here is an example monad:
type CounterT = StateT
runCounterT :: (Functor m, Num c) => CounterT c m a -> m a
runCounterT c = fst <$> runStateT 0 c
increment :: (Monad m, Num c) => CounterT c m ()
increment = sets_ (+1)
decrement :: (Monad m, Num c) => CounterT c m ()
decrement = sets_ (subtract 1)
printCounter :: (BaseM m IO, Show c) => CounterT c m ()
printCounter = get >>= inBase . print
Let's build a custom monad using CounterT somewhere in the middle:
type MyMonad = IdT (IdT (CounterT Integer (IdT IO)))
Now let's write the specialized lifting functions:
myMonadIO :: IO a -> MyMonad a
myMonadIO = inBase
myMonadInnerId :: IdT IO a -> MyMonad a
myMonadInnerId = lift . lift . lift
myMonadCtr :: CounterT Integer (IdT IO) a -> MyMonad a
myMonadCtr = lift . lift
myMonadOuterId :: IdT (CounterT Integer (IdT IO)) a -> MyMonad a
myMonadOuterId = lift
As you can see this can get quite ugly and tiresome. There is a much
easier approach, inspired by monadLib's 'inBase' function:
class (Monad m, Monad n) => CounterM m n | m -> n where
inCtr :: n a -> m a
instance Monad m => CounterM (CounterT c m) (CounterT c m) where
inCtr = id
instance CounterM m n => CounterM (IdT m) n where
inCtr = lift . inCtr
This requires a bunch of type system extensions, though, most notably
the UndecidableInstances extension. But it's safe to use here. Now you
can get along without custom lifting functions entirely:
testComp :: MyMonad ()
testComp = do
x <- inCtr $ increment >> increment >> get
inBase $ print x
y <- inCtr $ decrement >> decrement >> get
inBase $ print y
The type system calculates the proper number of lifts for you here and
provides them through the 'inCtr' function.
Greets,
Ertugrul
--
nightmare = unsafePerformIO (getWrongWife >>= sex)
http://ertes.de/
More information about the Haskell-Cafe
mailing list