Re: [Haskell-cafe] ANNOUNCE: The Monad.Reader - Issue 6

2007-02-01 Thread David House

On 31/01/07, David House [EMAIL PROTECTED] wrote:

dw :: (a - Bool) - [a] - [a]
dw p = reverse . fst . foldl comb ([],False)
 where comb (xs,done) x | done  = (x:xs, True)
| p x   = (xs, False)
| otherwise = (x:xs, True)


I forgot to mention: I used foldl because it was neater, but you can
easily convert it to use foldr by reversing the list first and
swapping the arguments to comb.

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


Re: [Haskell-cafe] Re: Channel9 Interview: Software Composability and theFu ture of Languages

2007-02-01 Thread Benjamin Franksen
[sorry, this was meant to go to the list]
On Wednesday 31 January 2007 00:40, Bulat Ziganshin wrote:
 Saturday, January 27, 2007, 12:00:11 AM, you wrote:
  and support operational reasoning, i.e. creating and understanding
  programs by mentally modeling their execution on a machine. This form
  of reasoning appeals to 'common sense', it is familiar to almost all
  (even completely un-educated) people and is therefore easier acessible
  to them.
 
  greatly simplifies denotional resp. equational reasoning(**), i.e. to
  understand a program as an abstract formula with certain logical
  properties; an abstract entity in its own right, independent of the
  possibility of execution on a machine. This way of thinking is less
  familiar to most people

 i think you are completely wrong! FP way is to represent everything as
 function, imperative way is to represent everything as algorithm.
 there is no natural thinking way, the only think that matters is
 *when* student learned the appropriate concept.

What I meant is that it is more similar to the way we use to think in our
daily life. Noone thinks about day-to-day practical problems in a formal
way -- in most cases this would be a completely inappropriate approach.
Formal thinking comes naturally to only a gifted few of us, most find it
exceptionally hard to learn.

However, I didn't mean to say that formal reasoning is something that
cannot be learned. I would even say that it is easier to learn if done
right from the start as something completely new instead of appealing to
intuition, thus trying to connect it to the more 'natural' ways of
thinking -- because the latter have to be 'unlearned' to a certain extent
before the new way of thinking can take hold.

 all the problem of learning FP paradigm for college-finished
 programmers is just that their brains are filled with imperative
 paradigm and they can't imagine non-imperative programming. it was
 hard for me, too :)

 we should change college programs to make FP programming available for
 the masses

Absolutely.

Cheers
Ben
--
Programming = Mathematics + Murphy's Law (Dijkstra in EWD1008)
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Re: Channel9 Interview: Software Composability and theFu ture of Languages

2007-02-01 Thread Dougal Stanton
Quoth Magnus Therning, nevermore,
 I'm not sure how a functional recipe would look, maybe something like
 this:
 
  White_sauce is a combination of ... .
 
  Chopped_onions is onions cut into small pieces.
 
  White_sauce_with_chopped_onions is the combination of white_sauce and
  chopped_onions.

The functional approach

 whitesauce = foldl stir base milks
 where base = flour + (heat butter)

compared with the imperative

 whitesauce
 base = flour + heat(butter);
 while (milks  0)
 stir(base, milk);
 milks--;

I'm going to go out on a limb here and suggest that, like Feynman's
example of how people count in their heads, both of these explanations
are accurate. If I were to explain the process to someone it would be in
the imperative style: literally giving commands, which is what a
recipe is. But in my mind I imagine it as the gradual process of
stirring milk into a base, which is far more adequately described in the
functional style.

The question is --- how would an expert describe such a process? Would a
professional chef give instructions in the functional or imperative
style? I think that is relevant, since the approach to the problem may
change depending on proficiency. We may *learn* in the imperative style
but *think* in the functional.

Cheers,

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


Re: [Haskell-cafe] Re: DevRandom

2007-02-01 Thread Yitzchak Gale

Bryan Donlan wrote:

{-# NOINLINE hDevRandom  #-}
hDevRandom = unsafePerformIO $ openFile /dev/random ReadMode


I wrote:

The NOINLINE guarantees that openFile is called only
once. But does it guarantee that openFile is NOT called
if we do not need it? We could check what the compilers
actually do, but I am not sure we have a guarantee here.



There's commentary in GHC/Conc.lhs that this is the case:
{-# NOINLINE pendingEvents #-}
{-# NOINLINE pendingDelays #-}
(pendingEvents,pendingDelays) = unsafePerformIO $ do
   startIOManagerThread
   reqs - newIORef []
   dels - newIORef []
   return (reqs, dels)
-- the first time we schedule an IO request, the service thread
-- will be created (cool, huh?)
I don't know if this is a documented guarentee however.


Hmm. I'm not sure what that comment means.
They are doing just what I did - creating only an
empty IORef, with the actual resource allocated only
when needed. Also, this is located inside a module that
is explicitly GHC-specific.

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


[Haskell-cafe] Data.ByteString.Lazy.Char8 and finding substrings

2007-02-01 Thread Magnus Therning
I'm curious, why doesn't Data.ByteString.Lazy.Char8 have the functions
for searching for substrings that Data.ByteString.Char8 has (isPrefixOf,
isSuffixOf, isSubstringOf, findSubstring and findSubstrings)?

/M

-- 
Magnus Therning (OpenPGP: 0xAB4DFBA4)
[EMAIL PROTECTED] Jabber: [EMAIL PROTECTED]
http://therning.org/magnus


pgpDBNM5I8X6Y.pgp
Description: PGP signature
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


RE: [Haskell-cafe] Takusen - error handling and DBM monad

2007-02-01 Thread Bayley, Alistair
 From: [EMAIL PROTECTED] 
 [mailto:[EMAIL PROTECTED] On Behalf Of Paul Moore
 
 catcher :: DBException - DBM mark Session ()
 catcher x = do
 liftIO $ putStrLn $ show x
 
 main = do
withSession (connect ... ... ...) ( do
  catchDB (do ...
)
catcher
  )
 
 But this doesn't catch errors in the connect call.
 
 Wrapping the withSession in catchDB doesn't work, as withSession is in
 the IO monad [1], not the DBM one. But using catch with catcher
 doesn't work, as that expects an error handler in the IO monad, but
 catcher is in the DBM monad.


There's an example in the README file, in which we see:

main = flip catchDB reportRethrow $
  withSession (connect sqlite_db) (do ...

which basically wraps withSession with catchDB. This does catch errors
in the connect call. The difference between your example and this is in
the handler; your handler has type:

 catcher :: DBException - DBM mark Session ()

whereas the README example handler is from the library, and has type:

 reportRethrow :: CaughtMonadIO m = DBException - m ()

CaughtMonadIO isn't something we've bothered to explain in the docs, but
this is simply a way of catching exceptions in a monad that is in the
MonadIO class, which is something the standard libraries don't support.
In Control.Exception, catch and friends are stuck in the IO monad. This
problem has been discussed before on this list:
  http://www.haskell.org/pipermail/haskell/2006-February/017547.html
  http://www.haskell.org/pipermail/haskell/2006-April/017893.html

And may well be fixed for Haskell-Prime?
  http://hackage.haskell.org/cgi-bin/haskell-prime/trac.cgi/ticket/110

So you just need to float your handler out one level (so it wraps
withSession), and make it usable in the regular IO monad :-) That should
be as simple as changing the type sig:

 catcher :: CaughtMonadIO m = DBException - m ()
 catcher x = liftIO $ putStrLn $ show x

There are a couple of simple handlers in Database.Enumerator already,
which I'd recommend you start with:

 basicDBExceptionReporter :: CaughtMonadIO m = DBException - m ()
 basicDBExceptionReporter e = liftIO (putStrLn (formatDBException e))

 reportRethrow :: CaughtMonadIO m = DBException - m ()
 reportRethrow e = basicDBExceptionReporter e  IE.throwDB e

If you need something fancier then I suggest copying the code in
Database.Enumerator and modifying to suit your needs.


 I'm getting very confused about the relationship between the DBM stuff
 and the IO monad. I'm sure there are good reasons for the DBM monad,
 but at the moment I'm missing them, and all I'm doing is trying random
 things, to little avail.

The idea is to prevent resources used in database code from escaping
into other, non-database, parts of your program. This lets us safely use
the with- idiom to manage resources. For example, although code in the
DBM monad has access to the connection object (somewhat indirectly, but
it is there), it cannot return this object out of the DBM monad. When
withSession closes the connection, we can be sure that further access is
not possible. This is a similar technique to that used by the ST monad,
I think. Oleg explains it here:
  http://www.haskell.org/pipermail/haskell/2006-January/017410.html

Please feel free to mail me directly with questions, too, at this
address or [EMAIL PROTECTED] (although my access to that maibox
during working hours is sporadic and infrequent).


Al Falloon wrote:
 what does withSession return if there is a DBException?

Well, whatever the handler returns, same as with any other exception
handler. Note that this must have the same type as whatever withSession
returns, and this constraint is enforced by the type of catch/catchDB:

 catchDB :: CaughtMonadIO m = m a - (DBException - m a) - m a

... which is modelled on Control.Exception.catch (for regular IO monad
exceptions):

 catch :: IO a - (Exception - IO a) - IO a


Alistair
*
Confidentiality Note: The information contained in this message,
and any attachments, may contain confidential and/or privileged
material. It is intended solely for the person(s) or entity to
which it is addressed. Any review, retransmission, dissemination,
or taking of any action in reliance upon this information by
persons or entities other than the intended recipient(s) is
prohibited. If you received this in error, please contact the
sender and delete the material from any computer.
*
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Channel9 Interview: Software Composability and the Future of Languages

2007-02-01 Thread Tomasz Zielonka
On Wed, Jan 31, 2007 at 07:46:15PM +0300, Bulat Ziganshin wrote:
 Wednesday, January 31, 2007, 12:01:16 PM, you wrote:
 
  there are also many other similar issues, such as lack of good syntax
  for for, while, break and other well-known statements,
 
  On the other hand you have an ability to define your own control
  structures.
 
 i have a lot, but their features are limited, both in terms of
 automatic lifting and overall syntax. let's consider
 
 while (hGetBuf h buf bufsize == bufsize)
   crc := updateCrc crc buf bufsize
   break if crc==0
   print crc

A direct translation could look like this:

whileM c b = do { x - c; when x (b  whileM c b) }

f h buf =
flip runContT return $ do
callCC $ \break - do
flip execStateT 0 $ do
whileM (liftIO (liftM (== bufsize) (hGetBuf h buf 
bufsize))) $ do
do  crc - get
crc' - liftIO (updateCrc crc buf bufsize)
put crc'
crc - get
when (crc == 0) (lift (break crc))
liftIO (print crc)

Which, admittedly, is much more lengthy. If we assume that hGetBuf,
updateCrc and print can work in any MonadIO, and we define
inContT x = flip runContT return x
then it becomes slightly shorter:

inContT $ callCC $ \break - do
flip execStateT 0 $ do
whileM (liftM (== bufsize) (hGetBuf h buf bufsize)) $ do
do  crc - get
crc' - updateCrc crc buf bufsize
put crc'
crc - get
when (crc == 0) (lift (break crc))

Let's define:

modifyM f = do
x - get
x' - f x
put x'

and change the order of parametrs in updateCrc. We get:

inContT $ callCC $ \break - do
flip execStateT 0 $ do
whileM (liftM (== bufsize) (hGetBuf h buf bufsize)) $ do
modifyM (updateCrc buf bufsize)
crc - get
when (crc == 0) (lift (break crc))
print crc

 how this can be expressed in Haskell, without losing clarity?
 
I think it's quite clear what it does.

  inability is an exaggeration - you can use the ContT monad
  transformer, which even allows you to choose how high you
  want to jump. But you probably already know this and just want to point
  that it is cumbersome?
 
 don't know and don't want to use such a hard way.

I gave an example above. You can break with a return value, so it
seem it's what you want.

 there is a simpler solution, but it still requires to write more
 boilerplate code than C:
 
 res - doSomething
 if isLeft res  then return$ fromLeft res  else do
 let (Right x) = res
 ...

Not simpler, but easier... and uglier. Somehow I don't like to solve
problems on the level of programming language syntax.

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


Re: [Haskell-cafe] Re: Channel9 Interview: Software Composability and theFu ture of Languages

2007-02-01 Thread Yitzchak Gale

On 1/31/07, Kirsten Chevalier [EMAIL PROTECTED] wrote:

On 1/31/07, Bill Wood [EMAIL PROTECTED] wrote:
 On Wed, 2007-01-31 at 19:51 +1100, Donald Bruce Stewart wrote:
. . .
  foldl (\water dish - wash water dish) soapywater dishes :: [Dishes]

 Nice example.  First, note that you can't get close with map -- you need
 accumulation across the dishes.  Second, the correctness of this plan
 depends on the rather strong frame axiom that no entity in the
 environment is changed during a step of the fold, so no broken dishes.
 Finally, that doesn't work so well when there are constraints on the
 order that the dishes are washed, for example when washing the cruddiest
 dishes first while there are more suds.



It also assumes that there's necessarily a natural decomposition on
the dishes, and if you think there is, you haven't seen my kitchen!


In my kitchen, there is a natural decomposition on the dishes.
Especially on the ones that have been at the bottom of the pile
for the longest time.

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


Re: Re[4]: [Haskell-cafe] ANNOUNCE: binary: high performance, pure binary serialisation

2007-02-01 Thread Duncan Coutts
On Thu, 2007-02-01 at 10:47 +0300, Bulat Ziganshin wrote:
 Hello Duncan,
 
 Thursday, February 1, 2007, 3:39:16 AM, you wrote:
 
   Can anyone see a real serialisation use case that needs a monad for the
   serialisation side? I'd thought I had an example, but I was wrong.
  
  my program, FreeArc, has its own compression level on top of
  serializing - i.e. data serialized sent in 64k blocks to the C
  compression routine and both serialization and compression are run at
  the same time using threads
 
 i mean that in real world, programs may need to do something in IO
 monad - work with database, network, call C libs

Most of this can be done in a modular and mostly pure way. In that
example I gave, the compression function - while pure - was of course
calling out to a C library.

As an example of a real world program that uses this stuff and does
networking, keeps a persistent store and calls C libs, see
http://hpaste.org/

It uses HappS, ByteStrings and stores the pastes in compressed form on
disk (using my pure zlib wrapper library).

Duncan

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


Re: [Haskell-cafe] Re: Channel9 Interview: Software Composability and theFu ture of Languages

2007-02-01 Thread Neil Bartlett
 The question is --- how would an expert describe such a process? Would a
 professional chef give instructions in the functional or imperative
 style?

I think a sufficiently expert chef would not even need the functional
style. Everything would be declarative.

Dave Thomas (of Pragmatic Programmers fame) tells of finding his late
grandmother's recipe cards, which she accumulated over her entire life. He
was able to track their evolution from an extremely pedantic, imperative
style, through to the almost Zen-like cards that read:

Spice cake: like chocolate cake. No chocolate, add spice.



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


Re: [Haskell-cafe] Re: Channel9 Interview: Software Composability and theFu ture of Languages

2007-02-01 Thread Donald Bruce Stewart
neil:
  The question is --- how would an expert describe such a process? Would a
  professional chef give instructions in the functional or imperative
  style?
 
 I think a sufficiently expert chef would not even need the functional
 style. Everything would be declarative.
 
 Dave Thomas (of Pragmatic Programmers fame) tells of finding his late
 grandmother's recipe cards, which she accumulated over her entire life. He
 was able to track their evolution from an extremely pedantic, imperative
 style, through to the almost Zen-like cards that read:
 
 Spice cake: like chocolate cake. No chocolate, add spice.

Surely this is the arrow or monad transformer of recipe abstractions!
Entirely new functionality, and such information density, on a single line.

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


Re: [Haskell-cafe] Levels of recursion

2007-02-01 Thread Yitzchak Gale

Hi Andrew,

You wrote:

combine :: [Int] - [Int] - [[Int]]
combine [] _ = []
combine (x:xs) ys = (take x ys) : (combine xs (drop x ys))

...A much more experienced haskeller told me he
preferred to write it like this:

combine' :: [Int] - [Int] - [[Int]]
combine' xs ys = snd $ mapAccumL aux ys xs
  where aux ys n = (b,a)
  where (a,b) = splitAt n ys

Ack!


For real work, I like your version better. I might make it
a little more clear what I am trying to do by writing it as:

combine :: [Int] - [a] - [[a]]
combine (x:xs) ys = let (h, t) = splitAt x ys in h : combine xs t
combine _ _ = []

Raw recursions is a bit like goto in imperative programming -
it is often the simplest, but it also can make programs
very difficult to understand.

But as you point out, you can lose more than you gain with
higher-level constructs, unless they are simple, well-documented,
and widely used.

My favorite geeky way of writing your function would be:

combine = evalState . mapM (State . splitAt)

But in real life, I like yours better.

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


Re[2]: [Haskell-cafe] Channel9 Interview: Software Composability and the Future of Languages

2007-02-01 Thread Bulat Ziganshin
Hello Tomasz,

Thursday, February 1, 2007, 1:15:39 PM, you wrote:

 while (hGetBuf h buf bufsize == bufsize)
   crc := updateCrc crc buf bufsize
   break if crc==0
   print crc

 inContT $ callCC $ \break - do
 flip execStateT 0 $ do
 whileM (liftM (== bufsize) (hGetBuf h buf bufsize)) $ do
 modifyM (updateCrc buf bufsize)
 crc - get
 when (crc == 0) (lift (break crc))
 print crc

 how this can be expressed in Haskell, without losing clarity?
  
 I think it's quite clear what it does.

first. it's longer than original. what we can learn here is that
imperative languages have built-in monadic features support,
including automatic lifting and continuations. OTOH, of course, they
don't support type inference. so in one environment we need to
explicitly declare types while in other environment we need to
explicitly specify lifting operations

second. unfortunately, current Haskell libs defined in terms of IO
monad, not MonadIO. while this issue, i hope, will be addressed in
future, i write programs right now :)

-- 
Best regards,
 Bulatmailto:[EMAIL PROTECTED]

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


Re: [Haskell-cafe] Levels of recursion

2007-02-01 Thread Cale Gibbard

On 31/01/07, Andrew Wagner [EMAIL PROTECTED] wrote:

  Like I said, I'm familiar with map, foldr, etc. But this is the
first time it's dawned on me that I need to think in more general
recursive patterns like this instead of simple, raw recursion. That
map and foldr aren't JUST a nice way of doing things to a little list,
but they are recursive operators, building blocks that I need to use
as fluently as anything else.

  I suspect I'm not alone, though of course I could be wrong. But I
would bet that a significant difference between newbies and more
experienced Haskell programmers is the degree to which they can think
in this composition/HOF way. Where the beginner wants to program using
raw, simple recursion, the more experienced sees an opportunity to
apply an abstraction.

  So, a couple of questions to ponder about this: Is this unique to
Haskell, or could the same be said about any functional language? How
can we teach this better to newbies? Most of what I see in the
tutorials is Higher order functions accept as parameters and/or
return other functions. Here's some examples: explanation of map,
explanation of foldr. Moving on, ...   But clearly, this is
something important, and I think we can do a better job of teaching
it. Suggestions?


This is absolutely correct. I suppose I was lucky in that it was
probably my first epiphany of functional programming, and came before
I'd really learned much Haskell at all. I somehow determined that
working on understanding the translation from loops in the imperative
programming I knew to map, filter, zip, fold and so on was going to be
important, which helped a lot. I had a good time taking things that
way, and I certainly think it should be a key point near the beginning
of any functional programming tutorial. Higher order functions, and
higher-order list processing functions in particular, are the control
structures of functional programming. They stick everything else
together. They are every bit as important as loops are to the
imperative programmer. They can also be more natural ways of thinking
about how things fit together than the imperative approach offers. My
friend, who'd had a bit of C++ and a bit of Java, (and had pretty much
hated it), preferred the Haskell approach. He gave me the example that
map wash dishes is a whole lot closer to what you're thinking when
washing dishes than numbering the dishes and incrementing a counter,
washing dish n at each step.

This approach to functional programming is especially important in a
lazy language, since it works so well. Lists are, in a sense, loops
which haven't yet happened, and much of programming is done by
transforming them. Due to laziness, those elements not needed won't be
computed, which is a similar capability as that of being able to break
out of a loop early. This inversion allows you to essentially extend
the code which would be in the loop body after the fact (that is,
without modifying the existing code), which is not something you could
do in a strict imperative language unless you'd specifically provided
for passing in a continuation in the loop, or were modelling lazy
lists somehow.

Eventually, you come to mostly forget about loops and just think in
terms of the lists themselves, but it's a very useful alternate view
to have handy.

Of course, lists aren't the only data structure just as loops aren't
the only kind of recursion. Laziness basically makes data structures
into tools giving you the ability to reify recursion such that only
those steps which end up needed later on are actually carried out.

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


[Haskell-cafe] Modulo-foo equivalence classes in Haskell?

2007-02-01 Thread Diego Navarro

Watching the questions go by in #haskell, a still fuzzy but possibly
pregnant idea popped up in my mind. Someone needed a nubBy function
that returned an unique list modulo an arbitrary function foo. Well,
in this case it wasn't arbitrary; he had a list of transposable
matrices and wanted an unique list of matrices that couldn't be
transposed into each other.

I'm thinking there are many cases of fooBy functions that have to be
constantly rewritten, and also a lot of ugly code by having to
constantly add the modulo clauses (like in modular arithmetic).

I'm inexperienced with type classes -- I've only done the simplest
types and /some/ fundeps -- so I'm wondering what would be the
clearest, most general way of having a Modulo-foo Eq class that could
be parameterized with a function. The transposable matrix example
shows how this could be useful for (some limited form) of data
compression, but it could make some other forms of algebraically
modular (this is not a proper term, it's me trying to get thoughts
across) business rules, of which modular arithmetic is a special case.

Uh, I've probably not expressed myself well enough; I hope I have a
shot at trying to explain myself better if questions come up.

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


Re: [Haskell-cafe] Modulo-foo equivalence classes in Haskell?

2007-02-01 Thread Chris Kuklewicz
Diego Navarro wrote:
 Watching the questions go by in #haskell, a still fuzzy but possibly
 pregnant idea popped up in my mind. Someone needed a nubBy function
 that returned an unique list modulo an arbitrary function foo. Well,
 in this case it wasn't arbitrary; he had a list of transposable
 matrices and wanted an unique list of matrices that couldn't be
 transposed into each other.

I have seen situations that I needed nub/nubBy.  But nubBy is O(n^2) and so I
tend to avoid it if I can.  If you can sort or sortBy then you can use (norep .
sort) or the *By versions.

-- | after sort or sortBy the use of nub/nubBy can be replaced by norep/norepBy
norep :: (Eq a) = [a]-[a]
norep [] = []
norep [EMAIL PROTECTED] = x
norep (a:bs@(c:cs)) | a==c = norep (a:cs)
| otherwise = a:norep bs

-- | after sort or sortBy the use of nub/nubBy can be replaced by norep/norepBy
norepBy :: (a - a - Bool) - [a] - [a]
norepBy _ [] = []
norepBy _ [EMAIL PROTECTED] = x
norepBy eqF (a:bs@(c:cs)) | a `eqF` c = norepBy eqF (a:cs)


 
 I'm thinking there are many cases of fooBy functions that have to be
 constantly rewritten, and also a lot of ugly code by having to
 constantly add the modulo clauses (like in modular arithmetic).
 
 I'm inexperienced with type classes -- I've only done the simplest
 types and /some/ fundeps -- so I'm wondering what would be the
 clearest, most general way of having a Modulo-foo Eq class that could
 be parameterized with a function.

You have a type X and it already has an Eq instance.  But you want to (nubBy
foo) a list [X].  You could use a newtype:

newtype Y = Y { unY :: X }

instance Eq Y where (==) = foo

nub' :: [X] - [X]
nub' = map unY . sort . map Y

 The transposable matrix example
 shows how this could be useful for (some limited form) of data
 compression, but it could make some other forms of algebraically
 modular (this is not a proper term, it's me trying to get thoughts
 across) business rules, of which modular arithmetic is a special case.
 
 Uh, I've probably not expressed myself well enough; I hope I have a
 shot at trying to explain myself better if questions come up.
 

But I may have misunderstood what you want.  Here is a solution to a related
problem:

http://portal.acm.org/citation.cfm?id=1017481dl=ACMcoll=CFID=15151515CFTOKEN=6184618
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Modulo-foo equivalence classes in Haskell?

2007-02-01 Thread Diego Navarro

newtype Y = Y { unY :: X }

instance Eq Y where (==) = foo

nub' :: [X] - [X]
nub' = map unY . sort . map Y



Yes, I thought of that. I'm really thinking of how I can generalize
the Eq class so I dont have to go around manually lifting operations
that are already defined (like operations on integers for modulo-n
rings)

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


Re: [Haskell-cafe] Modulo-foo equivalence classes in Haskell?

2007-02-01 Thread Diego Navarro

Yes, I thought of that. I'm really thinking of how I can generalize
the Eq class so I dont have to go around manually lifting operations
that are already defined (like operations on integers for modulo-n
rings)


(I do realize it's a lucky chance that the ordinary (+) and (*) work
so well on modulo-n rings. Anyway, that's besides the point.)
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] Boost equivalent

2007-02-01 Thread John Ky

Hi,

Does the Haskell community have an equivalent to C++ community's Boost
project with the aim of writing libraries for the eventual inclusion into
Haskell?

Thanks

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


Re: [Haskell-cafe] Boost equivalent

2007-02-01 Thread Neil Mitchell

Hi John,


Does the Haskell community have an equivalent to C++ community's Boost
project with the aim of writing libraries for the eventual inclusion into
Haskell?


We have:

1) MissingH - a nice staging ground for things that may end up in the
base library

2) Library submission process, to add things to the base libraries

