Practical introduction to monads

I've started learning Haskell, and I'm going through all the tutorial material I can find - there's a lot of good stuff available. One thing I haven't found a really good discussion of, is practical examples of building monads. There's plenty of discussion of the IO monad, and the state monad, and a lot of good theory on monads, but although I've seen tantalising statements about how powerful the ability to define your own monads can be, but no really concrete examples - something along the lines of - here is problem X - this might be our first cut at coding it - we can abstract out this stuff, as a monad - see how the code looks now, how much cleaner it is (I've seen this type of model developing a state monad, but I'm looking for a more application-specific approach). Also, a lot of (non-IO) monad code I've seen seems to revolve around higher order features like monad combinators, which, while certainly powerful, still make my head explode. On the other hand, monadic IO feels entirely comprehensible, revolving round do-notation, and looking reassuringly sequential and imperative :-) Surely there are other uses of monads which can feel familiar to non-functional programmers? Otherwise, I'm still left with the (inaccurate, and unhelpful) impression that "IO is a badly integrated exception"... I don't know if the above makes sense. I've struggled with this for a while now, and haven't managed to express my confusion any more clearly - for which I apologise. I'd appreciate any pointers or explanations. FWIW, I've read (among other papers) "Why Functional Programming Matters", "A Gentle Introduction to Haskell", Hal Daume's "Yet Another Haskell Tutorial", Simon Peyton Jones' "Tackling the Awkward Squad", and "Haskell: The Craft of Functional Programming". I don't claim to have digested all of this - indeed, there are probably many areas I've only skimmed - so pointers to areas in these documents I might have missed would be appreciated. On the other hand, pointers to papers I've missed altogether would also be gratefully received. Thanks in advance for any help, Paul. -- There is a theory which states that if ever anybody discovers exactly what the Universe is for and why it is here, it will instantly disappear and be replaced by something even more bizarre and inexplicable. There is another theory which states that this has already happened. -- Douglas Adams

On 2 août 05, at 22:03, Paul Moore wrote:
I've started learning Haskell, and I'm going through all the tutorial material I can find - there's a lot of good stuff available.
One thing I haven't found a really good discussion of, is practical examples of building monads. There's plenty of discussion of the IO monad, and the state monad, and a lot of good theory on monads, but although I've seen tantalising statements about how powerful the ability to define your own monads can be, but no really concrete examples - something along the lines of
- here is problem X - this might be our first cut at coding it - we can abstract out this stuff, as a monad - see how the code looks now, how much cleaner it is
(I've seen this type of model developing a state monad, but I'm looking for a more application-specific approach).
have you read this http://homepages.inf.ed.ac.uk/wadler/papers/marktoberdorf/ marktoberdorf.pdf ? It presents a pb, show how it sux when coded naively without monad, and then show how beautiful the code is when you use a monad. I have also one time read an example where you use monads while implementing the unification or type inference algorithm, perhaps in the original monad paper (the essence of functional programming).

Yoann,
I have also one time read an example where you use monads while implementing the unification or type inference algorithm, perhaps in the original monad paper (the essence of functional programming).
I guess you are referring to Mark Jones' _Functional Programming with Overloading and Higher-order Polymorphism_ [1]. Cheers, Stefan http://www.cs.uu.nl/~stefan/ [1] Mark P. Jones. Functional programming with overloading and higher-order polymorphism. In Johan Jeuring and Erik Meijer, editors, Advanced Functional Programming, First International Spring School on Advanced Functional Programming Techniques, Bastad, Sweden, May 24–30, 1995, Tutorial Text, volume 925 of Lecture Notes in Computer Science, pages 97–136. Springer-Verlag, 1995.

On Tuesday 02 August 2005 22:03, Paul Moore wrote:
FWIW, I've read (among other papers) "Why Functional Programming Matters", "A Gentle Introduction to Haskell", Hal Daume's "Yet Another Haskell Tutorial", Simon Peyton Jones' "Tackling the Awkward Squad", and "Haskell: The Craft of Functional Programming". I don't claim to have digested all of this - indeed, there are probably many areas I've only skimmed - so pointers to areas in these documents I might have missed would be appreciated. On the other hand, pointers to papers I've missed altogether would also be gratefully received. The "All about monads"-Tutorial was very helpful for me: http://www.nomaware.com/monads/html/
regards, Peter

On Tue, 2 Aug 2005, Paul Moore wrote:
I've started learning Haskell, and I'm going through all the tutorial material I can find - there's a lot of good stuff available.
One thing I haven't found a really good discussion of, is practical examples of building monads.
I've not really seen any. Something that might help though is considering winding the state of an abstract machine through a monad? That covers a lot of examples (parsing and the List monad come to mind). -- flippa@flippac.org There is no magic bullet. There are, however, plenty of bullets that magically home in on feet when not used in exactly the right circumstances.

