[Haskell-cafe] [OT] Yet Another program written in Haskell: a language tag parser

2006-09-20 Thread Stephane Bortzmeyer
The program is written in Haskell, hence my shameless ad here: http://www.bortzmeyer.org/gabuzomeu-parsing-language-tags.html GaBuZoMeu is a set of programs to parse and check language tags (see the RFC 4646 produced by the IETF Working Group LTRU - Language Tag Registry Update). Language tags

[Haskell-cafe] Re: Why is type 'b' forced to be type 'm a' and not possibly 'm a - m a'

2006-09-20 Thread tpledger
Vivian McPhail wrote: class Forkable a where fork :: String - a - a - a What I would like to be able to do is differentiate between Forkable (m a - b) and Forkable (function type - b). Have you tried this combination of instances? instance Forkable (IO a) where ... --

[Haskell-cafe] Re: Numeric type classes

2006-09-20 Thread Aaron Denney
On 2006-09-12, Brian Hulley [EMAIL PROTECTED] wrote: Bryan Burgers wrote: That being said, I'll have to play the other side of the coin: it would probably be a little bit of a pain to have to define instances of each data declaration (Integer, Int, Float, Matrix, Complex, etc.) on each of

[Haskell-cafe] Re: Numeric type classes

2006-09-20 Thread Aaron Denney
On 2006-09-12, Jacques Carette [EMAIL PROTECTED] wrote: First, as already pointed out in http://www.haskell.org/pipermail/haskell-cafe/2006-April/015404.html there is a lot of relevant previous work in this area. I'm afraid I don't see the relevance. This is very easy to do in 'raw' category

[Haskell-cafe] Java or C to Haskell

2006-09-20 Thread Carajillu
I'm trying to write in Haskell a function that in Java would be something like this: char find_match (char[] l1, char[] l2, char e){ //l1 and l2 are not empty int i = 0; while (l2){ char aux = l2[i]; char[n] laux = l2;

Re: [Haskell-cafe] Java or C to Haskell

2006-09-20 Thread Donald Bruce Stewart
crespi.albert: I'm trying to write in Haskell a function that in Java would be something like this: char find_match (char[] l1, char[] l2, char e){ //l1 and l2 are not empty int i = 0; while (l2){ char aux = l2[i]; char[n] laux = l2;

Re: [Haskell-cafe] Java or C to Haskell

2006-09-20 Thread Andrea Rossato
On Wed, Sep 20, 2006 at 01:31:22AM -0700, Carajillu wrote: I'm trying to write in Haskell a function that in Java would be something like this: char find_match (char[] l1, char[] l2, char e){ //l1 and l2 are not empty int i = 0; while (l2){ char aux =

Re: [Haskell-cafe] Java or C to Haskell

2006-09-20 Thread Donald Bruce Stewart
dons: crespi.albert: I'm trying to write in Haskell a function that in Java would be something like this: char find_match (char[] l1, char[] l2, char e){ //l1 and l2 are not empty int i = 0; while (l2){ char aux = l2[i]; char[n] laux = l2;

Re: [Haskell-cafe] Java or C to Haskell

2006-09-20 Thread Andrea Rossato
On Wed, Sep 20, 2006 at 01:31:22AM -0700, Carajillu wrote: compare function just compares the two lists and return true if they are equal, or false if they are not. it is really a simple function, but I've been thinking about it a lot of time and I can't get the goal. I forgot, obviously,

Re: [Haskell-cafe] Java or C to Haskell

2006-09-20 Thread Carajillu
wow, the simpliest ever! Andrea Rossato wrote: On Wed, Sep 20, 2006 at 01:31:22AM -0700, Carajillu wrote: compare function just compares the two lists and return true if they are equal, or false if they are not. it is really a simple function, but I've been thinking about it a lot of

Re: [Haskell-cafe] Java or C to Haskell

2006-09-20 Thread Donald Bruce Stewart
mailing_list: On Wed, Sep 20, 2006 at 01:31:22AM -0700, Carajillu wrote: compare function just compares the two lists and return true if they are equal, or false if they are not. it is really a simple function, but I've been thinking about it a lot of time and I can't get the goal. I

Re: [Haskell-cafe] Java or C to Haskell

2006-09-20 Thread Carajillu
That works good, but I have a problem with the return type, I forgot to mention... can it be a [char]?? Donald Bruce Stewart wrote: crespi.albert: I'm trying to write in Haskell a function that in Java would be something like this: char find_match (char[] l1, char[] l2, char e){

Re: [Haskell-cafe] Java or C to Haskell