3) Hackage - anyone can write a library that anyone can use.

I think that covers most uses.

Thanks

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


[Haskell-cafe] Connected!

2007-02-01 Thread Bulat Ziganshin
Hello haskell-cafe,

i've just got ADSL connection here! it's slow (64k) and not cheap, but
at least it is completely different from dial-up i've used before

-- 
Best regards,
 Bulat  mailto:[EMAIL PROTECTED]

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


Re: [Haskell-cafe] Connected!

2007-02-01 Thread Joel Reymont

What part of Russia do you live in?

On Feb 1, 2007, at 1:23 PM, Bulat Ziganshin wrote:


Hello haskell-cafe,

i've just got ADSL connection here! it's slow (64k) and not cheap, but
at least it is completely different from dial-up i've used before


--
http://wagerlabs.com/





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


Re: [Haskell-cafe] Boost equivalent

2007-02-01 Thread Bulat Ziganshin
Hello John,

Thursday, February 1, 2007, 4:03:09 PM, you wrote:
 Does the Haskell community have an equivalent to C++ community's
 Boost project with the aim of writing libraries for the eventual inclusion 
 into Haskell?

i guess that the only reason why C++ people need such project is
because there are too many developers that want to develop such libs.
that's not true for Haskell. for example, the most successful library
of 2006 - ByteString - was developed by just 3 main contributors. if
you want to develop somewhat useful - just do it. if you want to add
more functionality to existing library - including base! - just send
your patches to the maintainer. the only thing we missing, imho, is a
darcs repository (or instructions for dummies like me on how to setup
my own publicly accessible repository, say, on haskell.org)