Paul Moore wrote:
One thing I haven't found a really good discussion of, is practical examples of building monads. There's plenty of discussion of the IO monad, and the state monad, and a lot of good theory on monads, but although I've seen tantalising statements about how powerful the ability to define your own monads can be, but no really concrete examples - something along the lines of
- here is problem X - this might be our first cut at coding it - we can abstract out this stuff, as a monad - see how the code looks now, how much cleaner it is
Maybe you could try going in the opposite direction, and convert something like monadic parser combinators... http://www.cs.nott.ac.uk/~gmh/bib.html#pearl ...it into their non-monadic form (explictly passing the parsed string around).
I've only skimmed - so pointers to areas in these documents I might have missed would be appreciated. On the other hand, pointers to papers I've missed altogether would also be gratefully received.
I found the papers by Philip Wadler to be the most helpful... http://homepages.inf.ed.ac.uk/wadler/topics/monads.html ...especially _Monads for functional programming_ and _Imperative functional programming_. Greg Buchholz

Can thread pool be implemented in GHC ? I have a program that is currently using about 12-15 threads (launch and kill for infinite times) and when running, especially after Ctrl-C, my computer got freezed up. And if i ran it several times, the "Stack overflows" occurs. Cheers TuanAnh _________________________________________________________________ Winks & nudges are here - download MSN Messenger 7.0 today! http://messenger.msn.co.uk

On 8/4/05, Dinh Tien Tuan Anh
Can thread pool be implemented in GHC ?
I have a program that is currently using about 12-15 threads (launch and kill for infinite times) and when running, especially after Ctrl-C, my computer got freezed up. And if i ran it several times, the "Stack overflows" occurs.
Did you try "-threaded" ? -- Sebastian Sylvan +46(0)736-818655 UIN: 44640862

And how to use that ?
Did you try "-threaded" ?
_________________________________________________________________ It's fast, it's easy and it's free. Get MSN Messenger 7.0 today! http://messenger.msn.co.uk

On 8/4/05, Dinh Tien Tuan Anh
And how to use that ?
Did you try "-threaded" ?
Haven't experimented with it too much but i think the "-threaded" flag enables a thread pool so that all the forkIO threads get dispersed on a few real OS threads by the GHC scheduler... /S -- Sebastian Sylvan +46(0)736-818655 UIN: 44640862

Dinh Tien Tuan Anh
Can thread pool be implemented in GHC ?
I have a program that is currently using about 12-15 threads (launch and kill for infinite times) and when running, especially after Ctrl-C, my computer got freezed up. And if i ran it several times, the "Stack overflows" occurs.
I made the following a while back. Maybe it's useful... limitedThreadsWithChannelMapM :: Integer -> (a -> IO b) -> [a] -> IO [MVar b] limitedThreadsWithChannelMapM lim ioaction x = do threadpoolcounter <- atomically ( newTVar 0 ) mapM (throttledFork threadpoolcounter . ioaction) x where throttledFork poolcount io = do atomically ( do prev <- readTVar poolcount if prev >= lim then retry else writeTVar poolcount (prev+1) ) mvar <- newEmptyMVar forkIO( finally (io >>= putMVar mvar) (atomically ( readTVar poolcount >>= writeTVar poolcount . (subtract 1) ) ) ) return mvar
Cheers TuanAnh
_________________________________________________________________ Winks & nudges are here - download MSN Messenger 7.0 today! http://messenger.msn.co.uk

Its probably too long to bring back this topic, but i have a small question. If some threads may never terminate and have to be killed by killThread, are they going back to the pool, or we need some twist to force them. Thanks a lot TuanAnh
From: genneth
To: haskell-cafe@haskell.org Subject: [Haskell-cafe] Re: Thread pool in GHC Date: Thu, 4 Aug 2005 16:47:56 +0000 (UTC) Dinh Tien Tuan Anh
writes: Can thread pool be implemented in GHC ?
I have a program that is currently using about 12-15 threads (launch and kill for infinite times) and when running, especially after Ctrl-C, my computer got freezed up. And if i ran it several times, the "Stack overflows" occurs.
I made the following a while back. Maybe it's useful...
limitedThreadsWithChannelMapM :: Integer -> (a -> IO b) -> [a] -> IO [MVar b] limitedThreadsWithChannelMapM lim ioaction x = do threadpoolcounter <- atomically ( newTVar 0 ) mapM (throttledFork threadpoolcounter . ioaction) x where throttledFork poolcount io = do atomically ( do prev <- readTVar poolcount if prev >= lim then retry else writeTVar poolcount (prev+1) ) mvar <- newEmptyMVar forkIO( finally (io >>= putMVar mvar) (atomically ( readTVar poolcount >>= writeTVar poolcount . (subtract 1) ) ) ) return mvar
Cheers TuanAnh
_________________________________________________________________ Winks & nudges are here - download MSN Messenger 7.0 today! http://messenger.msn.co.uk
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
_________________________________________________________________ Winks & nudges are here - download MSN Messenger 7.0 today! http://messenger.msn.co.uk