2006-09-20 Thread Carajillu
Yes, they must be equal the whole way, I like this recursive solution :) Ketil Malde-3 wrote: Carajillu [EMAIL PROTECTED] writes: compare function just compares the two lists and return true if they are equal, or false if they are not. find_match 4*ha 4*5a 'h' returns '5' (5

Re: [Haskell-cafe] Java or C to Haskell

2006-09-20 Thread Ketil Malde
Andrea Rossato [EMAIL PROTECTED] writes: I forgot, obviously, that lists are an instance of the Eq class... so, this is enough: comp l1 l2 = if l1 == l2 then True else False Or why not: comp l1 l2 = l1 == l2 Or simply: comp = (==) :-) -k -- If I haven't seen further, it is by

Re: [Haskell-cafe] Java or C to Haskell

2006-09-20 Thread Andrea Rossato
On Wed, Sep 20, 2006 at 07:20:23PM +1000, Donald Bruce Stewart wrote: comp l1 l2 = if l1 == l2 then True else False You never stop learning! andrea which you would just write as: comp = (==) and then you'd just use == anyway :) this is why I came to love haskell: it remembers

Re: [Haskell-cafe] System threads?

2006-09-20 Thread Duncan Coutts
On Tue, 2006-09-19 at 19:45 -0700, Lyle Kopnicky wrote: Hi folks, I'm working on a project for which the solution is highly parallelizable. I've been writing it so far for GHC as a single-threaded app. I'd like to be able to split the job into multiple pieces, and spawn different system

Re: [Haskell-cafe] Re: Optimization problem

2006-09-20 Thread Ross Paterson
On Tue, Sep 19, 2006 at 08:06:07PM +0200, [EMAIL PROTECTED] wrote: For our optimization problem, it's only a matter of constructors on the right hand side. They should pop out before do not look on any arguments, so it's safe to cry so you just know, i'm a Just. It seems the appropriate

Re: [Haskell-cafe] sections for record settors

2006-09-20 Thread Bulat Ziganshin
Hello Tim, Wednesday, September 20, 2006, 1:28:47 AM, you wrote: rec {field=val} but there is no settor function. It would be nice if there was some sort of section-like syntax to access the settor function, like: you can use DriFT which generates setter, isA and many other functions

[Haskell-cafe] Re: Java or C to Haskell

2006-09-20 Thread Jón Fairbairn
Carajillu [EMAIL PROTECTED] writes: That works good, but I have a problem with the return type, I forgot to mention... can it be a [char]?? If that's what you want, how about this: import Maybe find_match l1 l2 c = fmap catMaybes . sequence $ zipWith match l1 l2 where

Re: [Haskell-cafe] Java or C to Haskell

