[Haskell-cafe] Tutorial on Haskell

2007-04-16 Thread Simon Peyton-Jones
Friends

I have agreed to give a 3-hr tutorial on Haskell at the Open Source Convention 
2007
http://conferences.oreillynet.com/os2007/

I'm quite excited about this: it is a great opportunity to expose Haskell to a 
bunch of smart folk, many of whom won't know much about Haskell.  My guess is 
that they'll be Linux/Perl/Ruby types, and they'll be practitioners rather than 
pointy-headed academics.

One possibility is to do a tutorial along the lines of "here's how to reverse a 
list", "here's what a type is" etc; you know the kind of thing.  But instead, 
I'd prefer to show them programs that they might consider *useful* rather than 
cute, and introduce the language along the way, as it were.

So this message is to ask you for your advice.  Many of you are exactly the 
kind of folk that come to OSCON --- except that you know Haskell.   So help me 
out:

Suggest concrete examples of programs that are
* small
* useful
* demonstrate Haskell's power
* preferably something that might be a bit
tricky in another language

For example, a possible unifying theme would be this:
http://haskell.org/haskellwiki/Simple_unix_tools

Another might be Don's cpu-scaling example
http://cgi.cse.unsw.edu.au/~dons/blog/2007/03/10

But there must be lots of others.  For example, there are lots in the blog 
entries that Don collects for the Haskell Weekly Newsletter.  But I'd like to 
use you as a filter: tell me your favourites, the examples you find compelling. 
 (It doesn't have to be *your* program... a URL to a great blog entry is just 
fine.)  Of course I'll give credit to the author.

Remember, the goal is _not_ "explain monads".  It's "Haskell is a great way to 
Get The Job Done".

Thanks!

Simon
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] type inference futility

2007-04-16 Thread Paul Wankadia

The following code has ambiguity, but I can't figure out how to get
around it.  Am I missing something trivial?  Am I going in the wrong
direction?  Thank you in advance for your time and for any help that
you can offer.


data MehQueue = MehQueue

class MehBase a where new :: IO a
instance MehBase MehQueue where new = return MehQueue

class (MehBase a) => HasShift a where shift :: a -> IO a
instance HasShift MehQueue where shift a = return a

main :: IO ()
main = do
x <- new
shift x
return ()


Please note that I intend to extend this example with MehStack,
HasPush and HasPop.  You can probably guess where I'm going with all
this.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Tutorial on Haskell

2007-04-16 Thread Steffen Mazanek

What about demonstrating the use of an Haskell interpreter as a pimped up
calculator?

multTable = putStr $ unlines [unlines [show x ++ ' ':show y ++ ' ':show
(x*y)|y<-[1..10]] | x<-[1..10]]

2007/4/16, Simon Peyton-Jones <[EMAIL PROTECTED]>:


Friends

I have agreed to give a 3-hr tutorial on Haskell at the Open Source
Convention 2007
http://conferences.oreillynet.com/os2007/

I'm quite excited about this: it is a great opportunity to expose Haskell
to a bunch of smart folk, many of whom won't know much about Haskell.  My
guess is that they'll be Linux/Perl/Ruby types, and they'll be practitioners
rather than pointy-headed academics.

One possibility is to do a tutorial along the lines of "here's how to
reverse a list", "here's what a type is" etc; you know the kind of
thing.  But instead, I'd prefer to show them programs that they might
consider *useful* rather than cute, and introduce the language along the
way, as it were.

So this message is to ask you for your advice.  Many of you are exactly
the kind of folk that come to OSCON --- except that you know Haskell.   So
help me out:

Suggest concrete examples of programs that are
* small
* useful
* demonstrate Haskell's power
* preferably something that might be a bit
tricky in another language

For example, a possible unifying theme would be this:
http://haskell.org/haskellwiki/Simple_unix_tools

Another might be Don's cpu-scaling example
http://cgi.cse.unsw.edu.au/~dons/blog/2007/03/10

But there must be lots of others.  For example, there are lots in the blog
entries that Don collects for the Haskell Weekly Newsletter.  But I'd like
to use you as a filter: tell me your favourites, the examples you find
compelling.  (It doesn't have to be *your* program... a URL to a great blog
entry is just fine.)  Of course I'll give credit to the author.

Remember, the goal is _not_ "explain monads".  It's "Haskell is a great
way to Get The Job Done".

Thanks!

Simon
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe





--
Dipl.-Inform. Steffen Mazanek
Institut für Softwaretechnologie
Fakultät Informatik

Universität der Bundeswehr München
85577 Neubiberg

Tel: +49 (0)89 6004-2505
Fax: +49 (0)89 6004-4447

E-Mail: [EMAIL PROTECTED]
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Tutorial on Haskell

2007-04-16 Thread Thomas Hartman

Give them a program that selects a bunch of files based on some
filtering criteria, and then does something to each file.

Kind of like find + xargs, but using haskell instead. Good recipe for sysadmins.

There was a recent example involving parsing raw emails into a thread here

http://groups.google.de/group/fa.haskell/browse_thread/thread/b80dc2836f63f270/4a020e087e5b2060?lnk=st&q=%22haskell+cafe%22+email+&rnum=3&hl=en#4a020e087e5b2060

Maybe that could be simplified and something could be based on that.

A one-liner using PCRE regex might also be of use.

2007/4/16, Simon Peyton-Jones <[EMAIL PROTECTED]>:

Friends

I have agreed to give a 3-hr tutorial on Haskell at the Open Source Convention 
2007
http://conferences.oreillynet.com/os2007/

I'm quite excited about this: it is a great opportunity to expose Haskell to a 
bunch of smart folk, many of whom won't know much about Haskell.  My guess is 
that they'll be Linux/Perl/Ruby types, and they'll be practitioners rather than 
pointy-headed academics.

One possibility is to do a tutorial along the lines of "here's how to reverse a list", 
"here's what a type is" etc; you know the kind of thing.  But instead, I'd prefer to show 
them programs that they might consider *useful* rather than cute, and introduce the language along 
the way, as it were.

So this message is to ask you for your advice.  Many of you are exactly the 
kind of folk that come to OSCON --- except that you know Haskell.   So help me 
out:

Suggest concrete examples of programs that are
* small
* useful
* demonstrate Haskell's power
* preferably something that might be a bit
tricky in another language

For example, a possible unifying theme would be this:
http://haskell.org/haskellwiki/Simple_unix_tools

Another might be Don's cpu-scaling example
http://cgi.cse.unsw.edu.au/~dons/blog/2007/03/10

But there must be lots of others.  For example, there are lots in the blog 
entries that Don collects for the Haskell Weekly Newsletter.  But I'd like to 
use you as a filter: tell me your favourites, the examples you find compelling. 
 (It doesn't have to be *your* program... a URL to a great blog entry is just 
fine.)  Of course I'll give credit to the author.

Remember, the goal is _not_ "explain monads".  It's "Haskell is a great way to Get 
The Job Done".

Thanks!

Simon
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Tutorial on Haskell

2007-04-16 Thread Dougal Stanton

On 16/04/07, Thomas Hartman <[EMAIL PROTECTED]> wrote:


Maybe that could be simplified and something could be based on that.

A one-liner using PCRE regex might also be of use.



Unless it can be performed with astounding dexterity, I don't think
try to beat, for example, Perl at its own game will produce worthwhile
results.

What, instead, is Haskell's unique selling point? Non-strictness?
Purity? Optional, composable, computation styles (ie, drop-in monads
for non-determinism, continuations, state etc)? Succinct and elegant
syntax? Something else?

Cheers,

D.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] k-minima in Haskell

2007-04-16 Thread Ronny Wichers Schreur

Yitz writes (in the Haskell Cafe):


This gives O(log k * (n + k)) execution in constant memory.


I guess that should be O(k) memory.


Cheers,

Ronny Wichers Schreur
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] Re: [Haskell] Re: ANN: wl-pprint-1.0: Wadler/Leijen pretty printer

2007-04-16 Thread Duncan Coutts
On Mon, 2007-04-16 at 10:08 +, Arthur van Leeuwen wrote:

> Goody! UU.PPrint is now on hackage! Regrettably, this does seem like
> a bit of a waste of time, as UU.PPrint was already cabalised as part
> of the Haskell Utrecht Tools at http://www.cs.uu.nl/wiki/HUT/
> which also contains the parser combinators and DData, Daan
> Leijen's datastructure library.
> 
> Doei, Arthur. (Who thinks Utrecht does too little marketing of its code :))

I'd like to note that uulib and uuagc have been included in Gentoo for
ages! :-)

Duncan

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] type inference futility

2007-04-16 Thread Felipe Almeida Lessa

On 4/16/07, Paul Wankadia <[EMAIL PROTECTED]> wrote:

The following code has ambiguity, but I can't figure out how to get
around it.  Am I missing something trivial?  Am I going in the wrong
direction?  Thank you in advance for your time and for any help that
you can offer.


How about changing


x <- new


to


x <- new :: IO MehQueue


?


I'm not a professional haskeller, probably there's a better alternative =).

Cheers,

--
Felipe.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Parallel executing of actions

2007-04-16 Thread Mitar

Hi!

On 4/16/07, Bertram Felgenhauer <[EMAIL PROTECTED]> wrote:

> Since all the threads block on a single MVar how do they run in
> parallel?

The idea is that before the threads block on the MVar, they run their
action x to completion.


The rendering crashes. I will have to precompute the values in threads
someway and then sequentially draw it? Any suggestion how to do that?


Mitar
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Parallel executing of actions

2007-04-16 Thread Pepe Iborra

On 16/04/2007, at 12:30, Mitar wrote:


Hi!

On 4/16/07, Bertram Felgenhauer  
<[EMAIL PROTECTED]> wrote:

> Since all the threads block on a single MVar how do they run in
> parallel?

The idea is that before the threads block on the MVar, they run their
action x to completion.


The rendering crashes. I will have to precompute the values in threads
someway and then sequentially draw it? Any suggestion how to do that?



Could it be that you are launching 400x300=120.000 new threads all at  
once?
If you are not doing it already, it would be sensible to implement  
some pooling of threads.


This is what I use myself, don't worry about the unsafeness IF you  
know that the sequence of computations doesn't matter:


\begin{code}
unsafeParMapM :: (a -> IO b) -> [a] -> IO [b]
unsafeParMapM f = return . parMap rwhnf (unsafePerformIO . f)

unsafeParMapMn :: Integral bound => bound -> (a -> IO b) -> [a] -> IO  
[b]

unsafeParMapMn max f xx = return (map (unsafePerformIO . f) xx
`using`
  parListChunk (fromIntegral max) rwhnf)

unsafeParSeqn :: Integral bound => bound -> [IO a] -> IO [a]
unsafeParSeqn max cc = return ((map unsafePerformIO cc)
`using`
   parListChunk (fromIntegral max) rwhnf)
\begin{code}


___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Tutorial on Haskell

2007-04-16 Thread Thomas Hartman

There may be something to this point of view.

On the other hand, it is easier for me to see examples that can
connect back to something I am already familiar with.

That said, I will mention something where perl *seemed* to be a fit,
but later proved frustrating. To whit -- Doing something at the shell
level, in parallel. Ideally, in such a way that it could scale to, for
example, multiple processes on a multi processor box, or even
distributed map-reduce using a botnet.

I just couldn't figure out a good way to do this in perl, despite a
recently published map-reduce module to the CPAN. It all just seemed
to get icky. I couldn't "plug in" my bits of finished code in the way
I would have liked to, forking and other fiddly bits just seemed to
get in the way.

Now, this is probably largely due to my inexperience with "parallel"
thinking. However, I think part of it is also the limitations in the
language.