I think it would go back to the pool. The finally clause means that
even if the thread dies from an exception (which, AFAIK, is how kills
are modelled), the thread count would be restored.
Gen
On 9/6/05, Dinh Tien Tuan Anh
Its probably too long to bring back this topic, but i have a small question.
If some threads may never terminate and have to be killed by killThread, are they going back to the pool, or we need some twist to force them.
Thanks a lot TuanAnh
From: genneth
To: haskell-cafe@haskell.org Subject: [Haskell-cafe] Re: Thread pool in GHC Date: Thu, 4 Aug 2005 16:47:56 +0000 (UTC) Dinh Tien Tuan Anh
writes: Can thread pool be implemented in GHC ?
I have a program that is currently using about 12-15 threads (launch and kill for infinite times) and when running, especially after Ctrl-C, my computer got freezed up. And if i ran it several times, the "Stack overflows" occurs.
I made the following a while back. Maybe it's useful...
limitedThreadsWithChannelMapM :: Integer -> (a -> IO b) -> [a] -> IO [MVar b] limitedThreadsWithChannelMapM lim ioaction x = do threadpoolcounter <- atomically ( newTVar 0 ) mapM (throttledFork threadpoolcounter . ioaction) x where throttledFork poolcount io = do atomically ( do prev <- readTVar poolcount if prev >= lim then retry else writeTVar poolcount (prev+1) ) mvar <- newEmptyMVar forkIO( finally (io >>= putMVar mvar) (atomically ( readTVar poolcount >>= writeTVar poolcount . (subtract 1) ) ) ) return mvar
Cheers TuanAnh
_________________________________________________________________ Winks & nudges are here - download MSN Messenger 7.0 today! http://messenger.msn.co.uk
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
_________________________________________________________________ Winks & nudges are here - download MSN Messenger 7.0 today! http://messenger.msn.co.uk

Does it mean that the thread pool will "LAUNCH" new thread as long as the thread count does not exceed a maximum number ? If it does launch the new thread, then the idea of thread reuse is completely ignored. My program creates and kills at most 5 threads at a time, but this process repeated for an infinite times, so thread reuse would improve the performance by getting of the overhead of creating new thread. TuanAnh
From: genneth
To: Dinh Tien Tuan Anh CC: haskell-cafe@haskell.org Subject: Re: [Haskell-cafe] Re: Thread pool in GHC Date: Tue, 6 Sep 2005 10:25:15 +0800 I think it would go back to the pool. The finally clause means that even if the thread dies from an exception (which, AFAIK, is how kills are modelled), the thread count would be restored.
Gen
On 9/6/05, Dinh Tien Tuan Anh
wrote: Its probably too long to bring back this topic, but i have a small
question.
If some threads may never terminate and have to be killed by killThread,
are
they going back to the pool, or we need some twist to force them.
Thanks a lot TuanAnh
From: genneth
To: haskell-cafe@haskell.org Subject: [Haskell-cafe] Re: Thread pool in GHC Date: Thu, 4 Aug 2005 16:47:56 +0000 (UTC) Dinh Tien Tuan Anh
writes: Can thread pool be implemented in GHC ?
I have a program that is currently using about 12-15 threads (launch
and
kill for infinite times) and when running, especially after Ctrl-C, my computer got freezed up. And if i ran it several times, the "Stack overflows" occurs.
I made the following a while back. Maybe it's useful...
limitedThreadsWithChannelMapM :: Integer -> (a -> IO b) -> [a] -> IO [MVar b] limitedThreadsWithChannelMapM lim ioaction x = do threadpoolcounter <- atomically ( newTVar 0 ) mapM (throttledFork threadpoolcounter . ioaction) x where throttledFork poolcount io = do atomically ( do prev <- readTVar poolcount if prev >= lim then retry else writeTVar poolcount (prev+1) ) mvar <- newEmptyMVar forkIO( finally (io >>= putMVar mvar) (atomically ( readTVar poolcount >>= writeTVar poolcount . (subtract 1) ) ) ) return mvar
Cheers TuanAnh
_________________________________________________________________ Winks & nudges are here - download MSN Messenger 7.0 today! http://messenger.msn.co.uk
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
_________________________________________________________________ Winks & nudges are here - download MSN Messenger 7.0 today! http://messenger.msn.co.uk
_________________________________________________________________ It's fast, it's easy and it's free. Get MSN Messenger 7.0 today! http://messenger.msn.co.uk