2006-09-20 Thread Matthias Fischmann
... and if you want to search strings not single characters: findmatch s t e = take m . drop n $ t where m' = length e (n, m) = f 0 s f i s | take m' s == e = (i, m') | null s = (0, 0) | otherwise = f (i+1) (tail s) findmatch asdfasdf

[Haskell-cafe] Re: Why is type 'b' forced to be type 'm a' and not possibly 'm a - m a'

2006-09-20 Thread Vivian McPhail
Vivian McPhail wrote: class Forkable a where fork :: String - a - a - a What I would like to be able to do is differentiate between Forkable (m a - b) and Forkable (function type - b). Have you tried this combination of instances? instance Forkable (IO a) where

[Haskell-cafe] Trying to write a TCP proxy

2006-09-20 Thread John Ky
Hello, I'm trying to use haskell to put together a TCP proxy I can put between my browser and my webserver. This is as far as I got. The webserver isn't returning my request: listen = withSocketsDo $ do putStrLn Listening... socket - listenOn $ PortNumber 8082 (handleToClient,

[Haskell-cafe] Re: Trying to write a TCP proxy

2006-09-20 Thread John Ky
Actually, it blocks on: putStrLn contents It even blocks if I replace it with: print $ length contents Is there some kind of magic happening here? -John On 9/20/06, John Ky [EMAIL PROTECTED] wrote: Hello, I'm trying to use haskell to put together a TCP proxy I can put between my

Re: [Haskell-cafe] Re: Trying to write a TCP proxy

2006-09-20 Thread Philippa Cowderoy
On Wed, 20 Sep 2006, John Ky wrote: Actually, it blocks on: putStrLn contents It even blocks if I replace it with: print $ length contents Is there some kind of magic happening here? No, but you're trying to do magic - it can't get all of contents until the connection's

Re: [Haskell-cafe] Trying to write a TCP proxy

2006-09-20 Thread Bulat Ziganshin
Hello John, Wednesday, September 20, 2006, 3:59:36 PM, you wrote: I'm trying to use haskell to put together a TCP proxy I can put between my browser and my webserver. This is as far as I got. The webserver isn't returning my request: hSetBuffering handleToServer LineBuffering may help

Re: [Haskell-cafe] Trying to write a TCP proxy

2006-09-20 Thread John Ky
Hi Bulat, Thanks. Yes it helps with an earlier implementation I wrote (below). But surely there must be a better way to write this. My code is way to verbose. -John --- doProxyServer handleToClient handleToServer = do eof - hIsEOF handleToServer if not eof then do ready -

Re: [Haskell-cafe] Re: Trying to write a TCP proxy

2006-09-20 Thread John Ky
Hi again, Given that putStrLn contents did manage to print out the HTTP header before blocking, am I correct in coming to the conlusion that 'contents' is evaluated lazily? So Monads don't actually eliminate laziness? -John On 9/20/06, Philippa Cowderoy [EMAIL PROTECTED] wrote: On Wed, 20

[Haskell-cafe] ICFP programming contest 2006 results: video stream

2006-09-20 Thread Donald Bruce Stewart
Malcolm Wallace has recorded the ICFP programming contest results announcement as video, straight from the ICFP conference in Portland. He's posted it to Google Video, and it's available to download (120M) or stream from Google video, here:

Re: [Haskell-cafe] Java or C to Haskell

2006-09-20 Thread Cale Gibbard
How about something like this? import Data.List findMatch xs ys k = lookup k . concat $ zipWith zip (substrings xs) (substrings ys) where substrings = nonempty . map (nonempty . inits) . tails where nonempty = filter (not . null) On 20/09/06, Matthias Fischmann [EMAIL

Re: [Haskell-cafe] Re: Numeric type classes

2006-09-20 Thread Jacques Carette
Whenever people start discussing the Numeric type classes, the true scope of what a refactoring can (and should?) be is frequently under-estimated. The 'structure' of algebraic objects in mathematics has been studied quite a lot (in mathematics and in CS, but not so much by programming

[Haskell-cafe] Re: Numeric type classes

2006-09-20 Thread Aaron Denney
On 2006-09-20, Jacques Carette [EMAIL PROTECTED] wrote: [Hopefully this answers your 'relevance' question]. Yes. I was focusing on the more narrow aspect, rather than what had started this thread. In other words, the specification language people have been down this road quite some time

Re: [Haskell-cafe] Re: Trying to write a TCP proxy

2006-09-20 Thread Tomasz Zielonka
On Thu, Sep 21, 2006 at 12:26:03AM +1000, John Ky wrote: Given that putStrLn contents did manage to print out the HTTP header before blocking, am I correct in coming to the conlusion that 'contents' is evaluated lazily? hGetContents breaks the rules of the IO monad - it returns a value (the

[Haskell-cafe] Re: MonadList?

2006-09-20 Thread Ashley Yakeley
Michael Shulman wrote: Ah, excellent. So it sounds like at least in Haskell prime, I'll probably be able to use MonadPlus to do what I want, because MaybeT and ErrorT will be instances of MonadOr instead. I'm not sure if this is part of Haskell Prime, though. -- Ashley Yakeley

Re: [Haskell-cafe] Either e Monad

2006-09-20 Thread Bas van Dijk
On Tuesday 19 September 2006 09:40, Deokhwan Kim wrote: Albert Lai wrote: Deokhwan Kim [EMAIL PROTECTED] writes: Where is the Monad instance declaration of Either e? It is in Control.Monad.Error as well. Strange: the doc doesn't state it. Thanks a lot, Albert! I found the

[Haskell-cafe] Trouble with simple embedding of shell in haskell

2006-09-20 Thread George Brewster
I'm just tried writing a function to allow convenient embedding of shell commands, but I'm running into behavior I don't really understand somewhere at the intersection of lazy evaluation, IO, and threading. The function in question is: sh :: String - String - IO String sh cmd = \input -

[Haskell-cafe] [newbie] How to test this function?

2006-09-20 Thread Bruno Martínez
I've written a function that looks similar to this one getList = find 5 where find 0 = return [] find n = do ch - getChar if ch `elem` ['a'..'e'] then do tl - find (n-1) return (ch : tl) else find n First, how do I fix the identation of the

Re: [Haskell-cafe] [newbie] How to test this function?

2006-09-20 Thread Donald Bruce Stewart
br1: I've written a function that looks similar to this one getList = find 5 where find 0 = return [] find n = do ch - getChar if ch `elem` ['a'..'e'] then do tl - find (n-1) return (ch : tl) else find n First, how do I fix the

Re: [Haskell-cafe] [newbie] How to test this function?

2006-09-20 Thread Donald Bruce Stewart
dons: br1: Second, I want to test this function, without hitting the filesystem. In C++ I would use a istringstream. I couldn't find a function that returns a Handle from a String. The closer thing that may work that I could find was making a pipe and convertind the file

Re: [Haskell-cafe] [newbie] How to test this function?

2006-09-20 Thread Donald Bruce Stewart
dons: br1: Second, I want to test this function, without hitting the filesystem. In C++ I would use a istringstream. I couldn't find a function that returns a Handle from a String. The closer thing that may work that I could find was making a pipe and convertind the file