-- 
Best regards,
 Bulatmailto:[EMAIL PROTECTED]

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


Re: [Haskell-cafe] Boost equivalent

2007-02-01 Thread Chris Kuklewicz
Bulat Ziganshin wrote:
 Hello John,
 
 Thursday, February 1, 2007, 4:03:09 PM, you wrote:
 Does the Haskell community have an equivalent to C++ community's
 Boost project with the aim of writing libraries for the eventual inclusion 
 into Haskell?

The Haskell community is hosted on the wiki at haskell.org.

 i guess that the only reason why C++ people need such project is
 because there are too many developers that want to develop such libs.
 that's not true for Haskell. for example, the most successful library
 of 2006 - ByteString - was developed by just 3 main contributors. if
 you want to develop somewhat useful - just do it. if you want to add
 more functionality to existing library - including base! - just send
 your patches to the maintainer. the only thing we missing, imho, is a
 darcs repository (or instructions for dummies like me on how to setup
 my own publicly accessible repository, say, on haskell.org)
 

When I wrote the regex-* packages to upgrade and extend and replace Text.Regex I
worked alone and then submitted them in time for the GHC 6.6 / base 2.0 release.
 They gave me darcs space (which I am still using for the project) on
darcs.haskell.org.  This was useful for the GHC developers since they needed
some of it there for GHC anyway.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re[2]: [Haskell-cafe] Connected!

2007-02-01 Thread Bulat Ziganshin
Hello Joel,

Thursday, February 1, 2007, 4:25:45 PM, you wrote:

 What part of Russia do you live in?

Tatarstan. we make Kamaz here :)  if you are interested, such
situation is very common for Russia - except for Moscow and a few
other largest cities, internet costs are very high.

you will stop wondering if i say that son of Tatarstan's chief - the
richest man in Tatarstan. and he is not a genius - he just own the
biggest independent Tatarstan Internet provider, his wealth built
from those crazy rates. other businessmen that want to become
providers, just don't got appropriate licenses from his father

and this situation isn't unique. richest woman in Russia is a wife of
Moscow mayor. she build houses in Moscow. you may guess that other
builders just don't got licenses/land for their work. as a result,
Moscow has highest cost of floor space in the world

so Moscow has cheap internet and expensive apartments, and we - vice
versa :)  btw, all the underdeveloped countries has the same situation
with corruption - and this is one of reasons why they are underdeveloped ;)



 On Feb 1, 2007, at 1:23 PM, Bulat Ziganshin wrote:

 Hello haskell-cafe,

 i've just got ADSL connection here! it's slow (64k) and not cheap, but
 at least it is completely different from dial-up i've used before








-- 
Best regards,
 Bulatmailto:[EMAIL PROTECTED]

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


[Haskell-cafe] data package

2007-02-01 Thread Pavel Rozenblioum

Hi,
I am trying to compile the GLR examples from Happy 1.16, but I get the
message that I am missing the data package. Where can I download it
from? I am using GHC 6.6

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


[Haskell-cafe] Importance of MonadRandom

2007-02-01 Thread Yitzchak Gale

I would like to point out the importance of Cale Gibbard's
MonadRandom, beyond what is currently mentioned
on its wiki page:

http://www.haskell.org/haskellwiki/New_monads/MonadRandom

This monad makes it possible to write functions that
use randomness without having to specify in
advance whether the source of randomness will
be a pure pseudorandom number generator, as
in System.Random, or physical randomness via
the IO monad, such as your operating system's
source of physical randomness, or random.org,
or a hardware random generator.

Before use of MonadRandom becomes widespread -
and I think it ought to - I would like to suggest a change
to the interface. (I mentioned this once to
Cale on #haskell, but I didn't say what change
I meant.)

Currently, the members of the MonadRandom
class mimic the members of the Random class
in System.Random. I think it would be better if
instead they mimicked the members of
RandomGen. Like this:

\begin{code}

class (Monad m) = MonadRandom m where
 nextR :: m Int
 splitR :: m (m ())
 rangeR :: m (Int, Int)
 getR :: (forall g . RandomGen g = g - a) - m a

\end{code}

The extra function getR provides access not
only to the member functions of Random, but
to any function that generates random variables
of any type. You would use

getR random, getR $ randomR (a, b), etc.

instead of

getRandom, getRandomR (a, b), etc.


Provide a default method for getR as follows:

\begin{code}

 getR f = do
   r - nextR
   (lo, hi) - rangeR
   return $ f $ TrivialGen r lo hi

data TrivialGen = TrivialGen Int Int Int

instance RandomGen TrivialGen where
 next (TrivialGen r _ _) = r
 genRange (TrivialGen _ lo hi) = (lo, hi)
 split _ = undefined

\end{code}

We would use the default method of getR for
MonadRandom instances of things like
DevRandom, DevURandom, RandomDotOrg,
etc. For the Rand and RandT instances we
provide explicit methods:

\begin{code}

-- For RandT:
 getR f = RandT $ gets f

--For Rand:
 getR =Rand $ getR f

\end{code}

I think this is better for several reasons:

o We anyway need getR for general random variables
o We could lose precision getting other random
 variables via getRandom in the case where
 genRange /= (minBound, maxBound)
o I think it is a better semantic fit

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


Re: [Haskell-cafe] Think of a monad...

2007-02-01 Thread Frederick Ross

And we have reached the monadic equivalent of Schrodinger's cat.

On 1/31/07, Eric Y. Kow [EMAIL PROTECTED] wrote:

Dear Haskellers,

In the recent HWN, I noticed a new monad metaphor by Don Stewart:
  Think of a monad as a spacesuite full of nuclear waste in the ocean next to a
  container of apples. now, you can't put oranges in the space suite or the
  nucelar waste falls in the ocean, *but* the apples are carried around
  anyway, and you just take what you need

This metaphor very clearly captures the essence of monads.  Perhaps it
will be even more helpful if accompanied by a small illustration:
  http://koweycode.blogspot.com/2007/01/think-of-monad.html

I hope this turns out to be useful to somebody,

--
Eric Kow http://www.loria.fr/~kow
PGP Key ID: 08AC04F9 Merci de corriger mon français.

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






--
Frederick Ross
Graduate Fellow, (|Siggia + |McKinney)/sqrt(2) Lab
The Rockefeller University
Je ne suis pas Fred Cross!
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] Re: Takusen - error handling and DBM monad

2007-02-01 Thread Al Falloon

Bayley, Alistair wrote:

Al Falloon wrote:

what does withSession return if there is a DBException?


Well, whatever the handler returns, same as with any other exception
handler. Note that this must have the same type as whatever withSession
returns, and this constraint is enforced by the type of catch/catchDB:


Sorry, I wasn't clear. What does it return when there is an uncaught 
exception? It sounds like it raises an exception in IO. Is this correct?


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


Re: [Haskell-cafe] Think of a monad...

2007-02-01 Thread Dan Mead

so are monads whats holding the nuclear waste or whats holding the apples?

;)

On 2/1/07, Frederick Ross [EMAIL PROTECTED] wrote:


And we have reached the monadic equivalent of Schrodinger's cat.

On 1/31/07, Eric Y. Kow [EMAIL PROTECTED] wrote:
 Dear Haskellers,

 In the recent HWN, I noticed a new monad metaphor by Don Stewart:
   Think of a monad as a spacesuite full of nuclear waste in the ocean
next to a
   container of apples. now, you can't put oranges in the space suite or
the
   nucelar waste falls in the ocean, *but* the apples are carried around
   anyway, and you just take what you need

 This metaphor very clearly captures the essence of monads.  Perhaps it
 will be even more helpful if accompanied by a small illustration:
   http://koweycode.blogspot.com/2007/01/think-of-monad.html

 I hope this turns out to be useful to somebody,

 --
 Eric Kow http://www.loria.fr/~kow
 PGP Key ID: 08AC04F9 Merci de corriger mon français.

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





--
Frederick Ross
Graduate Fellow, (|Siggia + |McKinney)/sqrt(2) Lab
The Rockefeller University
Je ne suis pas Fred Cross!
___
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[2]: [Haskell-cafe] Think of a monad...

2007-02-01 Thread Bulat Ziganshin
Hello Frederick,

Thursday, February 1, 2007, 6:11:32 PM, you wrote:

 And we have reached the monadic equivalent of Schrodinger's cat.

yes, it's exact reason why we love monads - the appropriate fruits in
container are appeared depending on environment where it's used. you
send probabilistic container to the friend, she should just say i believe
that it contains apples before opening it


 In the recent HWN, I noticed a new monad metaphor by Don Stewart:
   Think of a monad as a spacesuite full of nuclear waste in the ocean next 
 to a
   container of apples. now, you can't put oranges in the space suite or the
   nucelar waste falls in the ocean, *but* the apples are carried around
   anyway, and you just take what you need

 This metaphor very clearly captures the essence of monads.  Perhaps it
 will be even more helpful if accompanied by a small illustration:
   http://koweycode.blogspot.com/2007/01/think-of-monad.html

 I hope this turns out to be useful to somebody,

 --
 Eric Kow http://www.loria.fr/~kow
 PGP Key ID: 08AC04F9 Merci de corriger mon francais.

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








-- 
Best regards,
 Bulatmailto:[EMAIL PROTECTED]

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


Re: Re[2]: [Haskell-cafe] Channel9 Interview: Software Composability andthe Future of Languages

2007-02-01 Thread Claus Reinke

while (hGetBuf h buf bufsize == bufsize)
  crc := updateCrc crc buf bufsize
  break if crc==0
  print crc



inContT $ callCC $ \break - do
flip execStateT 0 $ do
whileM (liftM (== bufsize) (hGetBuf h buf bufsize)) $ do
modifyM (updateCrc buf bufsize)
crc - get
when (crc == 0) (lift (break crc))
print crc


first. it's longer than original. 


is it, though? what makes it longer are features that the original doesn't have,
I think. so how about a less ambitious translation, with crc in an MVar and a
while-loop that can be broken from the body as well as the condition:

   while (hGetBuf h buf bufzise .==. (return bufsize)) $ do
   crc =: updateCrc crc buf bufsize
   breakIf ((val crc) .==. (return 0)) `orElse` do
   printM (val crc)
   od

using definitions roughly like this

   while c b = do { r - c; when r (b = flip when (while c b)) }
   continueIf c m = c = \b- if b then od else m
   breakIf c m = c = \b- if b then return False else m
   orElse = ($)
   od :: Monad m = m Bool
   od = return True

   x .==. y = liftM2 (==) x y
   printM x = x = print

   v =: x = do { rx - x; swapMVar v rx }
   val = readMVar

not that I like that style;-)
Claus

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


Re: [Haskell-cafe] Let's welcome the Ruby hackers!

2007-02-01 Thread Martin DeMello

On 2/1/07, Donald Bruce Stewart [EMAIL PROTECTED] wrote:


So a big hello to any Ruby/Rails hackers lurking out there!
Free lambdas for all if you drop by #haskell...


I came to Haskell from Ruby the first time around, but didn't have
anything real to write in it so I lost steam somewhat. This time I'm
here following the parser combinator trail, so hopefully it'll stick
:)

martin

p.s.  Is there a collection of parsec parsers for various languages
maintained anywhere? I hunted around but didn't find anything.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


RE: [Haskell-cafe] Re: Takusen - error handling and DBM monad

2007-02-01 Thread Bayley, Alistair
 From: [EMAIL PROTECTED] 
 [mailto:[EMAIL PROTECTED] On Behalf Of Al Falloon
 
 Bayley, Alistair wrote:
  Al Falloon wrote:
  what does withSession return if there is a DBException?
  
  Well, whatever the handler returns, same as with any other exception
  handler. Note that this must have the same type as whatever 
 withSession
  returns, and this constraint is enforced by the type of 
 catch/catchDB:
 
 Sorry, I wasn't clear. What does it return when there is an uncaught 
 exception? It sounds like it raises an exception in IO. Is 
 this correct?


Well, a function raising an uncaught exception doesn't really return
anything - it's raised an exception. I'm not clear on the semantics of
exceptions in Haskell, but if you don't catch it then eventually it
reaches the RTS, which will halt your program with an uncaught exception
error. If you're asking if it propagates up to the RTS, then the answer
is yes. The downside is that because it's a dynamic exception, the RTS
can't/won't show anything other than uncaught dynamic exception, which
isn't helpful.

Alistair
*
Confidentiality Note: The information contained in this message,
and any attachments, may contain confidential and/or privileged
material. It is intended solely for the person(s) or entity to
which it is addressed. Any review, retransmission, dissemination,
or taking of any action in reliance upon this information by
persons or entities other than the intended recipient(s) is
prohibited. If you received this in error, please contact the
sender and delete the material from any computer.
*
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re[4]: [Haskell-cafe] Channel9 Interview: Software Composability andthe Future of Languages

2007-02-01 Thread Bulat Ziganshin
Hello Claus,

Thursday, February 1, 2007, 6:34:23 PM, you wrote:

 is it, though? what makes it longer are features that the original doesn't 
 have,

and what i don't need :)

 I think. so how about a less ambitious translation, with crc in an MVar and a
 while-loop that can be broken from the body as well as the condition:

 while (hGetBuf h buf bufzise .==. (return bufsize)) $ do
 crc =: updateCrc crc buf bufsize
 breakIf ((val crc) .==. (return 0)) `orElse` do
 printM (val crc)
 od

your solution is just to make lifted copy of each and every pure
operation. so one should define 2^n operations where n is number of
arguments


-- 
Best regards,
 Bulatmailto:[EMAIL PROTECTED]

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


Re: [Haskell-cafe] Boost equivalent

2007-02-01 Thread Alexy Khrabrov
One of the great strengths of Python is Boost.Python.  Practitioners  
say it's a major advantage of Python over Ruby, for example.  So the  
question is not whether there's a Boost in Haskell -- C++ and Haskell  
are too different for it to have much meaning -- but whether there's  
or going to be a Boost.Haskell?


Cheers,
Alexy

On Feb 1, 2007, at 5:03 AM, John Ky wrote:
Does the Haskell community have an equivalent to C++ community's  
Boost project with the aim of writing libraries for the eventual  
inclusion into Haskell?


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


[Haskell-cafe] Circular programming (aka time-travel) resources?

2007-02-01 Thread Justin Bailey

In The Monad.Reader - Issue 6, that just came out, there is a really
interesting article that uses a circular technique to implement an
assembly language in Haskell. The technique demonstrated seems
fascinating. Can someone point me to more resources on the topic?

A quick google search turned up a couple of blogs and some papers -
but is there more out there?

Thanks for any help!

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


Re: [Haskell-cafe] Circular programming (aka time-travel) resources?

2007-02-01 Thread Neil Mitchell

Hi Justin,


A quick google search turned up a couple of blogs and some papers -
but is there more out there?


http://news.cs.york.ac.uk/ftpdir/pub/colin/jfp97lw.ps.gz

Laziness, circularity and prime numbers all in one :)

Thanks

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


Re: [Haskell-cafe] Let's welcome the Ruby hackers!

2007-02-01 Thread Paul Johnson

On 2/1/07, Donald Bruce Stewart [EMAIL PROTECTED] wrote:

So a big hello to any Ruby/Rails hackers lurking out there!
Free lambdas for all if you drop by #haskell...


I think we should also try to get some feedback about the learning 
experience: what tutorials work best, and what don't?  Do metaphors for 
monads work?  How did they get their heads around big-O complexity with 
lazy evaluation, and so on.


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


Re: [Haskell-cafe] Circular programming (aka time-travel) resources?

2007-02-01 Thread Wouter Swierstra

Hi Justin,


In The Monad.Reader - Issue 6, that just came out, there is a really
interesting article that uses a circular technique to implement an
assembly language in Haskell. The technique demonstrated seems
fascinating. Can someone point me to more resources on the topic?


I believe the classical reference is:

Richard Bird: Using Circular Programs to Eliminate Multiple  
Traversals of Data.

(http://www.springerlink.com/content/g74174vvl1861605/)

There are a few more recent wiki pages worth checking out:

http://www.haskell.org/hawiki/CircularProgramming

and the more recent

http://www.haskell.org/haskellwiki/Circular_programming

Hope this helps,

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


[Haskell-cafe] Re: Boost equivalent

2007-02-01 Thread Al Falloon
Boost.Python is for extending Python with C++, or embedding Python in 
C++. This is especially useful because it allows you to use Python as an 
extension language for a C++ program.


Presumably Boost.Haskell would be for integrating Haskell code with C++, 
which would of course be useful, but the main use case (an embedded 
extension language) that draws people to Boost.Python isn't as much of a 
draw for Haskell because of the compilation phase.


On the other hand, I suppose you could always integrate a Haskell 
interpreter like Hugs, or even go the HsPlugins route and dynamically 
load a compiled module, but the fit doesn't seem as natural as it does 
with a latently typed scripting language.


There are also technical problems that are hard to overcome. Extending 
Python is mostly done in C, so a C++ library to add some nice sugar is a 
good fit. Haskell, OTOH, embeds C programs via its FFI. There doesn't 
seem to be any way to export functions and value from C++ to Haskell, 
but instead the C++ code must import from Haskell. All the heavy lifting 
is done on the Haskell side, so there isn't as much opportunity to write 
a slick C++ library.


This could change if someone made a version of Hugs that can be linked 
in as a library with a documented C API for evaluating Haskell code and 
mucking with Haskell values. But I don't think its much of a priority 
right now :)


--
Alan Falloon

Alexy Khrabrov wrote:
One of the great strengths of Python is Boost.Python.  Practitioners say 
it's a major advantage of Python over Ruby, for example.  So the 
question is not whether there's a Boost in Haskell -- C++ and Haskell 
are too different for it to have much meaning -- but whether there's or 
going to be a Boost.Haskell?


Cheers,
Alexy

On Feb 1, 2007, at 5:03 AM, John Ky wrote:
Does the Haskell community have an equivalent to C++ community's Boost 
project with the aim of writing libraries for the eventual inclusion 
into Haskell?


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


Re: [Haskell-cafe] ANNOUNCE: The Monad.Reader - Issue 6

2007-02-01 Thread Spencer Janssen

Yet another higher order solution:

dropWhile' p0 xs = foldr f (const []) xs $ p0
  where
f y ys p | p y   = ys p
 | otherwise = y : ys (const False)


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


Re: [Haskell-cafe] ANNOUNCE: The Monad.Reader - Issue 6

2007-02-01 Thread Bernie Pope