My simple task was to download a bunch of urls. This could be done
with wget. What I got frustrated with was, speeding this up by doing
things in parallel. There are a number of modules on the CPAN that
purport to help with this... parallel fork manager... parallel web
user agent... others... but things got messy fast, even through the
core task (fetch a url) was extremely simple. That is something that
got me thinking.

So, an example to take a simple task (eg web fetch, but could be
something else), and then scale it to work in parallel -- with
threads, with map reduce, howsoever -- might be a good show of
haskell's strehgths. I think there was even a post to haskell cafe
about this today.

To recap: transform a piece of simple code that works in serial, so it
works in parallel. Maybe even a couple, or three ways: using forks,
using threads, using map reduce.

Compare and contrast this with doing the same transformation in perl.
Perl should be messier.

Hope this helps...

2007/4/16, Dougal Stanton <[EMAIL PROTECTED]>:

On 16/04/07, Thomas Hartman <[EMAIL PROTECTED]> wrote:

> Maybe that could be simplified and something could be based on that.
>
> A one-liner using PCRE regex might also be of use.
>

Unless it can be performed with astounding dexterity, I don't think
try to beat, for example, Perl at its own game will produce worthwhile
results.

What, instead, is Haskell's unique selling point? Non-strictness?
Purity? Optional, composable, computation styles (ie, drop-in monads
for non-determinism, continuations, state etc)? Succinct and elegant
syntax? Something else?

Cheers,

D.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Tutorial on Haskell

2007-04-16 Thread Neil Bartlett
Well, given that concurrency is a hot topic at the moment, how about
something based on STM?

E.g. perhaps some kind of instant messaging server? Or "Twitter" except
scalable. By ruthlessly eliminating features, you could get the core of
one of these down to something that could be built in three hours.

But please, no Santa Clauses ;-)

Neil

> Friends
>
> I have agreed to give a 3-hr tutorial on Haskell at the Open Source
Convention 2007
> http://conferences.oreillynet.com/os2007/
>
> I'm quite excited about this: it is a great opportunity to expose
Haskell to a bunch of smart folk, many of whom won't know much about
Haskell.  My guess is that they'll be Linux/Perl/Ruby types, and they'll
be
> practitioners rather than pointy-headed academics.
>
> One possibility is to do a tutorial along the lines of "here's how to
reverse a list", "here's what a type is" etc; you know the kind of
thing. But instead, I'd prefer to show them programs that they might
consider *useful* rather than cute, and introduce the language along the
way, as it were.
>
> So this message is to ask you for your advice.  Many of you are exactly
the kind of folk that come to OSCON --- except that you know Haskell.  
So help me out:
>
> Suggest concrete examples of programs that are
> * small
> * useful
> * demonstrate Haskell's power
> * preferably something that might be a bit
> tricky in another language
>
> For example, a possible unifying theme would be this:
> http://haskell.org/haskellwiki/Simple_unix_tools
>
> Another might be Don's cpu-scaling example
> http://cgi.cse.unsw.edu.au/~dons/blog/2007/03/10
>
> But there must be lots of others.  For example, there are lots in the
blog entries that Don collects for the Haskell Weekly Newsletter.  But
I'd like to use you as a filter: tell me your favourites, the examples
you find compelling.  (It doesn't have to be *your* program... a URL to
a great blog entry is just fine.)  Of course I'll give credit to the
author.
>
> Remember, the goal is _not_ "explain monads".  It's "Haskell is a great
way to Get The Job Done".
>
> Thanks!
>
> Simon
> ___
> Haskell-Cafe mailing list
> Haskell-Cafe@haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe
>




___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Tutorial on Haskell

2007-04-16 Thread Ketil Malde
On Mon, 2007-04-16 at 13:27 +0200, Thomas Hartman wrote:

> To recap: transform a piece of simple code that works in serial, so it
> works in parallel. Maybe even a couple, or three ways: using forks,
> using threads, using map reduce.

This made me think of one of my favorite observations.

You occasionally hear how the wonderful static type system just forces
your program to be correct: if they compile, they work.  We all know
that this is an exaggeration, but there is one case when this seems to
apply - when refactoring already working code.

IME, it seems that whenever I tear my programs apart, as long as the
type checker agrees the pieces all fit back together, the program works
as i expect it to.

(Perhaps not so easy to apply this to a tutorial setting?)

-k

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Re: Translating perl -> haskell, string "fill ins" with an error on invalid inputseems awfullycomplex. Is there a way to simplify?

2007-04-16 Thread Thomas Hartman

With regards to the variable interpolation in strings problem, it's
probably worth watching

http://groups.google.de/group/fa.haskell/browse_thread/thread/34741c2a5c311a17/286dbd62748ef1c1?lnk=st&q=%22haskell+cafe%22+%22template+system%22&rnum=1&hl=en#286dbd62748ef1c1

which mentions some perl/python-like template systems in the works for haskell.

2007/4/16, jeff p <[EMAIL PROTECTED]>:

{

Hello,

  Here is a variation on Claus' code which returns an Either type
rather than fails with error. This could be further generalized to use
any instance of MonadError, rather than Either.

-Jeff

}

import Control.Monad.Error

financial_output :: String -> String -> String -> String -> Either String String
financial_output company displaymode startDate endDate = financial_script
where
  financial_script = gnuplot_timeseries_settings <++> "\n"
 <++> "plot [\"" <++> startDate <++> "\":\""
<++> endDate <++> "\"]"
 <++> " '" <++> companyFile <++> "'" <++> modeString
 <++> " title \"" <++> company <++> " " <++>
titleEnd <++> "\""

  companyFile = lookupWith ("no company file for " ++ company)
company company_to_companyfile

  modeString  = lookupWith ("no mode string for " ++ displaymode)
displaymode displaymode_to_modestring

  titleEnd= lookupWith ("no title end for " ++ displaymode)
displaymode displaymode_to_titleend

lookupWith :: (Eq a) => String -> a -> [(a,String)] -> Either String String
lookupWith error key assocs = maybe (Left error) Right $ lookup key assocs

class MyString a
where mystr :: a -> Either String String
instance MyString (Either String String)
where mystr = id
instance MyString String
where mystr = Right

x <++> y = do xv <- mystr x
  yv <- mystr y
  return $ xv ++ yv


___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] type inference futility

2007-04-16 Thread Paul Wankadia

Felipe Almeida Lessa <[EMAIL PROTECTED]> wrote:


How about changing

> x <- new

to

> x <- new :: IO MehQueue

?


Is it impossible for the compiler to infer the type from the methods called?

(-fweird-strange-sick-twisted-eerie-godless-evil-stuff!-and-i-want-in.)
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Tutorial on Haskell

2007-04-16 Thread Ketil Malde
On Mon, 2007-04-16 at 11:06 +0100, Dougal Stanton wrote:

> > A one-liner using PCRE regex might also be of use.

> Unless it can be performed with astounding dexterity, I don't think
> try to beat, for example, Perl at its own game will produce worthwhile
> results.

One possibility is a task where the Perl hacker will pull out regular
expressions, but where cleaner and more maintainable code can be written
using Haskell.  Possibly parsing a relatively simple, line based format
with 'words', 'concat', 'split', et al.?  Or a recursive format?

-k


___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Tutorial on Haskell

2007-04-16 Thread Sebastian Sylvan

On 4/16/07, Ketil Malde <[EMAIL PROTECTED]> wrote:


On Mon, 2007-04-16 at 13:27 +0200, Thomas Hartman wrote:

> To recap: transform a piece of simple code that works in serial, so it
> works in parallel. Maybe even a couple, or three ways: using forks,
> using threads, using map reduce.

This made me think of one of my favorite observations.

You occasionally hear how the wonderful static type system just forces
your program to be correct: if they compile, they work.  We all know
that this is an exaggeration,



No we don't! At least not anywhere near as much of an exaggeration as that
statement would be about an strongly typed imperative language (sequencing
can't be type checked*, imperative programs are mostly sequencing, thus
imperative programs are mostly unchecked).

Strong static typing + expression-based programming + rich support for
custom data types = "if the compiler doesn't beep, the program almost always
works".

I think this is a key selling point. Not sure how to convince people it's
actually true in a 3 hour tutorial, though.


* well, you can check scoping, but that's about it, right?



--
Sebastian Sylvan
+44(0)7857-300802
UIN: 44640862
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] Type classes and type equality

2007-04-16 Thread Neil Mitchell

Hi,

I'm looking for a type class which checks whether two types are the
same or not. My first guess is:

class Same a b where
  same :: a -> b -> Bool

instance Same a a where
  same _ _ = True

instance Same a b where
  same _ _ = False

In Hugs this seems to work with overlapping instances (not requiring
unsafe overlapping instances).

GHC requires {-# LANGUAGE MultiParamTypeClasses, IncoherentInstances #-}

So my question is if this is safe? Will the compiler always pick the
"right one"? Is there a better way to do this?

The alternative I thought of is using Typeable, but this is not
supported particularly well on Hugs (no deriving Typeable) and would
require modifications to the existing data structures (additional
derivings) so is not such a good choice.

Thanks

Neil
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Tutorial on Haskell

2007-04-16 Thread Hans van Thiel
On Mon, 2007-04-16 at 09:34 +0100, Simon Peyton-Jones wrote:
> Friends
> 
> I have agreed to give a 3-hr tutorial on Haskell at the Open Source 
> Convention 2007
> http://conferences.oreillynet.com/os2007/
> 
> I'm quite excited about this: it is a great opportunity to expose Haskell to 
> a bunch of smart folk, many of whom won't know much about Haskell.  My guess 
> is that they'll be Linux/Perl/Ruby types, and they'll be practitioners rather 
> than pointy-headed academics.
> 
> One possibility is to do a tutorial along the lines of "here's how to reverse 
> a list", "here's what a type is" etc; you know the kind of thing.  But 
> instead, I'd prefer to show them programs that they might consider *useful* 
> rather than cute, and introduce the language along the way, as it were.
> 
> So this message is to ask you for your advice.  Many of you are exactly the 
> kind of folk that come to OSCON --- except that you know Haskell.   So help 
> me out:
> 
> Suggest concrete examples of programs that are
> * small
> * useful
> * demonstrate Haskell's power
> * preferably something that might be a bit
> tricky in another language
> 
> For example, a possible unifying theme would be this:
> http://haskell.org/haskellwiki/Simple_unix_tools
> 
> Another might be Don's cpu-scaling example
> http://cgi.cse.unsw.edu.au/~dons/blog/2007/03/10
> 
> But there must be lots of others.  For example, there are lots in the blog 
> entries that Don collects for the Haskell Weekly Newsletter.  But I'd like to 
> use you as a filter: tell me your favourites, the examples you find 
> compelling.  (It doesn't have to be *your* program... a URL to a great blog 
> entry is just fine.)  Of course I'll give credit to the author.
> 
> Remember, the goal is _not_ "explain monads".  It's "Haskell is a great way 
> to Get The Job Done".
> 
> Thanks!
> 
> Simon
I'm really enthusiastic about parsec. Even though the principles are
(still) far above my head, I've been able to use it on a .csv table
produced by OO Calc (the spreadsheet). The tutorial is also very good,
and maybe parsec is also an example of (possible) interaction of Haskell
to 'modules' written in other programming languages. You can do
something (simple but useful)  with parsec after just an afternoon's
reading.

fwiw, summing up my own Haskell experience:
I've been learning Haskell for a year now, and I find it very difficult.
I miss a training in computer science and often I feel like the guy in
that movie who's on a 500 mile trip driving an old lawn mower. Traffic
zooms past, and  often you depend on people who're willing to lend a
hand. Having said that, it's also fun and I enjoy the pioneer spirit in
the community.

The major advantages of Haskell are, IMO,

1) the type system is a great aid to the programmer and programs are
short. Therefore Haskell is very well suited for the independent
developer who can't afford huge amounts of code. Open Source has many of
those.
2) polymorphism is also a great advantage. You can write your program in
the most general types using e.g. only equality and order, and fine tune
them later to more specific types which perform better.
3) the difficulty of Haskell is not necessarily a bad thing, it also
makes it interesting, and there are many good libraries to use. But
Haskell is also pretty scaleable, in the sense that you can do a lot of
things just with recursion, then do them better with maps, folds, list
comprehensions, then do them better with some monadic replacements, and
so on.
4) there is a very helpful and knowledgeable community.