Yes, but AFAIK, threads in Haskell are exceedingly lightweight, as
they are only primitives for concurrency. To be perfectly honest, I've
found that my solution is completely useless in practise. I made up
the solution cos I reconned that tweaking GHC runtime heap size would
be harder than making a threadpool (it isn't). Basically, all the
usual reasons for using a threadpool just don't apply in Haskell.
Gen
On 9/6/05, Dinh Tien Tuan Anh
Does it mean that the thread pool will "LAUNCH" new thread as long as the thread count does not exceed a maximum number ? If it does launch the new thread, then the idea of thread reuse is completely ignored. My program creates and kills at most 5 threads at a time, but this process repeated for an infinite times, so thread reuse would improve the performance by getting of the overhead of creating new thread.
TuanAnh
From: genneth
To: Dinh Tien Tuan Anh CC: haskell-cafe@haskell.org Subject: Re: [Haskell-cafe] Re: Thread pool in GHC Date: Tue, 6 Sep 2005 10:25:15 +0800 I think it would go back to the pool. The finally clause means that even if the thread dies from an exception (which, AFAIK, is how kills are modelled), the thread count would be restored.
Gen
On 9/6/05, Dinh Tien Tuan Anh
wrote: Its probably too long to bring back this topic, but i have a small
question.
If some threads may never terminate and have to be killed by killThread,
are
they going back to the pool, or we need some twist to force them.
Thanks a lot TuanAnh
From: genneth
To: haskell-cafe@haskell.org Subject: [Haskell-cafe] Re: Thread pool in GHC Date: Thu, 4 Aug 2005 16:47:56 +0000 (UTC) Dinh Tien Tuan Anh
writes: Can thread pool be implemented in GHC ?
I have a program that is currently using about 12-15 threads (launch
and
kill for infinite times) and when running, especially after Ctrl-C, my computer got freezed up. And if i ran it several times, the "Stack overflows" occurs.
I made the following a while back. Maybe it's useful...
limitedThreadsWithChannelMapM :: Integer -> (a -> IO b) -> [a] -> IO [MVar b] limitedThreadsWithChannelMapM lim ioaction x = do threadpoolcounter <- atomically ( newTVar 0 ) mapM (throttledFork threadpoolcounter . ioaction) x where throttledFork poolcount io = do atomically ( do prev <- readTVar poolcount if prev >= lim then retry else writeTVar poolcount (prev+1) ) mvar <- newEmptyMVar forkIO( finally (io >>= putMVar mvar) (atomically ( readTVar poolcount >>= writeTVar poolcount . (subtract 1) ) ) ) return mvar
Cheers TuanAnh
_________________________________________________________________ Winks & nudges are here - download MSN Messenger 7.0 today! http://messenger.msn.co.uk
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
_________________________________________________________________ Winks & nudges are here - download MSN Messenger 7.0 today! http://messenger.msn.co.uk
_________________________________________________________________ It's fast, it's easy and it's free. Get MSN Messenger 7.0 today! http://messenger.msn.co.uk

So is there a way to reuse thread ? I think eventhough threads in GHC are extremely lighweight, it still make a different if u keep launching and killing thread in so many times. TuanAnh
Yes, but AFAIK, threads in Haskell are exceedingly lightweight, as they are only primitives for concurrency. To be perfectly honest, I've found that my solution is completely useless in practise. I made up the solution cos I reconned that tweaking GHC runtime heap size would be harder than making a threadpool (it isn't). Basically, all the usual reasons for using a threadpool just don't apply in Haskell.
_________________________________________________________________ MSN Messenger 7.5 is now out. Download it for FREE here. http://messenger.msn.co.uk

