[Haskell-cafe] Monad Imparative Usage Example
Brian Hulley
brianh at metamilk.com
Sat Aug 5 11:04:15 EDT 2006
Kaveh Shahbazian wrote:
> Very Thankyou
> I am starting to feel it. I think about it as a 'context' that wraps
> some computations, which are handled by compiler environment (please
> make me correct if I am wrong). Now I think I need to find out how
> this 'monads' fit in solving problems. And for that I must go through
> bigger programs to write.
> Thanks again
Hi Kaveh -
Yes, monads can be used to wrap computations with a context. With the State
monad, S (s -> (a,s)), this context is just a value of type (s) which the
monadic ops (return) and (>>=) pass around. It's important to see that there
is no special compiler magic here: (>>=) is just a normal higher order
function.
The only place where there is any special compiler magic (*) is the IO
monad, but you can get a good idea of what's going on by imagining it as a
kind of state monad as if it was IO (RealWorld -> (a, RealWorld)) where
RealWorld is a special compiler-generated record containing all the mutable
variables used by your program and all external state provided by the
operating system eg the contents of the hard drive etc.
I'd suggest a possible path to writing larger Haskell programs is just:
1) Understand State monad
2) Use this to understand IO monad
3) Learn about IORefs
4) Read about monad transformers eg StateT and ReaderT
5) Understand how (lift) works by looking at the source (instances of
Trans)
6) Read about MonadIO and liftIO
7) Use (ReaderT AppData IO) where AppData is a record of IORefs to write
imperative code where "global mutable state" is now neatly encapsulated in a
monad
So you'd learn about monads and monad transformers while still staying in
the comfort zone of normal imperative programming with "global" mutable
variables. Of course this is not all that radical... ;-)
I found looking at the source code for the various monads and monad
transformers makes things a lot easier to understand than the Haddock docs
which only contain the type signatures.
BTW I've noticed a slight bug in my explanation in that I fixed the result
types of both actions to be the same when they could have had different
types so my corrected explanation follows below (apologies for not checking
it properly before posting the first time):
> For example with the State monad, (q) must be some expression which
> evaluates to something of the form S fq where fq is a function with
> type s -> (a,s), and similarly, (\x -> p) must have type a ->S ( s ->
> (a,s)). If we choose names for these values which describe the types
> we have:
Actually the above types are not general enough because p and q don't need
to use the same result type (a), so I'd like to correct my explanation to
the following (State monad assumed throughout):
q >>= (\x -> p)
means that both q and p are expressions that evaluate to monadic values ie
values whose type is of the form
S (s -> (a, s))
Different actions can have different result types (ie different a's) but
all share the same state type (s) because the type that's the instance of
Monad is (State s)
So we have:
q :: S (s -> (a, s))
(\x -> p) :: a -> S (s -> (b, s))
To make the explanation simpler, we can rename the variables in the
definition of >>= to reflect their types:
> S m >>= k = S (\s ->
> let
> (a, s1) = m s
> S n = k a
> in n s1)
S s_as >>= a_S_s_bs =
S (\s0 ->
let
(a, s1) = s_as s0
S s_bs = a_S_s_bs a
in
s_bs s1)
so
runState s0 (q >>= \x -> p)
=== runState s0 (S (\s0 -> let ... in s_bs s1))
=== (\s0 -> let ... in s_bs s1) s0
=== s_bs s1
=== bs2
ie (b, s2) where b::b and s2::s is the new state after executing the
composite action.
(*) There is also the ST monad but I'd leave that for later.
Best regards, Brian
--
Logic empowers us and Love gives us purpose.
Yet still phantoms restless for eras long past,
congealed in the present in unthought forms,
strive mightily unseen to destroy us.
http://www.metamilk.com
More information about the Haskell-Cafe
mailing list