A major disadvantage of Haskell is the lack of books, especially with
regard to intermediate level programming and the libraries.
Documentation that is available varies in quality and is, in general,
fragmented. 

Best Regards,

Hans van Thiel


___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Tutorial on Haskell

2007-04-16 Thread Neil Mitchell

Hi

I think its important to cover whats different about Haskell. Things
like laziness are cool, but are harder to convince a strict programmer
that they are useful. Types however are obviously very handy, if you
can focus on why a Haskell program is so obviously correct easily.


1) the type system is a great aid to the programmer and programs are
short. Therefore Haskell is very well suited for the independent
developer who can't afford huge amounts of code. Open Source has many of
those.


I'd also at least demonstrate Hoogle, but perhaps I'm biased :-)


2) polymorphism is also a great advantage. You can write your program in
the most general types using e.g. only equality and order, and fine tune
them later to more specific types which perform better.


I'd also focus on the fact that polymorphism can be inferred, in
things like C++/Ada using polymorphism means littering the code with
hints about the polymorphism.

Thanks

Neil
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] partial kinds and instances

2007-04-16 Thread Matthew Pocock
Hi,

I saw that it's possible to peal off kinds from the right-hand side when 
instantiating classes. Is it possible to peel them off from the left-hand 
side? Or in any order?

I have been told in #haskell by people who seems to know that Very Bad Things 
happen if you do this without also making the kind system more clever.

Is there a quick fix that will give me the same effect, without introducing a 
newtype or re-writing the original type declaration to introduce the extra 
types in a different order?

Illustrative code below.

Matthew

data MyType e = Singleton e  

data MyOtherType k v 
  = Empty
  | Node k v

data YetAnotherType k v
  = OtherEmpty
  | OtherNode k v

type RevYAT v k = YetAnotherType k v

class Iterable ite where
  iterate :: ite e -> [e]

instance Iterable MyType where
  iterate (Singleton e) = [e]

instance Iterable (MyOtherType k) where
  iterate ite = []  --broken but illustrative

instance Iterable (RevYAT v) where
  iterate it = []  --broken again

   Type synonym `RevMOM' should have 2 arguments, but has been given 1
In the instance declaration for `Iterable (RevYAT v)'
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Re: Translating perl -> haskell, string "fill ins" with an error on invalid inputseems awfullycomplex.Is there a way to simplify?

2007-04-16 Thread Claus Reinke

With regards to the variable interpolation in strings problem, ..


as i mentioned, it is not difficult to hack something up, and in many cases,
efficiency doesn't matter much for this part of the problem (though a standard,
efficient, well-designed library would be welcome). but if we compare the 
attached
example with here docs in perl or shell or .., we find that we can get rid of 
all that
escaping and concatenation in strings, but:

   - the file name should be implicit (the current source)
   - the dictionary should be implicit (the current variable environment)

the former might be easy to add to the language, and the latter would be a minor
subset of template haskell functionality. but they need to be standardized and 
widely available to be of much use.


claus

ps here's the output:

$ runhaskell Here.hs

this is a poor man's here-document

with quotes ", and escapes \,
and line-breaks, and layout
without escaping \" \\ \n,
without concatenation.

oh, and with some variables, $(too).




very important page



this is a poor man's here-document

with quotes ", and escapes \,
and line-breaks, and layout
without escaping \" \\ \n,
without concatenation.

oh, and with some variables, $(too).







Here.hs
Description: Binary data
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Tutorial on Haskell

2007-04-16 Thread Derek Elkins

Hans van Thiel wrote:

On Mon, 2007-04-16 at 09:34 +0100, Simon Peyton-Jones wrote:

Friends

I have agreed to give a 3-hr tutorial on Haskell at the Open Source Convention 
2007
http://conferences.oreillynet.com/os2007/

I'm quite excited about this: it is a great opportunity to expose Haskell to a 
bunch of smart folk, many of whom won't know much about Haskell.  My guess is 
that they'll be Linux/Perl/Ruby types, and they'll be practitioners rather than 
pointy-headed academics.

One possibility is to do a tutorial along the lines of "here's how to reverse a list", 
"here's what a type is" etc; you know the kind of thing.  But instead, I'd prefer to show 
them programs that they might consider *useful* rather than cute, and introduce the language along 
the way, as it were.

So this message is to ask you for your advice.  Many of you are exactly the 
kind of folk that come to OSCON --- except that you know Haskell.   So help me 
out:

Suggest concrete examples of programs that are
* small
* useful
* demonstrate Haskell's power
* preferably something that might be a bit
tricky in another language

For example, a possible unifying theme would be this:
http://haskell.org/haskellwiki/Simple_unix_tools


 >> Another might be Don's cpu-scaling example

http://cgi.cse.unsw.edu.au/~dons/blog/2007/03/10

But there must be lots of others.  For example, there are lots in the blog 
entries that Don collects for the Haskell Weekly Newsletter.  But I'd like to 
use you as a filter: tell me your favourites, the examples you find compelling. 
 (It doesn't have to be *your* program... a URL to a great blog entry is just 
fine.)  Of course I'll give credit to the author.

Remember, the goal is _not_ "explain monads".  It's "Haskell is a great way to Get 
The Job Done".

Thanks!

Simon



I'm really enthusiastic about parsec. Even though the principles are

[cut]

4) there is a very helpful and knowledgeable community.


It is significant that Parsec has been and continues to be a lure of Haskell.

Also, the community, in my opinion, is one of the greatest boons of the 
language, but I'm not sure how to convey that.


This blog article 
(http://blog.moertel.com/articles/2006/10/18/a-type-based-solution-to-the-strings-problem) 
was/is fairly popular and demonstrates many aspects of Haskell and the way 
Haskellers think.


Some of the recent ByteString stuff that does interesting things faster and much 
cleaner than C may also be a good example.

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Tutorial on Haskell

2007-04-16 Thread Nicolas Frisby

One technique I find compelling is (ab)using the type class system for
meta programming. Something from Lightweight Static Resources, Faking
It, or Hinze's Full Circle slides might be really attractive. Perhaps
Danvy's Haskell printf? The hook might be:

"Yeah, you've heard of strong static typing and polymorphism, but did
you know you could do this?"

Also: generic programming is always a hot topic.

On 4/16/07, Simon Peyton-Jones <[EMAIL PROTECTED]> wrote:

Friends

I have agreed to give a 3-hr tutorial on Haskell at the Open Source Convention 
2007
http://conferences.oreillynet.com/os2007/

I'm quite excited about this: it is a great opportunity to expose Haskell to a 
bunch of smart folk, many of whom won't know much about Haskell.  My guess is 
that they'll be Linux/Perl/Ruby types, and they'll be practitioners rather than 
pointy-headed academics.

One possibility is to do a tutorial along the lines of "here's how to reverse a list", 
"here's what a type is" etc; you know the kind of thing.  But instead, I'd prefer to show 
them programs that they might consider *useful* rather than cute, and introduce the language along 
the way, as it were.

So this message is to ask you for your advice.  Many of you are exactly the 
kind of folk that come to OSCON --- except that you know Haskell.   So help me 
out:

Suggest concrete examples of programs that are
* small
* useful
* demonstrate Haskell's power
* preferably something that might be a bit
tricky in another language

For example, a possible unifying theme would be this:
http://haskell.org/haskellwiki/Simple_unix_tools

Another might be Don's cpu-scaling example
http://cgi.cse.unsw.edu.au/~dons/blog/2007/03/10

But there must be lots of others.  For example, there are lots in the blog 
entries that Don collects for the Haskell Weekly Newsletter.  But I'd like to 
use you as a filter: tell me your favourites, the examples you find compelling. 
 (It doesn't have to be *your* program... a URL to a great blog entry is just 
fine.)  Of course I'll give credit to the author.

Remember, the goal is _not_ "explain monads".  It's "Haskell is a great way to Get 
The Job Done".

Thanks!

Simon
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Re: Translating perl -> haskell, string "fill ins" with an error on invalid inputseems awfullycomplex.Is there a way to simplify?

2007-04-16 Thread Thomas Hartman

I put this on the haskell wiki at

http://haskell.org/haskellwiki/Poor_Man%27s_Heredoc_in_Haskell

So far I have only linked this from
http://haskell.org/haskellwiki/Simple_unix_tools

I feel like the wiki deserves a section on "Haskell Template
Solutions" distinct from this. However, there is a bit of a namespace
conflict, as "template haskell" is a ghc extension, and so if you
google on it you will get all stuff first.

I wonder if anyone has an opinion on a good title for a wiki page about this.

Haskell String Interpolation?
Haskell String Templates?

But these sound clunky to me.

2007/4/16, Claus Reinke <[EMAIL PROTECTED]>:

> With regards to the variable interpolation in strings problem, ..

as i mentioned, it is not difficult to hack something up, and in many cases,
efficiency doesn't matter much for this part of the problem (though a standard,
efficient, well-designed library would be welcome). but if we compare the 
attached
example with here docs in perl or shell or .., we find that we can get rid of 
all that
escaping and concatenation in strings, but:

- the file name should be implicit (the current source)
- the dictionary should be implicit (the current variable environment)

the former might be easy to add to the language, and the latter would be a minor
subset of template haskell functionality. but they need to be standardized and
widely available to be of much use.

claus

ps here's the output:

$ runhaskell Here.hs

this is a poor man's here-document

with quotes ", and escapes \,
and line-breaks, and layout
without escaping \" \\ \n,
without concatenation.

oh, and with some variables, $(too).




very important page



this is a poor man's here-document

with quotes ", and escapes \,
and line-breaks, and layout
without escaping \" \\ \n,
without concatenation.

oh, and with some variables, $(too).








___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


RE: [Haskell-cafe] Tutorial on Haskell

2007-04-16 Thread Taillefer, Troy (EXP)
Simon,

Hopefully a video of this tutorial would be made available as a learning
resource for those of use who can't make it to this Convention. 

Troy
  