On Tue, Aug 02, 2005 at 09:03:49PM +0100, Paul Moore wrote:
I've started learning Haskell, and I'm going through all the tutorial material I can find - there's a lot of good stuff available.
One thing I haven't found a really good discussion of, is practical examples of building monads. There's plenty of discussion of the IO monad, and the state monad, and a lot of good theory on monads, but although I've seen tantalising statements about how powerful the ability to define your own monads can be, but no really concrete examples - something along the lines of
A very nice simple starting monad from the Prelude to consider when thinking about these things is Maybe. It was a long time before I realized how nice the monad interface to Maybe is. If you have a bunch of calculations that might fail (and return Nothing in that case), you can convert case f a of Nothing -> Nothing Just b -> case g b of Nothing -> Nothing Just (c, d) -> ... into do b <- f a (c, d) <- g b ... which is much more comprehensible (and equivalent to the above). It took me a long time before I realized I could do this, and as a result I had a lot of nested case statements regarding Maybes. Actually, I had even implemented my own mplus operator for Maybe (only of course it wasn't called that). For more complicated practical examples (and only sporadically documented), you could look at some of the darcs source code. DarcsIO defines a monadic class, which has both IO and other versions. FilePathMonad is a pretty simple monad that is in those classes, and allows you to apply patches just to a list of FilePaths. The other big DarcsIO-related monad is the SlurpMonad, defined in SlurpDirectory, which is a tad ugly, but does show off the niceness of defining a uniform monadic interface. PatchCommute defines a Maybe-like monad called Perhaps, which has three states, success, failure and unknown, for calculations where "failure" doesn't mean a mistake but rather an answer (the patches don't commute). This is just a tad weird, but seems to work pretty well. The Perhaps monad has a conversion with the Maybe monad which I actually use most of the time. If you want to see lots of usage of Perhaps, you could check out the darcs-conflicts branch (which has the new conflictor code): http://abridgegame.org/cgi-bin/darcs.cgi/darcs-unstable/PatchCommute.lhs?c=a... There are also in darcs a couple of parser monads (lazy and strict) and probably a few more monads hanging around that I haven't thought of. In short, there really are nice practical uses non-IO monads. -- David Roundy

David Roundy
A very nice simple starting monad from the Prelude to consider when thinking about these things is Maybe.
[...]
It took me a long time before I realized I could do this,
Wow, that's a really nice example.
For more complicated practical examples (and only sporadically documented), you could look at some of the darcs source code. [...]
Hmm, I've had on my list to look at the source of Darcs (and Pugs) as nice "real-life" large-scale programs. I'm not sure I'm ready yet, but maybe I should see how I go... Thanks for the comments, Paul. -- Heck: the place you go to you don't believe in Gosh. -- WinXPNews reader Mark G.

Hello Paul, Wednesday, August 03, 2005, 2:31:05 AM, you wrote: PM> Hmm, I've had on my list to look at the source of Darcs (and Pugs) as PM> nice "real-life" large-scale programs. I'm not sure I'm ready yet, PM> but maybe I should see how I go... i also recommend you Yi and my own FreeArc as examples of "imperative" programs. you can find references to these and other applications written in Haskell in famous "Haskell Communities and Activities Report". also don't skip source code of libraries, including thats included in ghc itself about your first question - read http://www.nomaware.com/monads/monad_tutorial.zip -- Best regards, Bulat mailto:bulatz@HotPOP.com

Bulat Ziganshin
about your first question - read http://www.nomaware.com/monads/monad_tutorial.zip
That's a great tutorial. Thanks for the pointer! Paul. -- C++ is history repeated as tragedy. Java is history repeated as farce. -- Scott McKay

Hello Paul, Wednesday, August 03, 2005, 12:03:49 AM, you wrote: PM> One thing I haven't found a really good discussion of, is practical PM> examples of building monads. There's plenty of discussion of the IO i recall one more usage of monads - to do parsing. read the following: http://www.cs.nott.ac.uk/~gmh//pearl.pdf http://www.cs.nott.ac.uk/~gmh//pearl.hs that is really beatiful - parsing monad used both for holding state (position in input stream) and to backtrack to alternative rules when parsing with current rule fails. these ideas also used in ParseC (parser combinators) library, which are widely used (read http://www.cs.uu.nl/people/daan/download/parsec/parsec.html) btw, just obstacles with creating more advanced parsing libraries with help of monads lead to inventing of arrows - more generalized variant of monads (see http://www.cs.chalmers.se/~rjmh/Papers/arrows.pdf) ps: another example can be CPS (continuation passing style) monads, but i know nothing about it, except for name :) may be someone can point me to tutorial? :) -- Best regards, Bulat mailto:bulatz@HotPOP.com
participants (11)
-
Bulat Ziganshin
-
David Roundy
-
Dinh Tien Tuan Anh
-
genneth
-
Greg Buchholz
-
Paul Moore
-
Peter Robinson
-
Philippa Cowderoy
-
Sebastian Sylvan
-
Stefan Holdermans
-
yoann padioleau