David House wrote:

It was a great article though, seeing
fix's definition in terms of foldr was one of those mind-bending
moments which makes learning Haskell what it is.


It's nice to see so many new solutions posted in the cafe.

The great thing about Haskell is that it keeps on giving :)

Cheers,
Bernie.


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


Re: [Haskell-cafe] Re: Boost equivalent

2007-02-01 Thread Slavomir Kaslev

On 2/1/07, Al Falloon [EMAIL PROTECTED] wrote:

Boost.Python is for extending Python with C++, or embedding Python in
C++. This is especially useful because it allows you to use Python as an
extension language for a C++ program.

Presumably Boost.Haskell would be for integrating Haskell code with C++,
which would of course be useful, but the main use case (an embedded
extension language) that draws people to Boost.Python isn't as much of a
draw for Haskell because of the compilation phase.

On the other hand, I suppose you could always integrate a Haskell
interpreter like Hugs, or even go the HsPlugins route and dynamically
load a compiled module, but the fit doesn't seem as natural as it does
with a latently typed scripting language.

There are also technical problems that are hard to overcome. Extending
Python is mostly done in C, so a C++ library to add some nice sugar is a
good fit. Haskell, OTOH, embeds C programs via its FFI. There doesn't
seem to be any way to export functions and value from C++ to Haskell,
but instead the C++ code must import from Haskell. All the heavy lifting
is done on the Haskell side, so there isn't as much opportunity to write
a slick C++ library.

This could change if someone made a version of Hugs that can be linked
in as a library with a documented C API for evaluating Haskell code and
mucking with Haskell values. But I don't think its much of a priority
right now :)

--
Alan Falloon



I think a more common scenario would be using C++ legacy code in
Haskell project. I would imagine Boost.Haskell as collection of code
generation templates for exposing C++ APIs to be used in Haskell. That
would be sweet. Even sweeter is easily accessing .Net Framework from
ghc, especially for Windows users. .Net Framework is huge. It is
de-facto _the_ windows framework. Are there any projects going in this
direction?

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


Re: Re[4]: [Haskell-cafe] Channel9 Interview: Software Composabilityandthe Future of Languages

2007-02-01 Thread Claus Reinke

while (hGetBuf h buf bufzise .==. (return bufsize)) $ do
crc =: updateCrc crc buf bufsize
breakIf ((val crc) .==. (return 0)) `orElse` do
printM (val crc)
od


your solution is just to make lifted copy of each and every pure
operation. so one should define 2^n operations where n is number of
arguments


ah, I thought the problem at hand was breaking out of a while loop.
but if you look closely, I think you'll find it to be ~2 operations, the
monadic one, and possibly a pure one to be lifted. one can always
lift pure arguments via return, and use the fully lifted monadic 
operation, as I did in the example code (you were talking about 
imperative programming, after all?-). 

if one were to go down that route, one would probably want to 
overload literals, such as (Num a,Monad m) = Num (m a) for 
fromInteger, rather than writing (return 0) everywhere, and as usual,

the obligatory superclasses would get in the way and would have to
be ignored, and Bool isn't overloaded, .. all the usual suspects for 
hampering embedded DSLs in Haskell.


Claus

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


[Haskell-cafe] (a - [b]) vs. [a - b]

2007-02-01 Thread Chad Scherrer

Are (a - [b]) and [a - b] isomorphic? I'm trying to construct a function

f :: (a - [b]) - [a - b]

that is the (at least one-sided) inverse of

f' :: [a - b] - a - [b]
f' gs x = map ($ x) gs

It seems like it should be obvious, but I haven't had any luck with it yet.
Any help is greatly appreciated.

Thanks,

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


[Haskell-cafe] Write Yourself a Scheme in 48 Hours

2007-02-01 Thread Shannon -jj Behrens

I'm going through the Write Yourself a Scheme in 48 Hours
http://halogen.note.amherst.edu/~jdtang/scheme_in_48/tutorial/overview.html
tutorial.  I like it a lot, but I have some concerns.  Are the
exercises in the tutorial known to be solvable by mere mortals?

For instance:

Rewrite parseNumber using...explicit sequencing with the = operator
http://halogen.note.amherst.edu/~jdtang/scheme_in_48/tutorial/parser.html#symbols

There aren't any examples of using = previous to this question.
Furthermore, the link to the Standard Prelude is not helpful because
there aren't any examples of how to use =.

Furthermore, consider the exercise:

Change parseNumber to support the Scheme standard for different
bases. You may find the readOct and readHex functions useful.
http://halogen.note.amherst.edu/~jdtang/scheme_in_48/tutorial/parser.html#symbols

I struggled against this for a couple hours last night.  How is the
reader supposed to figure out readOct, which is part of ReadS, without
understanding the whole ReadS business?  If the reader does understand
the ReadS business, he probably already understands Haskell far better
than the tutorial seems to suggest.  I eventually figured out how to
write:

parseHexNumber = do char '#'
   char 'x'
   s - many1 (oneOf 0123456789abcdefABCDEF)
   case readHex s of
 [(n,)] - return n

but it was no small feat.  Furthermore, it was only possible because I
had already spent so much time trying to understand A Gentle
Introduction to Haskell.  Worst of all, once I had it all
implemented, the parser *from* the tutorial:

parseExpr :: Parser LispVal
parseExpr = parseAtom
   | parseString
   | parseNumber

led to some surprising results.  It turns out that #o9, which should be
an invalid attempt at an octal number, is getting parsed as an atom.
There's a whole layer of difficulty that seems insurmountable by mere
mortals like me using just this tutorial and minimal reference usage.

What am I missing?  Is it really solvable by mere mortals who don't
already know Haskell, the Parsec module, etc.?

Thanks,
-jj

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


Re: [Haskell-cafe] Channel9 Interview: Software Composability and the Future of Languages

2007-02-01 Thread Steve Downey

The 70's and early 80's were very different in terms of information
propagation. I really miss some the journals available back then,
because the editors really did their jobs, both in selecting and
helping to convey, information.
OO did get oversold. The same way that putting it on the internet did
at the beginning of this century (I love saying that, now, where's my
flying car)
but just like many of the good principles of structured programming
inform OO, it should be possible to take good OO and apply it
functionally.

On 1/30/07, Bulat Ziganshin [EMAIL PROTECTED] wrote:

Hello Steve,

Friday, January 26, 2007, 10:03:09 PM, you wrote:

 Haskell _is_ hard, although I don't think it's _too_ hard, or I wouldn't
...

 The audience for programming languages like Haskell is always going to
 be small, because it appeals to those who want to understand how the TV
 works,

i don't think so :)  imho, we just don't have good _teachers_. in
70's, OOP audience was also small, but it was popularized later and
now every student know about polymorphism via inheritance. but most of
OOP programmers don't reinvent the wheels, they just use patterns
described in OOP bestselling books

i have a positive experience of making complex concepts easy and
available for wide audience ([1]-[5]), [1] was even used to teach
students in some college. and i guess that good Haskell books, such as
yaht and printed ones, also make it easy to learn Haskell. but we need
to gather much more attention to Haskell to make it as patternized
as structured-programming and OOP. _nowadays_ there is no even one
advanced Haskell or Haskell in Real World book and this means that
anyone who want to learn Haskell in deep should study those terrible papers

(well, it's very like higher education in Russia - no one really
teaches you at our colleges so you should either learn yourself or die :)
but this means that at least whose who still alive, are Real Machos :)

the same apply to Haskell - now the only way to learn it is to learn
yourself, so we all definitely are cool mans. once i even got C# job
offer only because i know Haskell :)


[1] http://haskell.org/haskellwiki/IO_inside
http://haskell.org/haskellwiki/OOP_vs_type_classes
http://haskell.org/haskellwiki/Modern_array_libraries
http://haskell.org/bz/th3.htm
http://haskell.org/bz/thdoc.htm

--
Best regards,
 Bulatmailto:[EMAIL PROTECTED]

___
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] Write Yourself a Scheme in 48 Hours

2007-02-01 Thread Bryan O'Sullivan

Shannon -jj Behrens wrote:

I'm going through the Write Yourself a Scheme in 48 Hours
http://halogen.note.amherst.edu/~jdtang/scheme_in_48/tutorial/overview.html 


tutorial.  I like it a lot, but I have some concerns.  Are the
exercises in the tutorial known to be solvable by mere mortals?


The answer seems to be yes, iff the mortals in question have grasped 
the basics of monads, so they can fill in the gaps in the exposition.



For instance:

Rewrite parseNumber using...explicit sequencing with the = operator
http://halogen.note.amherst.edu/~jdtang/scheme_in_48/tutorial/parser.html#symbols 


There aren't any examples of using = previous to this question.


There's a peculiar mixture of assumptions in the article.  He treats 
monads breezily, as if they're a given; but pattern matching (much more 
basic) receives some rather more detailed exposition.  And he glosses 
over , but doesn't mention the rewrite rule from a-x to x=\a-.


So don't beat yourself up.  The tutorial is missing a few bits and pieces.

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


[Haskell-cafe] strict bytestring fun

2007-02-01 Thread Donald Bruce Stewart
High performance strings on the shootout:

http://shootout.alioth.debian.org/gp4/benchmark.php?test=sumcollang=all

interesting alternative programs
0.5   Haskell GHC #5  1.2990,880270

1.0   Clean   2.77600   136
2.0   C gcc   5.64444   159
2.1   D Digital Mars #2   5.85700   153
2.3   C++ g++ #2  6.46848   244

Ah well, its illegally strict, but its good to know you can do it, eh?

(A lazy bytestring version has been submitted, we'll see how that runs).

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


Re: [Haskell-cafe] Let's welcome the Ruby hackers!

2007-02-01 Thread Alexis
On Fri, 2 Feb 2007 06:46 am, Paul Johnson wrote:

 I think we should also try to get some feedback about the learning
 experience: what tutorials work best, and what don't?  Do metaphors for
 monads work?

Fwiw, here's an excerpt from something i wrote in my blog about monads (where 
i've substituted links with references to footnotes):

People have tried to communicate what Haskell monads are about in 
various
ways: via 'container' metaphors (e.g. this[1] and this[2]; i found the 
former
to be more illuminating than the latter); via relationship metaphors 
(e.g.
this[3], which i found more confusing than helpful), and even via a
 'monsters' metaphor[4] (which i found to be rather amusing)1. One 
tutorial
that people on the Haskell-café list seem eager to recommend (and that's
recommended on the Haskellwiki) is All about monads[5], but that just
overwhelmed me when i first read it; and even now, when i've got a 
better
understanding of monads, i still find it difficult to follow. In 
contrast, i
found Tackling the awkward squad[6] and Monads for functional 
programming[7]
to both be very enlightening.

As far as i can tell, however, a monad simply seems to be a 
computational
environment in which one can specify that certain types and methods of
computation be performed, and in which the three monad laws are 
expected to
hold.

[1] http://www.haskell.org/haskellwiki/Monads_as_containers
[2] http://en.wikibooks.org/wiki/Haskell/Understanding_monads
[3] http://www.haskell.org/haskellwiki/Meet_Bob_The_Monadic_Lover
[4] 
http://www.haskell.org/pipermail/haskell-cafe/2006-November/019190.html
[5] http://www.nomaware.com/monads/html/
[6] http://research.microsoft.com/~simonpj/papers/marktoberdorf/
[7] http://homepages.inf.ed.ac.uk/wadler/topics/monads.html

To that, i would also add that i've found Martin Grabmueller's Monad 
Transformers Step by 
Step ( http://uebb.cs.tu-berlin.de/~magr/pub/Transformers.en.html ) and 
Simon Peyton-Jones' Beautiful 
Concurrency ( http://programming.reddit.com/info/vsba/comments ) to be very 
readable and enlightening. Finally, i enjoyed reading Hal Daume III's Yet 
Another Haskell Tutorial, since unlike many introductions to Haskell, it 
assumed that i was already familiar with a variety of programming concepts.

My background: well, firstly, apropos of the recent discussions about the 
qualifications of those studying / learning Haskell, i have a Bachelor of 
Arts degree majoring in Womens' Studies. :-) i have, however, done 
professional development work using both Perl and VBA (the latter in the 
context of MS Access). The only formal mathematical training i've had is the 
mathematics i did at secondary school, which went up to and included the 
basics of differentiation and integration. Having said that, i have continued 
to teach myself various areas of mathematics (e.g. set theory and point-set 
topology - category theory i'd like to learn more about, but am struggling to 
get around to doing so).

i must say i'm really enjoying learning Haskell: not only because, as a side 
effect :-), i'm ending up learning various bits and pieces about computer 
science; but also because i've come to very much appreciate the Haskell 
community. In contrast with other IT-related communities i've experienced, 
i've found the Haskell community (both here and on IRC) to generally be 
helpful, good-humoured and mercifully lacking in flames and alpha 
behaviours. :-)

i'm really hoping this Cookbook project happens - it would be great to be 
able to turn to Haskell for solutions to the sort of problems i come across 
on a regular basis, so that i'm no longer solely thinking in terms of Perl 
solutions to those problems. :-)


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


[Haskell-cafe] snd and tuples of various sizes...

2007-02-01 Thread Tim Newsham

This seems to make using tuples of various sizes easier (and can
also be applied to non-tuples).  I think it more closely matches
how I describe something in spoken language (when I say second
its obvious what that means for any tuple size):

{-# OPTIONS_GHC -fglasgow-exts #-}
module Main where

class Second a b | a - b where
snd :: a - b
instance Second (a,b) b where
snd (a,b) = b
instance Second (a,b,c) b where
snd (a,b,c) = b
instance Second (a,b,c,d) b where
snd (a,b,c,d) = b
instance Second (a,b,c,d,e) b where
snd (a,b,c,d,e) = b
instance Second (a,b,c,d,e,f) b where
snd (a,b,c,d,e,f) = b

instance Second [a] a where
snd [] = error don't got none
snd (x:y:xs) = y

main = do
print $ snd (1,2)
print $ snd (8,9,3)
print $ snd (9,8,9,3)
print $ snd (4,9,8,9,3)
print $ snd [3,4]

Tim Newsham
http://www.thenewsh.com/~newsham/
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Write Yourself a Scheme in 48 Hours

2007-02-01 Thread Henk-Jan van Tuyl


See for examples of the usage of = A tour of the Haskell monad  
functions, URL:

  members.chello.nl/hjgtuyl/tourdemonad.html


On Fri, 02 Feb 2007 01:31:36 +0100, Shannon -jj Behrens [EMAIL PROTECTED]  
wrote:



I'm going through the Write Yourself a Scheme in 48 Hours
http://halogen.note.amherst.edu/~jdtang/scheme_in_48/tutorial/overview.html
tutorial.  I like it a lot, but I have some concerns.  Are the
exercises in the tutorial known to be solvable by mere mortals?

For instance:

Rewrite parseNumber using...explicit sequencing with the = operator
http://halogen.note.amherst.edu/~jdtang/scheme_in_48/tutorial/parser.html#symbols

There aren't any examples of using = previous to this question.
Furthermore, the link to the Standard Prelude is not helpful because
there aren't any examples of how to use =.


--
Met vriendelijke groet,
Henk-Jan van Tuyl


--
http://Van.Tuyl.eu/
--

Using Opera's revolutionary e-mail client:
https://secure.bmtmicro.com/opera/buy-opera.html?AID=789433

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