-Original Message-
From: [EMAIL PROTECTED]
[mailto:[EMAIL PROTECTED] On Behalf Of Simon
Peyton-Jones
Sent: Monday, April 16, 2007 4:34 AM
To: haskell-cafe@haskell.org
Subject: [Haskell-cafe] Tutorial on Haskell

Friends

I have agreed to give a 3-hr tutorial on Haskell at the Open Source
Convention 2007
http://conferences.oreillynet.com/os2007/

I'm quite excited about this: it is a great opportunity to expose
Haskell to a bunch of smart folk, many of whom won't know much about
Haskell.  My guess is that they'll be Linux/Perl/Ruby types, and they'll
be practitioners rather than pointy-headed academics.

One possibility is to do a tutorial along the lines of "here's how to
reverse a list", "here's what a type is" etc; you know the kind of
thing.  But instead, I'd prefer to show them programs that they might
consider *useful* rather than cute, and introduce the language along the
way, as it were.

So this message is to ask you for your advice.  Many of you are exactly
the kind of folk that come to OSCON --- except that you know Haskell.
So help me out:

Suggest concrete examples of programs that are
* small
* useful
* demonstrate Haskell's power
* preferably something that might be a bit
tricky in another language

For example, a possible unifying theme would be this:
http://haskell.org/haskellwiki/Simple_unix_tools

Another might be Don's cpu-scaling example
http://cgi.cse.unsw.edu.au/~dons/blog/2007/03/10

But there must be lots of others.  For example, there are lots in the
blog entries that Don collects for the Haskell Weekly Newsletter.  But
I'd like to use you as a filter: tell me your favourites, the examples
you find compelling.  (It doesn't have to be *your* program... a URL to
a great blog entry is just fine.)  Of course I'll give credit to the
author.

Remember, the goal is _not_ "explain monads".  It's "Haskell is a great
way to Get The Job Done".

Thanks!

Simon
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] System.Random

2007-04-16 Thread Ketil Malde
Hi,

I've recently stumbled upon some issues with the System.Random module,
and thought I'd try to remedy them.  However, I'm not quite sure what an
optimal resolution is.

Problem 1 is that I often get the same "random" number on consecutive
program runs [1].  Looking at the code for initialization (called with
'0' argument on program start):

  mkStdRNG :: Integer -> IO StdGen
  mkStdRNG o = do
  ct  <- getCPUTime
  (TOD sec ms) <- getClockTime
  return (createStdGen (sec * 12345 + ms + ct + o))

Considering that 'getCPUTime' tends to return 0 early in the program,
and that we simply ignore the picosecond part of 'getClockTime', it's
fairly obvious why we get this result.  What is not obvious is the
rationale for discarding 'ms', or for that matter, the 12345
multiplication - can anybody shed some light on this?

Anyway, on my Linux system, I get (unsurprisingly considering the
defintion of time_t) picoseconds in even millions, and successive calls
to getClockTime are not successive enough to give the same result in my
cases.  A better implementation would perhaps use /dev/urandom, but that
is possibly not portable enough?

The second issue is reading the random state from a string [2]. I
realize (as Simon points out) that you can use 'reads' to get the
remainder of the string, but as many find it confusing (at least the OP
and I :-), I wonder what the rationale is behind this kind of interface?

And checking how the state is actually calculated:

  stdFromString :: String -> (StdGen, String)
  stdFromString s= (mkStdGen num, rest)
where (cs, rest) = splitAt 6 s
  num= foldl (\a x -> x + 3 * a) 1 (map ord cs)

So, it picks six chars, and folds them into an Int for mkStdGen.  Now,
this number (due to the low multiplier) never exceeds 93549.  Since we
have an Int of state, why not use the whole range?  Why not fold with a
multiplier of 256?

(All of this is trivial to fix of course, but I worry about changing
code I don't understand the rationale behind.)

One final question: are there build and install instructions for 'base'?
I got the code from darcs, but I haven't find a way to build it and
replace the bundled 'base' with a new version.

-k

References:

[1] http://hackage.haskell.org/trac/ghc/ticket/1272
[2] http://www.nabble.com/Re%
3A--Haskell-cafe--System.Random-StdGen-read-fails-on-some-strings--tf3394495.html#a9450043
[3]
http://web.archive.org/web/20011027002011/http://dilbert.com/comics/dilbert/archive/images/dilbert2001182781025.gif

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


RE: [Haskell-cafe] Tutorial on Haskell

2007-04-16 Thread Simon Peyton-Jones
Hopefully!  Do suggest it to the OSCON organisers: the one I'm in touch with is 
Vee McMillen [EMAIL PROTECTED]

Simon

| -Original Message-
| From: [EMAIL PROTECTED] [mailto:[EMAIL PROTECTED] On Behalf Of
| Taillefer, Troy (EXP)
| Sent: 16 April 2007 15:08
| To: Simon Peyton-Jones; haskell-cafe@haskell.org
| Subject: RE: [Haskell-cafe] Tutorial on Haskell
|
| Simon,
|
| Hopefully a video of this tutorial would be made available as a learning
| resource for those of use who can't make it to this Convention.
|
| Troy
|
|
| -Original Message-
| From: [EMAIL PROTECTED]
| [mailto:[EMAIL PROTECTED] On Behalf Of Simon
| Peyton-Jones
| Sent: Monday, April 16, 2007 4:34 AM
| To: haskell-cafe@haskell.org
| Subject: [Haskell-cafe] Tutorial on Haskell
|
| Friends
|
| I have agreed to give a 3-hr tutorial on Haskell at the Open Source
| Convention 2007
| http://conferences.oreillynet.com/os2007/
|
| I'm quite excited about this: it is a great opportunity to expose
| Haskell to a bunch of smart folk, many of whom won't know much about
| Haskell.  My guess is that they'll be Linux/Perl/Ruby types, and they'll
| be practitioners rather than pointy-headed academics.
|
| One possibility is to do a tutorial along the lines of "here's how to
| reverse a list", "here's what a type is" etc; you know the kind of
| thing.  But instead, I'd prefer to show them programs that they might
| consider *useful* rather than cute, and introduce the language along the
| way, as it were.
|
| So this message is to ask you for your advice.  Many of you are exactly
| the kind of folk that come to OSCON --- except that you know Haskell.
| So help me out:
|
| Suggest concrete examples of programs that are
| * small
| * useful
| * demonstrate Haskell's power
| * preferably something that might be a bit
| tricky in another language
|
| For example, a possible unifying theme would be this:
| http://haskell.org/haskellwiki/Simple_unix_tools
|
| Another might be Don's cpu-scaling example
| http://cgi.cse.unsw.edu.au/~dons/blog/2007/03/10
|
| But there must be lots of others.  For example, there are lots in the
| blog entries that Don collects for the Haskell Weekly Newsletter.  But
| I'd like to use you as a filter: tell me your favourites, the examples
| you find compelling.  (It doesn't have to be *your* program... a URL to
| a great blog entry is just fine.)  Of course I'll give credit to the
| author.
|
| Remember, the goal is _not_ "explain monads".  It's "Haskell is a great
| way to Get The Job Done".
|
| Thanks!
|
| Simon
| ___
| Haskell-Cafe mailing list
| Haskell-Cafe@haskell.org
| http://www.haskell.org/mailman/listinfo/haskell-cafe
| ___
| Haskell-Cafe mailing list
| Haskell-Cafe@haskell.org
| http://www.haskell.org/mailman/listinfo/haskell-cafe
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] Re: Tutorial on Haskell

2007-04-16 Thread Stefan Monnier
> No we don't! At least not anywhere near as much of an exaggeration as that
> statement would be about an strongly typed imperative language (sequencing
> can't be type checked*, imperative programs are mostly sequencing, thus
> imperative programs are mostly unchecked).

Actually, side effects *can* be type checked, but it's a lot more painful
(the type of an assignment is not nearly as simple as the one you're used to).


Stefan

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Tutorial on Haskell

2007-04-16 Thread Mark T.B. Carroll
"Neil Mitchell" <[EMAIL PROTECTED]> writes:
(snip)
> I think its important to cover whats different about Haskell. Things
> like laziness are cool, but are harder to convince a strict programmer
> that they are useful.
(snip)

Mmmm, it took me a while to really find laziness useful, and that was
normally to let me create complex things that were mutually dependent on
each other, releasing me from some housekeeping - some calculation in
one would help the other creep along, and vice versa. I'm afraid no
examples come easily to mind, though.

BTW, I wonder if it's too much difficulty to show off STM.

-- Mark

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] Re: Tutorial on Haskell

2007-04-16 Thread apfelmus
Simon Peyton-Jones wrote:
> I have agreed to give a 3-hr tutorial on Haskell at the Open Source 
> Convention 2007
> http://conferences.oreillynet.com/os2007/
> 
> I'm quite excited about this: it is a great opportunity to expose Haskell to 
> a bunch of smart folk,
> many of whom won't know much about Haskell.  My guess is that they'll
be Linux/Perl/Ruby types,
> and they'll be practitioners rather than pointy-headed academics.
> 
> One possibility is to do a tutorial along the lines of "here's how to reverse 
> a list",
> "here's what a type is" etc; you know the kind of thing.
> But instead, I'd prefer to show them programs that they might consider
*useful*
> rather than cute, and introduce the language along the way, as it were.
>
> [...]
>
> Remember, the goal is _not_ "explain monads".
> It's "Haskell is a great way to Get The Job Done".

While this it not a concrete suggestion for an example, I'd like to say
why I can't help but program in Haskell: it gives me power. Programming
in Haskell is like dual-wielding two light sabers whereas programming in
imperative languages is like being equipped with a blunt kitchen knife.
Sure, cleverly used, you can dissect problems with the knife but the
light saber will disintegrate them instantly. If I were to give a
tutorial, I would concentrate on showcasing such power.

My current favorite example of power is the k-minima problem that has
been discussed on this list:

   take k . quicksort

Why is this program correct? Because it's almost the problem
specification and because the type checker accepts it. But is it fast?
Sure it is, because lazy evaluation does miracles (at least here ;).
What else? The sugar on top is that this program is polymorphic.

The above example is probably not considered "useful". To me, useful =
asymptotically fast algorithm for a difficult problem, and I'm always
astonished how incredibly easy it is to formulate or even derive a
Haskell program that introduces the missing logarithm. But somehow, the
word "performance" that people cry for doesn't seem to be related to
that. At least, that's the impression I get when experiencing the
sluggishness of certain programs.

Anyway, maybe a showcase of power would be if the talk talks about how
to create talks in Haskell, especially the talk being held. I mean that
the showcased example could be to build a small type-setting/graphics/PS
or PDF system in Haskell from scratch that is capable of producing the
slides for the talk itself. This would include

  * a simple dynamic programming type-setting algorithm
(performance)
  * a simple, preferably external (XMl, Parsec, ...) language for
describing slides with some macro capabilities (like variables
and substitution, perhaps even recursion or loops, slide numbers!)
(expressiveness)
  * a small vector graphics library (for text and a few visual gimmicks)
that can output to PDF (or PostScript for simplicity).
(polymorphism: one API, different backends).

The point is of course: "With Haskell, I'm not only able to create my
slides from scratch, but I can even completely explain the code to you
in only 3 hours!".

Regards,
apfelmus

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] ghci Crashing...

2007-04-16 Thread Gaetano Caruana

Hi all. I am new to this list ;) Today I have encountered something new that
has never happened to me in the past 6 months that I have been using ghci
and Haskell.

I wrote this function:


type Line = (Point,Point)
type Point = (Float,Float)

circleLineIntersection :: Float -> Float -> Float -> Line -> Maybe [Point]
circleLineIntersection h k r ((x1,y1),(x2,y2)) = do
   let
   perpdist =
calcPerpDist (h,k) ((x1,y1),(x2,y2))
   noSolution =
perpdist > r
   oneSolution =
perpdist  == r
   twoSolutions =
perpdist < r
in
   do
 if noSolution then
 Nothing
  else
 let
 dx = x2 -
x1
 dy = y2 -
y1
 dr = sqrt
(dx * dx + dy * dy)
 bigD = x1
* y2 - x2 * y1
 x1 = (
bigD * dy + sign (dy) * dx  * sqrt( r * r * dr * dr - bigD * bigD  ) ) / (dr
* dr)
 y1 = -
bigD * dx + abs(dy) * sqrt( r * r * dr * dr - bigD * bigD  )  / (dr * dr)
 x2 = (
bigD * dy - sign (dy) * dx  * sqrt( r * r * dr * dr - bigD * bigD  ) ) / (dr
* dr)
 y2 = -
bigD * dx - abs(dy) * sqrt( r * r * dr * dr - bigD * bigD  )  / (dr * dr)

in
   if oneSolution
then
 do
 Just
[(x1,y1)]
   else
 do
   Just
[(x1,y1),(x2,y2)]

Compiling is fine...
When I run the function like this

circleLineIntersection 1 1 1 ((1,1),(2,2))

it simply outputs
Just [(

No CPU usage.
I am using fglasgow-exts

Thanks for your help.

Gaetano
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] ghci Crashing...

2007-04-16 Thread Henning Thielemann

On Mon, 16 Apr 2007, Gaetano Caruana wrote:

> Hi all. I am new to this list ;) Today I have encountered something new that
> has never happened to me in the past 6 months that I have been using ghci
> and Haskell.
>
> I wrote this function:
>
>
> type Line = (Point,Point)
> type Point = (Float,Float)
>
> circleLineIntersection :: Float -> Float -> Float -> Line -> Maybe [Point]
> circleLineIntersection h k r ((x1,y1),(x2,y2)) = do

no 'do' is needed here

> let
> perpdist =
> calcPerpDist (h,k) ((x1,y1),(x2,y2))
> noSolution =
> perpdist > r
> oneSolution =
> perpdist  == r
> twoSolutions =
> perpdist < r


case compare perpdist r of
  GT ->
  EQ ->
  LT ->

...

>  in
> do
>   if noSolution then
>   Nothing
>else
>   let
>   dx = x2 -
> x1
>   dy = y2 -
> y1
>   dr = sqrt
> (dx * dx + dy * dy)

Why computing sqrt if you only use dr*dr?

>   bigD = x1
> * y2 - x2 * y1
>   x1 = (
> bigD * dy + sign (dy) * dx  * sqrt( r * r * dr * dr - bigD * bigD  ) ) / (dr
> * dr)
>   y1 = -
> bigD * dx + abs(dy) * sqrt( r * r * dr * dr - bigD * bigD  )  / (dr * dr)
>   x2 = (
> bigD * dy - sign (dy) * dx  * sqrt( r * r * dr * dr - bigD * bigD  ) ) / (dr
> * dr)
>   y2 = -
> bigD * dx - abs(dy) * sqrt( r * r * dr * dr - bigD * bigD  )  / (dr * dr)


ghci -Wall should have warned you, that y2 shadows function argument y2.
Thus you programmed an infinite cycle.

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Tutorial on Haskell

2007-04-16 Thread Justin Bailey

I found this blog post, which describes a way to protect against "SQL
injection" attacks using the type system, to be really enlightening.

http://blog.moertel.com/articles/2006/10/18/a-type-based-solution-to-the-strings-problem

Justin
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] type inference futility

2007-04-16 Thread Peter Berry

On 16/04/07, Paul Wankadia <[EMAIL PROTECTED]> wrote:


Is it impossible for the compiler to infer the type from the methods called?


Your code:


main :: IO ()
main = do
x <- new



From the use of 'new', the compiler can infer that the type of x is an

instance of MehBase, and...


shift x


from the use of 'shift', that it is an instance of HasShift.


return ()


So we have x :: (MehBase a, HasShift a) => a. There isn't enough
information provided to pin down 'a' any more precisely, so GHC can't
figure out which 'new' or 'shift' you mean (remember that type classes
provide overloading), and gives up.

There is one special case where the compiler does infer a specific
type despite not having enough information to do so, and that is where
the class(es) is/are numeric. For example (Floating a) => a might
default to Float or Double. This is one case where the compiler
decides it can make 'reasonable' assumptions as to what you actually
wanted. It's also why ambiguous types seem to work in the interpreter,
if you've only ever looked at numeric ones. In the case of the code
you posted, GHC isn't smart enough to realise that there's only one
type in scope that satisfies the constraints.

Here's the relevant part of the report:
http://www.haskell.org/onlinereport/decls.html#sect4.3.4

Felipe's suggestion is probably the best way to fix it, i.e. tell the
compiler exactly which type you want. The report seems to suggest you
can give the compiler a list of defaults in the module declaration but
I don't know if that would be sensible.

--
Peter Berry <[EMAIL PROTECTED]>
Please avoid sending me Word or PowerPoint attachments.
See http://www.gnu.org/philosophy/no-word-attachments.html
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Tutorial on Haskell

2007-04-16 Thread Aaron Tomb


Having just read Simon Marlow's paper on the Haskell Web Server, I  
think it might be interesting to at least mention it, and how simple  
it is, while still performing well.


Also, I second the comment several have made so far that talking  
about concurrency is important. Haskell does it better than most  
languages, and people care about concurrency these days.


Admittedly, these aren't very concrete suggestions.

Aaron


___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] Re: release plans

2007-04-16 Thread Chad Scherrer

What do you think of this plan?  Are there features/bug-fixes that you really

want to see in 6.8?

I'm most anxious for parallel GC - do you think it will be another
release or two before this is a reality?

Thanks,
Chad
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Tutorial on Haskell

2007-04-16 Thread Bryan O'Sullivan

Mark T.B. Carroll wrote:


I'm afraid no
examples come easily to mind, though.


Here's a simple one: reading a flattened graph from disk.  If your 
flattened representation contains forward references, you have to fix 
them up in a strict language.  In a lazy language, you can refer to 
elements you haven't yet read, eliminating that book-keeping.


http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Tutorial on Haskell

2007-04-16 Thread Mark T.B. Carroll
Bryan O'Sullivan <[EMAIL PROTECTED]> writes:

> Mark T.B. Carroll wrote:
>
>> I'm afraid no
>> examples come easily to mind, though.
>
> Here's a simple one: reading a flattened graph from disk.  If your 
> flattened representation contains forward references, you have to fix 
> them up in a strict language.  In a lazy language, you can refer to 
> elements you haven't yet read, eliminating that book-keeping.

That's a good point. Indeed, I had used laziness in a programme that
read a file that contained a series of entity definitions that could
include forward references, I just couldn't remember exactly how I'd
used laziness. (-: (It's also useful in some memoising, I think.)

-- Mark

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Tutorial on Haskell

2007-04-16 Thread Bryan O'Sullivan

Neil Bartlett wrote:


E.g. perhaps some kind of instant messaging server? Or "Twitter" except
scalable.


A twitter-alike will quite probably get people's attention.  And of 
course anything that breaks the "it's good for compilers!" stereotype is 
to be commended :-)


Also on the subject of scaling, Ralf Lammel's paper on looking at 
MapReduce through a strongly typed functional lens has been quite a hit. 
A tutorial along the lines of dealing safely with lots of data, in a 
cluster of systems, would likely go down well.


http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Tutorial on Haskell

2007-04-16 Thread Derek Elkins

Mark T.B. Carroll wrote:

Bryan O'Sullivan <[EMAIL PROTECTED]> writes:


Mark T.B. Carroll wrote:


I'm afraid no
examples come easily to mind, though.
Here's a simple one: reading a flattened graph from disk.  If your 
flattened representation contains forward references, you have to fix 
them up in a strict language.  In a lazy language, you can refer to 
elements you haven't yet read, eliminating that book-keeping.


That's a good point. Indeed, I had used laziness in a programme that
read a file that contained a series of entity definitions that could
include forward references, I just couldn't remember exactly how I'd
used laziness. (-: (It's also useful in some memoising, I think.)

-- Mark

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe



Near the bottom of http://www.haskell.org/hawiki/TyingTheKnot is an example that 
uses lazy evaluation to do exactly this.  The real kicker though, is that the 
change from backward references only (i.e. simplistic one-pass code that would 
work in a strict language) to forward and backward references is trivial (just 
pass in the output).

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Type classes and type equality

2007-04-16 Thread Jeremy Shaw
At Mon, 16 Apr 2007 13:44:13 +0100,
Neil Mitchell wrote:
> 
> Hi,

> So my question is if this is safe? Will the compiler always pick the
> "right one"? Is there a better way to do this?

I noticed that the results can be a bit suprising sometimes. See if
you can predict the answers to these (in ghci):

> same 1 1

> let x = (undefined :: a) in same x x

> f :: a -> Bool
> f a = same a a

> f (undefined :: a)

Here is what ghci says:

*Main> same 1 1
False

*Main> :t 1
1 :: forall t. (Num t) => t

*Main> let x = (undefined :: a) in same x x
False

> f :: a -> Bool
> f a = same a a

*Main> f (undefined :: a)
True

I'm not saying anything is wrong here. Just be careful how you use it
:)

j.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Type classes and type equality

2007-04-16 Thread Clifford Beshers

Jeremy Shaw wrote:


I noticed that the results can be a bit suprising sometimes. See if
you can predict the answers to these (in ghci):
  


Interesting examples.  Here's another one that I would find problematic:

   *SameType> same Nothing (Just "xyzzy")
   False
   *SameType> same (Nothing :: Maybe String) (Just "xyzzy")
   True

And of course, the case with the integers lifts right up:

   *SameType> same (Just 1) (Just 1)
   False


___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Re: `Expect'-like lazy reading/Parsec matching on TCP sockets

2007-04-16 Thread Ian Lynagh

Hi Scott,

On Mon, Apr 09, 2007 at 10:03:55AM -0600, Scott Bell wrote:
> >Have you got a complete (but preferably small) program showing the
> >problem?

Great example, thanks!

Sorry for the delay in tracking it down.

> main :: IO ()
> main = do (_, h, _, p) <- runInteractiveCommand "telnet nyx.nyx.net"
>  t <- hGetContentsTimeout h 15000
>  print t >> terminateProcess p

The input handle is being garbage collected and closed, so telnet is
exiting. Try:

main :: IO ()
main = do (hin, h, _, p) <- runInteractiveCommand "telnet nyx.nyx.net"
 t <- hGetContentsTimeout h 15000
 print t
 hClose hin
 terminateProcess p

Note that you can't do either the hClose or terminateProcess before you
have forced the whole string (which print does here). You might prefer
to pass hin and p to hGetContentsTimeout, and have it close/terminate
them just before the return "".

> hGetContentsTimeout :: Handle -> Int -> IO String
> hGetContentsTimeout h t = do
>  hSetBuffering stdin NoBuffering
>  ready <- hWaitForInput h t; eof <- hIsEOF h  

You'll also need to remove the hIsEOF call from your code, or having
decided that nothing is ready it will then block, waiting to see if
there is an end of file or not.


Thanks
Ian

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Tutorial on Haskell

2007-04-16 Thread Albert Y. C. Lai

Neil Mitchell wrote:

Things
like laziness are cool, but are harder to convince a strict programmer
that they are useful.


Strict programmers like the "yield" command too. The same behaviour can 
be obtained by laziness, with easier reasoning.


That said, strict programmers may or may not like easier reasoning. 
Also, laziness in general (when not restricted to generators) is not 
easier to reason either.


___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] Re: Tutorial on Haskell, PLEAC

2007-04-16 Thread Pixel
Simon Peyton-Jones <[EMAIL PROTECTED]> writes:

> I'm quite excited about this: it is a great opportunity to expose Haskell to a
> bunch of smart folk, many of whom won't know much about Haskell. My guess is
> that they'll be Linux/Perl/Ruby types, and they'll be practitioners rather
> than pointy-headed academics.
>
> One possibility is to do a tutorial along the lines of "here's how to reverse
> a list", "here's what a type is" etc; you know the kind of thing. But instead,
> I'd prefer to show them programs that they might consider *useful* rather than
> cute, and introduce the language along the way, as it were.

As for me I find quickCheck a killer feature, and quite concise.


While on the subject, i'd like to mention that at last PLEAC now has a
"standard" haskell version:

http://pleac.sf.net/pleac_haskell

of course, it's still a long way to go: only 9% is done, nice comments
should be added, better code... But it's quite useful already!

(i know pleac is somewhat a duplicate of
http://haskell.org/haskellwiki/Cookbook, and it's not always adapted
to haskell, but i still think it's quite useful and worth working on
it. i suggest it's time to remove the pleac bashing from
http://haskell.org/haskellwiki/Cookbook)
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] Re: Tutorial on Haskell

2007-04-16 Thread Pete Kazmier
Simon Peyton-Jones <[EMAIL PROTECTED]> writes:

> My guess is that they'll be Linux/Perl/Ruby types, and they'll be
> practitioners rather than pointy-headed academics.

> Suggest concrete examples of programs that are
> * small
> * useful
> * demonstrate Haskell's power
> * preferably something that might be a bit
> tricky in another language

> But there must be lots of others.  

As one of those python/ruby types trying to learn Haskell for the past
year, here are my suggestions for small examples:

- Tom Moertel's Haskell Port Scanner
  Why? Demonstrates concurrent haskell in a small amount of lines
  http://blog.moertel.com/articles/2004/03/13/concurrent-port-scanner-in-haskell

- A web-server example of some sort that interfaces with a database
  and uses some interesting HTML combinator library.

- Building a simple unit testing framework is always a good example
  (even though they already exist), and then introducing quickcheck
  perhaps.

- A program to concurrently verify the links on an HTML page
  recursively.  I'm sure there are lots of interesting idioms and
  techniques that could be used while keeping the code small and
  elegant.

- Perhaps a Haskell version of Norvig's 20-line Python Spell Checker:
  Why? Maybe a Haskell version could be shorter and more elegant?
  http://norvig.com/spell-correct.html

- Tom Moertel's Directory Tree Printing in Haskell:
  Why? Demonstrates all sorts of introductory techniques
  
http://blog.moertel.com/articles/2007/03/28/directory-tree-printing-in-haskell-part-three-lazy-i-o


Some thoughts on other topics suggested by others:

- Parsec is not that interesting for those coming from perl, ruby, or
  python as they rely on regular expressions for everything and just
  expect that they are part of the language.  The thought of writing
  one's own parser is not as "cool" as most Haskellers believe it is,
  regardless of how interesting the parsec library is.

- STM may be too complex of a subject for an intro to Haskell
  tutorial.  There are just too many concepts in there that may
  overwhelm some beginners.

- Don's post on shell scripting was very interesting, but I'm still
  having a hard time understanding some parts of it, the error
  handling part, and I've been playing with Haskell on and off for the
  past year (I'm also a slow learner and not an academic).

- Don's post on simple UNIX utilities was also quite nice. I believe
  he also wrote a simple IRC bot example that would prove
  interesting, can't seem to find the link at the moment though.

Just my thoughts as a newbie desiring a book on how to use Haskell in
a practical manner (such as Practical Common Lisp book).

-Pete

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Re: Tutorial on Haskell

2007-04-16 Thread Donald Bruce Stewart
pete-expires-20070615:
> Simon Peyton-Jones <[EMAIL PROTECTED]> writes:
> 
> > My guess is that they'll be Linux/Perl/Ruby types, and they'll be
> > practitioners rather than pointy-headed academics.
> 
> > Suggest concrete examples of programs that are
> > * small
> > * useful
> > * demonstrate Haskell's power
> > * preferably something that might be a bit
> > tricky in another language
> 
> > But there must be lots of others.  
> 
> As one of those python/ruby types trying to learn Haskell for the past
> year, here are my suggestions for small examples:
> 
> - Tom Moertel's Haskell Port Scanner
>   Why? Demonstrates concurrent haskell in a small amount of lines
>   
> http://blog.moertel.com/articles/2004/03/13/concurrent-port-scanner-in-haskell
> 
> - A web-server example of some sort that interfaces with a database
>   and uses some interesting HTML combinator library.
> 
> - Building a simple unit testing framework is always a good example
>   (even though they already exist), and then introducing quickcheck
>   perhaps.

It's interesting to note that QuickCheck generalises unit testing:
zero-arity QC properties are exactly unit tests.

> - A program to concurrently verify the links on an HTML page
>   recursively.  I'm sure there are lots of interesting idioms and
>   techniques that could be used while keeping the code small and
>   elegant.

Ah, there's a (parallel) program I wrote for this, urlcheck. 

http://hackage.haskell.org/cgi-bin/hackage-scripts/package/urlcheck-0.1

I had meant to use this as a basis for a blog article, but didn't get
around to it.

> - Perhaps a Haskell version of Norvig's 20-line Python Spell Checker:
>   Why? Maybe a Haskell version could be shorter and more elegant?
>   http://norvig.com/spell-correct.html
> 
> - Tom Moertel's Directory Tree Printing in Haskell:
>   Why? Demonstrates all sorts of introductory techniques
>   
> http://blog.moertel.com/articles/2007/03/28/directory-tree-printing-in-haskell-part-three-lazy-i-o
> 
> 
> Some thoughts on other topics suggested by others:
> 
> - Parsec is not that interesting for those coming from perl, ruby, or
>   python as they rely on regular expressions for everything and just
>   expect that they are part of the language.  The thought of writing
>   one's own parser is not as "cool" as most Haskellers believe it is,
>   regardless of how interesting the parsec library is.

That's a useful insight.
  
> - STM may be too complex of a subject for an intro to Haskell
>   tutorial.  There are just too many concepts in there that may
>   overwhelm some beginners.
> 
> - Don's post on shell scripting was very interesting, but I'm still
>   having a hard time understanding some parts of it, the error
>   handling part, and I've been playing with Haskell on and off for the
>   past year (I'm also a slow learner and not an academic).

Interesting! Thanks for the feedback.
  
> - Don's post on simple UNIX utilities was also quite nice. I believe
>   he also wrote a simple IRC bot example that would prove
>   interesting, can't seem to find the link at the moment though.

http://haskell.org/haskellwiki/Roll_your_own_IRC_bot
  
> Just my thoughts as a newbie desiring a book on how to use Haskell in
> a practical manner (such as Practical Common Lisp book).

Don't we all! :-)

-- Don
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] Zero-arity tests in QuickCheck and displaying expected result

2007-04-16 Thread Joel Reymont


On Apr 16, 2007, at 9:29 PM, Donald Bruce Stewart wrote:


It's interesting to note that QuickCheck generalises unit testing:
zero-arity QC properties are exactly unit tests.


I don't think this works very well. I rely quite heavily on being  
able to compare expected output with test results and QC does not  
seem to provide for this feature when tests are zero arity.


Am I missing something?

Thanks, Joel

--
http://wagerlabs.com/




___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] Re: Zero-arity tests in QuickCheck and displaying expected result

2007-04-16 Thread Donald Bruce Stewart
joelr1:
> 
> On Apr 16, 2007, at 9:29 PM, Donald Bruce Stewart wrote:
> 
> >It's interesting to note that QuickCheck generalises unit testing:
> >zero-arity QC properties are exactly unit tests.
> 
> I don't think this works very well. I rely quite heavily on being  
> able to compare expected output with test results and QC does not  
> seem to provide for this feature when tests are zero arity.
> 
> Am I missing something?

That's just the default driver. Plenty of custom drivers exist which
compare the output. The QC driver is just a function you implement,
after all.

-- Don
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] Re: Zero-arity tests in QuickCheck and displaying expected result

2007-04-16 Thread Joel Reymont

Are there any examples of such custom drivers?

On Apr 16, 2007, at 10:09 PM, Donald Bruce Stewart wrote:


That's just the default driver. Plenty of custom drivers exist which
compare the output. The QC driver is just a function you implement,
after all.


--
http://wagerlabs.com/





___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Zero-arity tests in QuickCheck and displaying expected result

2007-04-16 Thread Lennart Augustsson

Why can't you just do 'f 1 2 3 == (4, 5, 6, 7)' to test f?

On Apr 16, 2007, at 22:08 , Joel Reymont wrote:



On Apr 16, 2007, at 9:29 PM, Donald Bruce Stewart wrote:


It's interesting to note that QuickCheck generalises unit testing:
zero-arity QC properties are exactly unit tests.


I don't think this works very well. I rely quite heavily on being  
able to compare expected output with test results and QC does not  
seem to provide for this feature when tests are zero arity.


Am I missing something?

Thanks, Joel

--
http://wagerlabs.com/




___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Zero-arity tests in QuickCheck and displaying expected result

2007-04-16 Thread Joel Reymont
That's what HUnit does but it's enticing to be able to standardize on  
QuickCheck for all of your testing.


On Apr 16, 2007, at 10:11 PM, Lennart Augustsson wrote:


Why can't you just do 'f 1 2 3 == (4, 5, 6, 7)' to test f?


--
http://wagerlabs.com/





___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] Re: Zero-arity tests in QuickCheck and displaying expected result

2007-04-16 Thread Donald Bruce Stewart
I usually roll a new driver for each project, for example:

http://www.cse.unsw.edu.au/~dons/code/fps/tests/QuickCheckUtils.hs

and a smp parallel driver,

http://www.cse.unsw.edu.au/~dons/code/pqc/Test/QuickCheck/Parallel.hs

There's a few examples in Test.QuickCheck too.

joelr1:
> Are there any examples of such custom drivers?
> 
> On Apr 16, 2007, at 10:09 PM, Donald Bruce Stewart wrote:
> 
> >That's just the default driver. Plenty of custom drivers exist which
> >compare the output. The QC driver is just a function you implement,
> >after all.
> 
> --
> http://wagerlabs.com/
> 
> 
> 
> 
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] implementing try for RWST ?

2007-04-16 Thread tpledger
Jeremy Shaw wrote:
 :
 | However, I think this is buggy, because changes
 | to 's' and 'w' will be lost if 'm' raises an
 | exception.
 :


That's determined by the way you stack your monad
transformers when declaring the type: adding error handling
to a writer monad, or adding writing to an error handling
monad.  For a concrete example, see the result types in the
following.  The first has the Either inside the tuple, and
the second has the tuple inside the Either.

Prelude> :t Control.Monad.Writer.runWriter .
Control.Monad.Error.runErrorT
Control.Monad.Writer.runWriter .
Control.Monad.Error.runErrorT :: Control.Monad.Error.ErrorT
e (Control.Monad.Writer.Writer w) a
-> (Either e a, w)
Prelude> :t either Left Right .
Control.Monad.Writer.runWriterT
either Left Right . Control.Monad.Writer.runWriterT ::
Control.Monad.Writer.WriterT w (Either a) a1 -> Either a
(a1, w)


Regards,
Tom
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Re: [web-devel] A light-weight web framework

2007-04-16 Thread S. Alexander Jacobson
DrIFT is a preproxessor so it makes the build process more complex.  I'd like to 
find a pure-haskell solution or a TH solution that doesn't require more build 
complexity.


-Alex-



On Tue, 10 Apr 2007, Marc Weber wrote:


Right now, you can largely do the same thing, but you have to write the XML
representations of your data structures manually.

-Alex-


I'm not sure but doesn't use HAppS kind of stripped down HaXml ?
DrIft can derive HaXml instances automatically.
Where is the problem doing using DrIft?

Marc
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe



___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Re: [web-devel] A light-weight web framework

2007-04-16 Thread Stefan O'Rear
On Mon, Apr 16, 2007 at 07:09:10PM -0400, S. Alexander Jacobson wrote:
> On Tue, 10 Apr 2007, Marc Weber wrote:
> >>Right now, you can largely do the same thing, but you have to write the 
> >>XML
> >>representations of your data structures manually.
> >>
> >>-Alex-
> >
> >I'm not sure but doesn't use HAppS kind of stripped down HaXml ?
> >DrIft can derive HaXml instances automatically.
> >Where is the problem doing using DrIft?
> >
> >Marc
> >___
> >Haskell-Cafe mailing list
> >Haskell-Cafe@haskell.org
> >http://www.haskell.org/mailman/listinfo/haskell-cafe
> >
> 
> DrIFT is a preproxessor so it makes the build process more complex.  I'd 
> like to find a pure-haskell solution or a TH solution that doesn't require 
> more build complexity.

You might want to look at the Data.Derive system.  Basically it's a
giant library of helpers for writing TH-based derivations.  It has a
few other cool features, like an automated guesser for sufficiently
regular classes.  It's still in the cleanup-for-release stage, so any
questions should not be hesitated on! 

http://www.cs.york.ac.uk/fp/darcs/derive

Primary maintainer: Neil Mitchell <[EMAIL PROTECTED]>  (I'm very familiar with 
it, too)

Stefan
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Fwd: [Haskell-cafe] Tutorial on Haskell

2007-04-16 Thread Ryan Dickie

Blast.. i didn't hit "reply all" so here's a forward of my mail to the
group...

--ryan
-- Forwarded message --
From: Ryan Dickie <[EMAIL PROTECTED]>
Date: Apr 16, 2007 4:24 PM
Subject: Re: [Haskell-cafe] Tutorial on Haskell
To: Simon Peyton-Jones <[EMAIL PROTECTED]>

I can tell you what me and my colleagues would be interested in (though none
of us are actually going). We code a lot of math. You may call it scientific
computing. Haskell seems like a natural fit for the task.

In particular we are interested in:
1) the type system
2) concurrency (can these be set to run on a large system)
3) simple relation between what equations we write on paper, and what
equations we write in haskell.

I'm still a n00b to Haskell. For us languages like matlab, maple, etc. do
not fit the job very well and run too slowly. C/C++ is usually what i use
but it can be a pain. Python, etc... well its good for the glue i suppose.
Haskell might fit that niche.

On 4/16/07, Simon Peyton-Jones <[EMAIL PROTECTED]> wrote:


Friends

I have agreed to give a 3-hr tutorial on Haskell at the Open Source
Convention 2007
http://conferences.oreillynet.com/os2007/

I'm quite excited about this: it is a great opportunity to expose Haskell
to a bunch of smart folk, many of whom won't know much about Haskell.  My
guess is that they'll be Linux/Perl/Ruby types, and they'll be practitioners
rather than pointy-headed academics.

One possibility is to do a tutorial along the lines of "here's how to
reverse a list", "here's what a type is" etc; you know the kind of
thing.  But instead, I'd prefer to show them programs that they might
consider *useful* rather than cute, and introduce the language along the
way, as it were.

So this message is to ask you for your advice.  Many of you are exactly
the kind of folk that come to OSCON --- except that you know Haskell.   So
help me out:

Suggest concrete examples of programs that are
* small
* useful
* demonstrate Haskell's power
* preferably something that might be a bit
tricky in another language

For example, a possible unifying theme would be this:
http://haskell.org/haskellwiki/Simple_unix_tools

Another might be Don's cpu-scaling example

http://cgi.cse.unsw.edu.au/~dons/blog/2007/03/10

But there must be lots of others.  For example, there are lots in the blog
entries that Don collects for the Haskell Weekly Newsletter.  But I'd like
to use you as a filter: tell me your favourites, the examples you find
compelling.  (It doesn't have to be *your* program... a URL to a great blog
entry is just fine.)  Of course I'll give credit to the author.

Remember, the goal is _not_ "explain monads".  It's "Haskell is a great
way to Get The Job Done".

Thanks!

Simon
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Re: [web-devel] A light-weight web framework

2007-04-16 Thread Neil Mitchell

Hi


> DrIFT is a preproxessor so it makes the build process more complex.  I'd
> like to find a pure-haskell solution or a TH solution that doesn't require
> more build complexity.

You might want to look at the Data.Derive system.  Basically it's a
giant library of helpers for writing TH-based derivations.


As Stefan says, you virtually described Data.Derive :)


It has a
few other cool features, like an automated guesser for sufficiently
regular classes.


A very cool feature, its touched on in the user manual, but I want to
write more on this :-) Basically we don't need to specify how to write
various derivations - we just write an example and it guesses at what
the derivation is. Examples for which we can guess include Data, Eq,
Ord, Serial, Arbitrary 


It's still in the cleanup-for-release stage, so any
questions should not be hesitated on!

http://www.cs.york.ac.uk/fp/darcs/derive


Homepage: http://www-users.cs.york.ac.uk/~ndm/derive/
Manual: http://www.cs.york.ac.uk/fp/darcs/derive/derive.htm

It is very much in the clean up for release stage - I'm hoping to get
it released in the next few days (it requires GHC 6.6 at the mo,
making it 6.4.2 compatible is one of the tasks on the list, but thats
about it). If you find anything else that needs polishing, do shout!

As of earlier today, Yhc uses Derive instead of DrIFT - and it made
some bits quite a lot simpler.

Thanks

Neil
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Re: Tutorial on Haskell

2007-04-16 Thread Evan Laforge

- Parsec is not that interesting for those coming from perl, ruby, or
  python as they rely on regular expressions for everything and just
  expect that they are part of the language.  The thought of writing
  one's own parser is not as "cool" as most Haskellers believe it is,
  regardless of how interesting the parsec library is.


I would think the reverse... people who have used regexes a lot might
be interested in a technique that doesn't have their limitations.  For
example, you can define your own parsers (anyone who has had to deal
with REs of any complexity will appreciate that), you can "remember"
things (e.g. the classic eat chars until balancing paren thing), much
better error reporting (wouldn't a perler like to know where and how
his regex failed to match?) and then you're not limited to characters!

I gave a talk on haskell once and intended to include (unfortunately
ran out of time) a "write your own regexish language in 50 lines"
section using parser combinators (a simplified monadic setup with
regex style capturing groups).  Then show how I can define custom
parsers (e.g. match a number between x and y), recursive ones (match a
sexpr), and wind up with much more readable individually testable
expressions, e.g. "ip = let ipnum = group (num_in_range 0 255) in
ipnum >> dot >> ipnum >> dot >> ipnum >> dot >> ipnum" then "log_msg =
hostname >> ip >> blah" vs. the usual huge buggy regex.  And then I
can take the same operators and apply them to matching keywords to
e.g. match cmdline args for a simple specification language.

What you lose is the nice concise line-noise language, but then you
can show how easy it is to write a line noise -> parser combinator
converter.

It illustrates a few nice things about haskell: laziness for the
recursive defs and easy backtracking, low syntax overhead and custom
operators for DSLs, composability, etc.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] Re: Tutorial on Haskell

2007-04-16 Thread Pete Kazmier
"Evan Laforge" <[EMAIL PROTECTED]> writes:

> It illustrates a few nice things about haskell: laziness for the
> recursive defs and easy backtracking, low syntax overhead and custom
> operators for DSLs, composability, etc.

Although that is true, I somehow feel that showing a perl, ruby, or
python programmer an alternate approach to regexps, a technique firmly
ingrained into the roots of these languages, will not garner much
interest in Haskell.  I know this is the case for me.  

In fact, it was always a large negative for me that Haskell/GHC never
had decent builtin support for regexps until recently (6.6).  From a
practical point of view, the tasks that I do frequently involve the
use of regexps (for better or worse).  Again, I'm not an academic,
just an everyday python programmer trying to assist me in my day job.

Upon thinking about this subject further, I think it would be very
important that Simon somehow incorporates at least one use of the new
regexp library.  The target audience would by more likely to consider
Haskell if it contains they're beloved tool of choice.  Later, they
can discover the elegance of parsec if needed.

-Pete

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] >> and sequencing [newbie]

2007-04-16 Thread David Powers

Ah... so the secret is in the hidden variables.  On some level I am
beginning to fear that Monads resurrect some of the scariest aspects of
method overriding from my OO programming days.  Do you (all) ever find that
the ever changing nature of >>= makes code hard to read?


On 4/15/07, jeff p <[EMAIL PROTECTED]> wrote:


Hello,

On 4/15/07, David Powers <[EMAIL PROTECTED]> wrote:
> so... this is likely a question based on serious misunderstandings, but
can
> anyone help me understand the exact mechanism by which monads enforce
> sequencing?
>
Monads do not enforce sequencing.

In general, data dependencies enforce sequencing (i.e. if expression x
depends upon expression y then expression y will have to be evaluated
first). Consider:

let x = case y of Just y' -> f y'
 Nothing -> g
 y = some code
in more stuff

Here y must be evaluated before x because x needs to look at y in
order to compute.

> Specifically, I'm confused by the >> operator.  If I understand
> things properly f a >> g expands to something like:
>
> f >>= \_ -> g
>
> What I'm missing is how the expansion of f is ever forced under lazy
> evaluation.  Since the result is never used, doesn't it just stay as a
> completely unevaluated thunk?
>
(>>=) is an overloaded function. Some instances of it will cause f to
be evaluated, others won't. Consider the State monad:

instance Monad (State s) where
return a = State $ \s -> (a, s)
m >>= k  = State $ \s -> case runState m s of
 (a, s') -> runState (k a) s'

Note that (>>=)  causes m to be evaluated (up to a pair) before
evaluating k because (>>=) needs to look at the result of m.

An example of a monad in which (>>=) doesn't force evaluation of the
first argument before the second is the Identity monad:

instance Monad Identity where
return a = Identity a
m >>= k  = k (runIdentity m)

Note that (>>=) actually forces the evaluation of k before m.

-Jeff

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] >> and sequencing [newbie]

2007-04-16 Thread Donald Bruce Stewart
david:
> 
>Ah... so the secret is in the hidden variables.  On some
>level I am beginning to fear that Monads resurrect some of
>the scariest aspects of method overriding from my OO
>programming days.  Do you (all) ever find that the ever
>changing nature of >>= makes code hard to read?

You always know which monad you're in though, since its in the type.
And the scary monads aren't terribly common anyway.

-- Don
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] >> and sequencing [newbie]

2007-04-16 Thread Clifford Beshers

Donald Bruce Stewart wrote:

david:
  

   Ah... so the secret is in the hidden variables.  On some
   level I am beginning to fear that Monads resurrect some of
   the scariest aspects of method overriding from my OO
   programming days.  Do you (all) ever find that the ever
   changing nature of >>= makes code hard to read?



You always know which monad you're in though, since its in the type.
And the scary monads aren't terribly common anyway.
  


Also, the monad laws impose a level of sanity that most OO frameworks do 
not, right?


___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] >> and sequencing [newbie]

2007-04-16 Thread Donald Bruce Stewart
clifford.beshers:
> 
>Donald Bruce Stewart wrote:
> 
> david:
>   
> 
>Ah... so the secret is in the hidden variables.  On some
>level I am beginning to fear that Monads resurrect some of
>the scariest aspects of method overriding from my OO
>programming days.  Do you (all) ever find that the ever
>changing nature of >>= makes code hard to read?
> 
> 
> You always know which monad you're in though, since its in the type.
> And the scary monads aren't terribly common anyway.
>   
> 
>Also, the monad laws impose a level of sanity that most OO
>frameworks do not, right?

Ah yes, and we have the 3 laws of monads. If you break these , the monad
police will come and lock you up.

-- Don
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] implementing try for RWST ?

2007-04-16 Thread Jeremy Shaw
At Tue, 17 Apr 2007 09:46:19 +1200,
[EMAIL PROTECTED] wrote:
} 
} Jeremy Shaw wrote:
}  :
}  | However, I think this is buggy, because changes
}  | to 's' and 'w' will be lost if 'm' raises an
}  | exception.
}  :
} 
} 
} That's determined by the way you stack your monad
} transformers when declaring the type: adding error handling
} to a writer monad, or adding writing to an error handling
} monad.  For a concrete example, see the result types in the
} following.  The first has the Either inside the tuple, and
} the second has the tuple inside the Either.
} 
} Prelude} :t Control.Monad.Writer.runWriter .
} Control.Monad.Error.runErrorT
} Control.Monad.Writer.runWriter .
} Control.Monad.Error.runErrorT :: Control.Monad.Error.ErrorT
} e (Control.Monad.Writer.Writer w) a
} -} (Either e a, w)
} Prelude} :t either Left Right .
} Control.Monad.Writer.runWriterT
} either Left Right . Control.Monad.Writer.runWriterT ::
} Control.Monad.Writer.WriterT w (Either a) a1 -} Either a
} (a1, w)

Unfortunately, while that gets me closer, it don't think it does the
whole job. I would like to be able to catch exceptions raised by
|error|. Let me demonstrate:

> import Control.Exception
> import Control.Monad
> import Control.Monad.Error
> import Control.Monad.RWS
> import Prelude hiding (catch)

Here I define ErrorT to be on the outside.

> newtype DryRunIO a = DryRunIO { runDryRunIO :: ErrorT Exception (RWST Bool 
> String Int IO) a }
> deriving (Monad, MonadIO, MonadFix, Functor, MonadReader Bool, 
> MonadWriter String, MonadState Int, MonadError Exception)

I have to add some instances of Exception to Error, since there are
none defined already.

> instance Error Exception where
> strMsg msg = ErrorCall msg

Here is a straight-forward implementation of try. 

> -- |like |try| 
> tryDR :: DryRunIO a -> DryRunIO (Either Exception a)
> tryDR m = catchError (m >>= return . Right) (return . Left)

A command to run my monad.

> -- |turn a DryRunIO into IO
> run :: Bool -> DryRunIO a -> IO (Either Exception a, Int, String)
> run dryRun action =
> runRWST (runErrorT (runDryRunIO action)) dryRun 0

A simple helper function for the demo.

> inc :: DryRunIO ()
> inc = modify (+1)

This test does what we I would like, because it uses the facilities
provided by ErrorT:

> test1 = run False (tryDR (inc >> throwError (ErrorCall "whee")))

*Main> test1
(Right (Left whee),1,"")

But this variation that calls |error| fails:

> test2 = run False (tryDR (error "whee"))

*Main> test2
*** Exception: whee

I can hack it a bit, if I use a wrapper function like this:

> io :: (MonadIO t, MonadError Exception t) => IO a -> t a
> io action = 
> do r <- liftIO (try action)
>case r of
>  Left e -> throwError e
>  Right r' -> return r'

This does what I want:

> test3 = run False (tryDR (io $ error "whee"))

*Main> test3
(Right (Left whee),0,"")

But, if I was going to do that, then I might as well just do:

> test4 = run False (liftIO $ try (error "whee"))

*Main> test4
(Right (Left whee),0,"")

Unfortunately, both those variations assume that error is being called
inside the IO parts of my program, and not because someone did
something silly like:

> test5 = run False (tryDR $ head [])

*Main> test5
*** Exception: Prelude.head: empty list

After some further investigation, I am not convinced that there is a
solution.

Instead of using the complicated RWST monad, I could demo the problem
using the simpiler StateT monad. However, I can simplify even further
for clarity. The |StateT IO a| monad is roughly equivalent to:

> type StateIO state a = (state -> IO (a, state))

In other words, it is similar to a function that takes the current
value of the state, and returns a value and a possibly updated state,
both in the IO monad.

If the state is a simple Counter, we can implement increment like
this:

> type Counter = Integer

> -- |Increment the counter by 1
> incIO :: (Counter -> IO ((), Counter))
> incIO = \c -> 
>let c' = c + 1 in
>do putStrLn ("Incrementing counter to: " ++ show c')
>   return ((), c')

We can then implement |tryC| like this:

> -- |similar to |try|
> tryC :: (Counter -> IO (a, Counter)) -> (Counter -> IO ((Either Exception a), 
> Counter))
> tryC f = \c -> 
>  catch (f c >>= \ (a, c') -> return (Right a, c')) (\e -> return (Left e, c))

And use them like this:

> test = \c ->
>do ((), c1) <- incIO c
>   (r, c2) <- (tryC die) c1
>   return (r, c2)
>where
>  -- |increment the counter by one and then die
>  die :: (Counter -> IO ((), Counter))
>  die = \c -> 
>do ((), c')  <- incIO c
>   error "die!"
>   return ((), c')

If we run the test function we will get this output:

*Main> test 0
Incrementing counter to: 1
Incrementing counter to: 2
(Left die!,1)

We see that the counter gets incremented twice, but the second
incrementation is lost when the exception is thrown. So the final
result is:

(Left die!,1)

[Haskell-cafe] Re: Type classes and type equality

2007-04-16 Thread oleg

Neil Mitchell wrote:
> I'm looking for a type class which checks whether two types are the
> same or not.

This problem is more complex than appears. It has been solved,
however. IncoherentInstances are not required, as IncoherentInstances
are generally unsafe.

For the full discussion of various solutions, please see Section 9 and
Appendix D of the HList paper:
http://homepages.cwi.nl/~ralf/HList/paper.pdf

The HList code is available
http://darcs.haskell.org/HList/
It includes the examples from the paper.




___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Tutorial on Haskell

2007-04-16 Thread ajb
G'day all.

Quoting Neil Mitchell <[EMAIL PROTECTED]>:

> I think its important to cover whats different about Haskell. Things
> like laziness are cool, but are harder to convince a strict programmer
> that they are useful.

I think you could.  What you need to convince a strict programmer of is
that laziness gives you modularity.  The Graham Hutton Sudoku solver is
a nice example, but it'd be cool if we had a similar example that was
less cheesy than Sudoku.

A dynamic programming or memoing example might not hurt, either.

Cheers,
Andrew Bromage
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] implementing try for RWST ?

2007-04-16 Thread oleg

The examples presented so far seem to show that the computation will
eventually run in the IO monad. One may wonder then why do we need
RWST transformer, given that the IO monad can implement both the state
and writer. At the very least me need the reader transformer, which is
the least demanding monad. We can do away with the reader as well,
depending on the circumstances (e.g., one may use implicit
parameters or implicit configurations, or just pass IORefs). 

The pure IO or ReaderIO solution has, besides simplicity, the
advantage of being more expressive. Monad transformers, besides
inefficiency, impose the rigid layering of effects, and so cannot
express some useful computations. The drawbacks of monad transformers
and their limited expressivity are not often discussed, unfortunately.

The following code shows Jeremy Shaw's example, with both persistent
and backed out state. The combinator tryC handles the exception and
preserves the state accumulated at the point of exception. In
contrast, tryBC undoes the changes to the state in case of
exception. Both combinators have their uses.

module T where

import Control.Monad.Reader
import Data.IORef
import Control.Exception
import Prelude hiding (catch)

type ReaderIO a v = ReaderT a IO v
type StateIO a v = ReaderIO (IORef a) v

type Counter = Integer

-- |Increment the counter by 1
incIO :: StateIO Counter ()
incIO = do
cref <- ask
c <- liftIO $ readIORef cref
let c' = c + 1
liftIO $ writeIORef cref c'
liftIO $ putStrLn ("Incrementing counter to: " ++ show c')

-- get the current value of the counter
getC :: StateIO Counter Counter
getC = ask >>= liftIO . readIORef

-- Try that preserves the state
tryC :: ReaderIO a v -> (Exception -> ReaderIO a v) -> ReaderIO a v
tryC action onerr = do
r <- ask
liftIO $ catch (runReaderT action r) (\e -> runReaderT (onerr e) r)

-- Try that backs up the state
tryBC :: StateIO a v -> (Exception -> StateIO a v) -> StateIO a v
tryBC action onerr = do
r <- ask
oldstate <- liftIO $ readIORef r
liftIO $ catch (runReaderT action r) 
   (\e -> do
  writeIORef r oldstate
  runReaderT (onerr e) r)

-- The run function
runC :: Counter -> StateIO Counter v -> IO v
runC v a = newIORef v >>= runReaderT a

test = runC 0 (do
incIO
v <- tryC (die >> (return $ Right "ok")) (return . Left . show)
c <- getC -- get the resulting counter
liftIO $ print (v,c))
 where
  -- |increment the counter by one and then die
  die = incIO >> error "die!"

{-
*T> test
Incrementing counter to: 1
Incrementing counter to: 2
(Left "die!",2)
-}


-- the same but with backtrackable state
test2 = runC 0 (do
incIO
v <- tryBC (die >> (return $ Right "ok")) (return . Left . show)
c <- getC
liftIO $ print (v,c))
 where
  -- |increment the counter by one and then die
  die = incIO >> error "die!"

{-
*T> test2
Incrementing counter to: 1
Incrementing counter to: 2
(Left "die!",1)
-}

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] implementing try for RWST ?

2007-04-16 Thread Brandon S. Allbery KF8NH


On Apr 17, 2007, at 0:03 , [EMAIL PROTECTED] wrote:

eventually run in the IO monad. One may wonder then why do we need
RWST transformer, given that the IO monad can implement both the state


For what it's worth, I got the impression that RWST was an example of  
a complex monad transformer --- not necessarily something useful.


--
brandon s. allbery  [solaris,freebsd,perl,pugs,haskell]   
[EMAIL PROTECTED]
system administrator  [openafs,heimdal,too many hats]   
[EMAIL PROTECTED]
electrical and computer engineering, carnegie mellon university   
KF8NH



___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Re: Tutorial on Haskell

2007-04-16 Thread Alexis Hazell
On Tuesday 17 April 2007 10:30, Pete Kazmier wrote:
> From a
> practical point of view, the tasks that I do frequently involve the
> use of regexps (for better or worse).  

Likewise. It's true that when regexps are readily available, everything can 
look like a hammer; but sometimes a nail is just a nail. :-)


Alexis.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Re: Tutorial on Haskell

2007-04-16 Thread Alexis Hazell
On Tuesday 17 April 2007 14:48, Alexis Hazell wrote:

> Likewise. It's true that when regexps are readily available, everything can
> look like a hammer; but sometimes a nail is just a nail. :-)

Er. i meant to say, when the regexp /hammer/ is readily available, everything 
can look like a /nail/.

%-}


A.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] unsafeInerleaveIO and randomIO

2007-04-16 Thread Marc Weber
stefan has pointed me a nice version:

=  ===
randomInts :: IO [Int]
randomInts = randoms `fmap` newStdGen

main = do
  ints <- randomInts
  print $ take 5 ints
===  =

Anyway I'm curious why 

=  ===
module Main where
import Data.Char
import Control.Monad
import Random
import System.IO.Unsafe

randomInts :: IO [Int]
randomInts = unsafeInterleaveIO $ 
sequence $ cycle [unsafeInterleaveIO randomIO]

main = do
  ints <- unsafeInterleaveIO randomInts
  print $ take 5 ints
=  ===

doesn't return.
Where did I miss another unsafeInerleaveIO to make it lazy enough?
I still need a hint.

Marc
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe